search

exercism / tcl

Exercism exercises in Tcl.
https://exercism.org/tracks/tcl
MIT License
10 stars 16 forks source link

Building a training set of tags for tcl #305

Closed ErikSchierboom closed 11 months ago

ErikSchierboom commented 11 months ago

Hello lovely maintainers :wave:

We've recently added "tags" to student's solutions. These express the constructs, paradigms and techniques that a solution uses. We are going to be using these tags for lots of things including filtering, pointing a student to alternative approaches, and much more.

In order to do this, we've built out a full AST-based tagger in C#, which has allowed us to do things like detect recursion or bit shifting. We've set things up so other tracks can do the same for their languages, but its a lot of work, and we've determined that actually it may be unnecessary. Instead we think that we can use machine learning to achieve tagging with good enough results. We've fine-tuned a model that can determine the correct tags for C# from the examples with a high success rate. It's also doing reasonably well in an untrained state for other languages. We think that with only a few examples per language, we can potentially get some quite good results, and that we can then refine things further as we go.

I released a new video on the Insiders page that talks through this in more detail.

We're going to be adding a fully-fledged UI in the coming weeks that allow maintainers and mentors to tag solutions and create training sets for the neural networks, but to start with, we're hoping you would be willing to manually tag 20 solutions for this track. In this post we'll add 20 comments, each with a student's solution, and the tags our model has generated. Your mission (should you choose to accept it) is to edit the tags on each issue, removing any incorrect ones, and add any that are missing. In order to build one model that performs well across languages, it's best if you stick as closely as possible to the C# tags as you can. Those are listed here. If you want to add extra tags, that's totally fine, but please don't arbitrarily reword existing tags, even if you don't like what Erik's chosen, as it'll just make it less likely that your language gets the correct tags assigned by the neural network.

To summarise - there are two paths forward for this issue:

  1. You're up for helping: Add a comment saying you're up for helping. Update the tags some time in the next few days. Add a comment when you're done. We'll then add them to our training set and move forward.
  2. You not up for helping: No problem! Just please add a comment letting us know :)

If you tell us you're not able/wanting to help or there's no comment added, we'll automatically crowd-source this in a week or so.

Finally, if you have questions or want to discuss things, it would be best done on the forum, so the knowledge can be shared across all maintainers in all tracks.

Thanks for your help! :blue_heart:

Note: Meta discussion on the forum

ErikSchierboom commented 11 months ago

Exercise: two-fer

Code

proc two-fer {{name "you"}} {
    return "One for $name, one for me."
}

Tags:

construct:string-interpolation
construct:optional-parameter
construct:parameter
construct:proc
construct:return
construct:template-string
construct:variable
paradigm:imperative
paradigm:functional
paradigm:reflective
technique:string-interpolation
ErikSchierboom commented 11 months ago

Exercise: scrabble-score

Code

proc scrabbleScore {word} {
    set score 0
    foreach char [split [string toupper $word] ""] {
        incr score [switch -glob -- $char {
            [AEIOULNRST] { expr  1 }
            [DG]         { expr  2 }
            [BCMP]       { expr  3 }
            [FHVWY]      { expr  4 }
            [K]          { expr  5 }
            [JX]         { expr  8 }
            [QZ]         { expr 10 }
            default      { expr  0 }
        }]
    }
    return $score
}

Tags:

construct:string
construct:char
construct:construct
construct:foreach
construct:invocation
construct:parameter
construct:proc
construct:proc
construct:return
construct:set
construct:split
construct:string
construct:switch
construct:variable
construct:visibility-modifiers
paradigm:imperative
paradigm:functional
paradigm:reflective
technique:enumeration
technique:higher-order-functions
ErikSchierboom commented 11 months ago

Exercise: scrabble-score

Code

proc value {char} {
    switch -- [string toupper $char] {
        A - E - I - O - U - L - N - R - S - T { expr 1 }
        D - G                                 { expr 2 }
        B - C - M - P                         { expr 3 }
        F - H - V - W - Y                     { expr 4 }
        K                                     { expr 5 }
        J - X                                 { expr 8 }
        Q - Z                                 { expr 10 }
        default                               { expr 0 }
    }
}

proc scrabbleScore {word} {
    set score 0
    foreach char [split $word ""] {
        incr score [value $char]
    }
    return $score
}

Tags:

construct:assignment
construct:char
construct:expression
construct:foreach
construct:invocation
construct:lambda
construct:list
construct:number
construct:parameter
construct:pattern-matching
construct:proc
construct:procedure
construct:return
construct:set
construct:string
construct:subtract
construct:switch
construct:variable-visibility
paradigm:functional
paradigm:imperative
paradigm:pattern-matching
technique:higher-order-functions
ErikSchierboom commented 11 months ago

Exercise: scrabble-score

Code

proc scrabbleScore {word} {
    set points [dict create \
        A 1 E 1 I 1 O 1 U 1 L 1 N 1 R 1 S 1 T 1 \
        D 2 G 2 \
        B 3 C 3 M 3 P 3 \
        F 4 H 4 V 4 W 4 Y 4 \
        K 5 \
        J 8 X 8 \
        Q 10 Z 10
    ]

    set res 0
    foreach a [split [string toupper $word] {}] {
        incr res [dict get $points $a]
    }
    set res
}

Tags:

construct:backslash
construct:char
construct:dictionary
construct:foreach
construct:invocation
construct:method
construct:number
construct:parameter
construct:proc
construct:set
construct:string
construct:variable
paradigm:imperative
paradigm:functional
paradigm:reflective
technique:enumeration
uses:dict::dict
ErikSchierboom commented 11 months ago

Exercise: tournament

Code

proc file_to_buff {filename} {
    set fh [open $filename r]
    set buff [read $fh]
    close $fh
    return $buff
}

proc sum_element_wise { la lb } {
    return [lmap x $la y $lb {expr {$x + $y}}] 
}

proc _sort_results { a b } {
    # custom sort function - by total, then by team name
    lassign $a teama _ _ _ _ tota
    lassign $b teamb _ _ _ _ totb
    if { $tota < $totb } {
        return 1
    } elseif { $tota > $totb } {
        return -1
    }
    return [string compare $teama $teamb]
}

proc dump_results { resd {lwidth 30} } {
    array set results $resd

    set resl [list ]

    foreach {k v} [array get results] {
        lappend resl [concat [list $k] $v]
    }
    set rbuff [list]
    lappend rbuff [format "%-*s | %s |  %s |  %s |  %s |  %s" \
                          $lwidth Team MP W D L P]
    foreach l [lsort -command _sort_results $resl] {
        lassign $l t mp w d l p
        lappend rbuff [format "%-*s |  %s |  %s |  %s |  %s |  %s" \
                              $lwidth $t $mp $w $d $l $p]
    }
    return [join $rbuff \n]
}

proc tournamentResults {filename} {
    set buff [file_to_buff $filename]
    foreach line [split $buff \n] {
        set items [split $line {;}]
        if { [llength $items] != 3 } {
            continue
        }
        lassign $items teama teamb res
        if { ! [info exists results($teama)] } {
            set results($teama) {0 0 0 0 0}
        }
        if { ! [info exists results($teamb)] } {
            set results($teamb) {0 0 0 0 0}
        }
        set adelta [list 1 [expr {"$res" eq "win" ? 1 : 0}] \
                    [expr {"$res" eq "draw" ? 1 : 0}] \
                    [expr {"$res" eq "loss" ? 1 : 0}] \
                    [expr {"$res" eq "win" ? 3 : [expr {"$res" eq "draw" ? 1 : 0}]}] ]

        set bdelta [list 1 [expr {"$res" eq "loss" ? 1 : 0}] \
                    [expr {"$res" eq "draw" ? 1 : 0}] \
                    [expr {"$res" eq "win" ? 1 : 0}] \
                    [expr {"$res" eq "loss" ? 3 : [expr {"$res" eq "draw" ? 1 : 0}]}] ]

        set results($teama) [sum_element_wise $results($teama) $adelta]
        set results($teamb) [sum_element_wise $results($teamb) $bdelta]
    }

    return [dump_results [array get results]]
}

Tags:

construct:assignment
construct:array
construct:close-brace
construct:comment
construct:continue
construct:elseif
construct:expr
construct:foreach
construct:if
construct:invocation
construct:lambda
construct:list
construct:lmap
construct:nested-braces
construct:optional-parameter
construct:parameter
construct:pattern
construct:proc
construct:read
construct:return
construct:set
construct:string
construct:subtract
construct:ternary
construct:variable
construct:visibility-modifiers
paradigm:functional
paradigm:imperative
paradigm:reflective
technique:higher-order-functions
technique:looping
ErikSchierboom commented 11 months ago

Exercise: tournament

Code

proc tournamentResults {filename} {
    [Tournament new $filename] results
}

# ---------------------------------------------------------
oo::class create Tournament {
    variable filename teams

    constructor {aFilename} {
        set filename $aFilename
        set teams [dict create]
    }

    method results {} {
        my Parse
        my Format
    }

    method Parse {} {
        set fh [open $filename r]
        while {[gets $fh match] != -1} {
            if {[regexp {(.+);(.+);(.+)} $match -> home away result]} {
                my InitializeTeam $home
                my InitializeTeam $away
                my RegisterMatch $home $away $result
            }
        }
        close $fh
    }

    method InitializeTeam {team} {
        if {![dict exists $teams $team]} {
            dict set teams $team [Team new $team]
        }
    }

    method RegisterMatch {home away result} {
        switch -exact -- $result {
            win {
                [dict get $teams $home] win
                [dict get $teams $away] lose
            }
            loss {
                [dict get $teams $home] lose
                [dict get $teams $away] win
            }
            draw {
                [dict get $teams $home] draw
                [dict get $teams $away] draw
            }
        }
    }

    method Format {} {
        set fmt "%-30s | %2s | %2s | %2s | %2s | %2s"
        lappend output [format $fmt Team MP W D L P]

        # sort by points descending then by name ascending
        set standings [lmap team [dict values $teams] {$team asList}]
        set standings [lsort -index 0 -dictionary $standings]
        set standings [lsort -index end -integer -decreasing $standings]

        foreach team $standings {
            lappend output [format $fmt {*}$team]
        }

        join $output \n
    }
}

# ---------------------------------------------------------
oo::class create Team {
    variable name wins losses draws 

    constructor {aName} {
        set name $aName
        set wins [set losses [set draws 0]]
    }

    method win  {} {incr wins}
    method draw {} {incr draws}
    method lose {} {incr losses}

    method asList {} {
        set played [expr {$wins + $draws + $losses}]
        set points [expr {3 * $wins + 1 * $draws}]
        list $name $played $wins $draws $losses $points
    }
}

Tags:

construct:add
construct:assignment
construct:class
construct:close-bracket
construct:comment
construct:constructor
construct:dictionary
construct:expr
construct:foreach
construct:getter
construct:if
construct:invocation
construct:lambda
construct:list
construct:method
construct:multiply
construct:nested-scopes
construct:number
construct:open-bracket
construct:parameter
construct:proc
construct:regexp
construct:set
construct:string
construct:subtract
construct:switch
construct:variable
construct:visibility-modifiers
construct:while-loop
paradigm:functional
paradigm:imperative
paradigm:object-oriented
technique:higher-order-functions
technique:looping
technique:regular-expression
ErikSchierboom commented 11 months ago

Exercise: rna-transcription

Code

proc to-rna {dna} {
    set nucleotides [split $dna ""]; # Split dna string to list of nucleotide chars
    set rna_trascription ""
    foreach nucleotide $nucleotides {
        switch $nucleotide {
            "G" { # Guanine
                set rna_nucleotide "C"; # Cytosine
            }
            "C" { # Cytosine
                set rna_nucleotide "G"; # Guanine
            }
            "T" { # Thymine
                set rna_nucleotide "A"; # Adenine
            }
            "A" { # Adenine
                set rna_nucleotide "U"; # Uracil
            }
        }
        append rna_trascription $rna_nucleotide
    }
    return $rna_trascription
}

Tags:

construct:append
construct:comment
construct:foreach
construct:function
construct:invocation
construct:list
construct:parameter
construct:proc
construct:return
construct:set
construct:string
construct:switch
construct:variable
paradigm:imperative
paradigm:functional
paradigm:reflective
technique:looping
ErikSchierboom commented 11 months ago

Exercise: leap

Code

#!/usr/bin/env tclsh

proc isLeapYear {year} {
    set a [expr {$year % 400}]
    if {$a == 0} then {
    return 1
    } elseif {[expr {$a % 100}] == 0} {
    return 0;
    } else {
        return [expr {$a % 4} == 0]
    }
}

Tags:

construct:boolean
construct:comment
construct:elseif
construct:if
construct:integer
construct:invocation
construct:number
construct:parameter
construct:proc
construct:return
construct:set
construct:semicolon
construct:variable
construct:visibility-modifiers
paradigm:imperative
paradigm:procedural
ErikSchierboom commented 11 months ago

Exercise: anagram

Code

namespace eval Anagrams {
    proc findAnagrams {subject candidates} {
        set keyFunc {{word} {lsort [split $word ""]}}

        set lcSubj [string tolower $subject]
        set key [apply $keyFunc $lcSubj]

        set anagrams {}
        foreach candidate $candidates {
            set lc [string tolower $candidate]
            if {($lcSubj ne $lc) && ($key eq [apply $keyFunc $lc])} {
                lappend anagrams $candidate
            }
        }
        return $anagrams
    }

    # or, with math! https://twitter.com/fermatslibrary/status/1275066521450975234
    proc findAnagramsByHashing {subject candidates} {
        set lcSubject [string tolower $subject]
        set key [hash $lcSubject]
        lmap candidate $candidates {
            set lc [string tolower $candidate]
            if {($lcSubject eq $lc) || ($key != [hash $lc])} {
                continue
            }
            set candidate
        }
    }

    # first 26 prime numbers
    variable primeMap {
        a "*   2"   j "*  29"   s "*  67"
        b "*   3"   k "*  31"   t "*  71"
        c "*   5"   l "*  37"   u "*  73"
        d "*   7"   m "*  41"   v "*  79"
        e "*  11"   n "*  43"   w "*  83"
        f "*  13"   o "*  47"   x "*  89"
        g "*  17"   p "*  53"   y "*  97"
        h "*  19"   q "*  59"   z "* 101"
        i "*  23"   r "*  61"
    }

    proc hash {word} {
        variable primeMap
        expr [string cat 1 [string map $primeMap [regsub -all {[^[:alpha:]]} $word ""]]]
    }
}

#interp alias {} findAnagrams {} Anagrams::findAnagrams
interp alias {} findAnagrams {} Anagrams::findAnagramsByHashing

Tags:

construct:boolean
construct:comment
construct:continue
construct:curly-braces
construct:expression
construct:foreach
construct:hash-table
construct:if
construct:invocation
construct:lambda
construct:list
construct:logical-and
construct:logical-or
construct:method
construct:namespace
construct:parameter
construct:proc
construct:return
construct:set
construct:string
construct:variable
construct:visibility-modifiers
paradigm:functional
paradigm:object-oriented
technique:boolean-logic
technique:enumeration
technique:higher-order-functions
technique:looping
uses:HashTable
uses:List
ErikSchierboom commented 11 months ago

Exercise: phone-number

Code

proc clean {input} {
    # remove valid non-digits
    regsub -all {[-+.()\s]} $input "" clean

    # so many assertions...

    assert {![regexp {[[:alpha:]]} $clean]} "letters not permitted"
    assert {![regexp {\D} $clean]} "punctuations not permitted"

    assert {[string length $clean] >= 10} "incorrect number of digits"
    assert {[string length $clean] <= 11} "more than 11 digits"
    # remove country code if present
    if {[string length $clean] == 11 && [regsub {^1} $clean "" clean] != 1} {
        error "11 digits must start with 1"
    }

    assert {![string match {0*} $clean]} "area code cannot start with zero"
    assert {![string match {1*} $clean]} "area code cannot start with one"
    assert {![string match {???0*} $clean]} "exchange code cannot start with zero"
    assert {![string match {???1*} $clean]} "exchange code cannot start with one"

    return $clean
}

proc assert {condition errMsg} {
    if {![uplevel 1 [list expr $condition]]} {
        error $errMsg
    }
}

Tags:

construct:comment
construct:double
construct:error
construct:floating-point-number
construct:function
construct:if
construct:invocation
construct:lambda
construct:list
construct:logical-and
construct:number
construct:parameter
construct:proc
construct:return
construct:string
construct:subtract
construct:variable
paradigm:functional
paradigm:imperative
paradigm:reflective
technique:boolean-logic
ErikSchierboom commented 11 months ago

Exercise: collatz-conjecture

Code

proc steps {n {step 0}} {
    if {$n <= 0} {
        error "Only positive numbers are allowed"
    }
    if {$n == 1} then {return $step}
    tailcall steps [expr {$n % 2 == 0 ? $n/2 : 3*$n + 1}] [incr step]
}

Tags:

construct:add
construct:boolean
construct:divide
construct:error
construct:if
construct:invocation
construct:number
construct:optional-parameter
construct:parameter
construct:proc
construct:return
construct:ternary
construct:variable
construct:visibility-modifiers
paradigm:imperative
paradigm:functional
paradigm:object-oriented
technique:exceptions
ErikSchierboom commented 11 months ago

Exercise: strain

Code


proc keep {varname list condition {keep yes}} {
    upvar 1 $varname elem
    lmap elem $list {
        if {!![uplevel 1 $condition] == !!$keep} {
            set elem
        } else {
            continue
        }
    }
}

proc discard {varname list condition} {
    tailcall keep $varname $list $condition no
}

Tags:

construct:boolean
construct:continue
construct:if
construct:invocation
construct:lmap
construct:named-argument
construct:optional-parameter
construct:parameter
construct:proc
construct:procedure
construct:set
construct:tailcall
construct:upvar
construct:variable
construct:visibility-modifiers
paradigm:functional
paradigm:imperative
paradigm:reflective
technique:higher-order-functions
ErikSchierboom commented 11 months ago

Exercise: robot-simulator

Code

oo::class create Robot {
    variable position

    constructor {{initialPos {}}} {
        set position [dict merge {x 0 y 0 direction north} $initialPos]

        dict with position {
            assert {$direction in {north east south west}} "invalid direction"
            assert {[string is integer -strict $x]} "invalid x coordinate"
            assert {[string is integer -strict $y]} "invalid y coordinate"
        }
    }

    method position {} {
        return $position
    }

    method move {instructions} {
        foreach inst [split $instructions ""] {
            switch -- $inst {
                A       {my advance}
                L - R   {my turn $inst}
                default {error "invalid instruction: $inst"}
            }
        }
    }

    method advance {} {
        set delta {
            north {X  0  Y  1}
            east  {X  1  Y  0}
            south {X  0  Y -1}
            west  {X -1  Y  0}
        }
        dict update position x xPos y yPos direction dir {
            dict with delta $dir {
                incr xPos $X
                incr yPos $Y
            }
        }
    }
    unexport advance    ;# private method

    method turn {which} {
        set turn {
            north {L west  R east}
            east  {L north R south}
            south {L east  R west}
            west  {L south R north}
        }
        dict update position direction dir {
            set dir [dict get $turn $dir $which]
        }
    }
    unexport turn   ;# private method
}

proc assert {condition errMsg} {
    if {![uplevel 1 [list expr $condition]]} {
        error $errMsg
    }
}

Tags:

construct:class
construct:comment
construct:constructor
construct:dict
construct:error
construct:foreach
construct:if
construct:invocation
construct:lambda
construct:list
construct:method
construct:nested-scopes
construct:parameter
construct:proc
construct:return
construct:set
construct:string
construct:switch
construct:unexported
construct:variable
construct:visibility-modifiers
paradigm:functional
paradigm:object-oriented
technique:higher-order-functions
ErikSchierboom commented 11 months ago

Exercise: robot-simulator

Code

oo::class create Robot {
    variable position

    constructor {args} {
        set position [dict create x 0 y 0 direction north]
        if {[llength $args] == 1} {
            set position [dict merge $position [lindex $args 0]]
        }

        dict with position {
            if {[lsearch -exact {north south west east} $direction] < 0} {
                error "invalid direction"
            }

            if {[string is integer $x] == 0} {
                error "invalid x coordinate"
            }

            if {[string is integer $y] == 0} {
                error "invalid y coordinate"
            }
        }
    }

    method position {} {
        return $position
    }

    method move {steps} {
        foreach step [split $steps ""] {
            switch -- $step {
                R       { my turnRight }
                L       { my turnLeft }
                A       { my advance }
                default { error "invalid instruction: $step" }
            }
        }
    }

    method turnRight {} {
        dict with position {
            switch -- $direction {
                north   { set direction east }
                east    { set direction south }
                south   { set direction west }
                west    { set direction north }
            }
        }
    }

    method turnLeft {} {
        my turnRight; my turnRight; my turnRight
    }

    method advance {} {
        dict with position {
            switch $direction {
                north   { incr y }
                south   { incr y -1 }
                east    { incr x }
                west    { incr x -1 }
            }
        }
    }
}

Tags:

construct:class
construct:constructor
construct:dict
construct:error
construct:foreach
construct:if
construct:invocation
construct:lambda
construct:method
construct:method-invocation
construct:nested-scope
construct:number
construct:parameter
construct:return
construct:set
construct:string
construct:subtract
construct:switch
construct:variable
construct:visibility-modifiers
paradigm:functional
paradigm:object-oriented
technique:higher-order-functions
ErikSchierboom commented 11 months ago

Exercise: wordy

Code

proc answer {question} {
    set input [string map {
        "what is"       ""
        "?"             ""
        "plus"          "+"
        "minus"         "-"
        "multiplied by" "*"
        "divided by"    "/"
    } [string tolower $question]]

    # should only be digits, spaces and operators remaining
    assert {[regexp {^[\d\s/*+-]*$} $input]} "unknown operation"

    set expression [regexp -inline -all {\S+} $input]

    # can't be empty
    assert {[llength $expression] > 0} "syntax error"

    while {[llength $expression] > 1} {
        set rest [lassign $expression left op right]

        assert {[string is integer -strict $left]}  "syntax error"
        assert {[string is integer -strict $right]} "syntax error"
        assert {[string match {[-+*/]} $op]}        "syntax error"

        set expression [linsert $rest 0 [expr "$left $op $right"]]
    }

    return $expression
}

proc assert {condition errMsg} {
    if {![uplevel 1 [list expr $condition]]} {
        error $errMsg
    }
}

Tags:

construct:string-map
construct:assignment
construct:comment
construct:if
construct:invocation
construct:list
construct:loop
construct:parameter
construct:proc
construct:return
construct:set
construct:string
construct:subtract
construct:throw
construct:while-loop
paradigm:imperative
paradigm:functional
paradigm:reflective
technique:exceptions
technique:higher-order-functions
technique:looping
uses:regexp
ErikSchierboom commented 11 months ago

Exercise: atbash-cipher

Code

namespace eval atbash {
    namespace export encode decode
    namespace ensemble create

    proc encode {input} {
        groups [decode $input] 5
    }

    proc decode {input} {
        set mapping {
            a z   b y   c x   d w   e v   f u   g t   h s   i r
            j q   k p   l o   m n   n m   o l   p k   q j   r i
            s h   t g   u f   v e   w d   x c   y b   z a   0 0
            1 1   2 2   3 3   4 4   5 5   6 6   7 7   8 8   9 9
        }
        set chars [regexp -all -inline -- {[[:alnum:]]} $input]
        string map -nocase $mapping [join $chars ""]
    }

    proc groups {s length} {
        set result {}
        for {set i 0} {$i < [string length $s]} {incr i $length} {
            lappend result [string range $s $i [expr {$i+$length-1}]]
        }
        return $result
    }
}

Tags:

construct:add
construct:assignment
construct:bracket
construct:comment
construct:constructor
construct:for-loop
construct:invocation
construct:join
construct:lambda
construct:list
construct:method
construct:namespace
construct:number
construct:parameter
construct:proc
construct:regexp
construct:return
construct:set
construct:string
construct:subtract
construct:variable
paradigm:functional
paradigm:imperative
paradigm:object-oriented
technique:higher-order-functions
technique:looping
technique:regular-expression
ErikSchierboom commented 11 months ago

Exercise: prime-factors

Code

proc factors {n {p 2} {primeFactors {}}} {
    if {$p * $p > $n} {
        if {$n > 1} then {lappend primeFactors $n }
        return $primeFactors
    }

    while {$n % $p == 0} {
        lappend primeFactors $p
        set n [expr {$n / $p}]
    }

    set procname [lindex [info level 0] 0]
    set step [expr {$p == 2 ? 1 : 2}]

    tailcall $procname $n [incr p $step] $primeFactors
}

Tags:

construct:assignment
construct:boolean
construct:divide
construct:expression
construct:if
construct:invocation
construct:lambda
construct:list
construct:method
construct:multiply
construct:number
construct:optional-parameter
construct:parameter
construct:proc
construct:procedure
construct:return
construct:set
construct:ternary
construct:variable
construct:visibility-modifiers
construct:while-loop
paradigm:functional
paradigm:imperative
paradigm:object-oriented
technique:boolean-logic
technique:higher-order-functions
technique:looping
ErikSchierboom commented 11 months ago

Exercise: meetup

Code

# Strategy: starting with the first day of the "nth" section of the month,
# then iterate day-by-day until we find the requested weekDay.
#
# Note the tests use English weekday names, so work in the en_US locale

proc meetup {year month nth weekDay} {
    # TODO catch errors for invalid input

    set firstDay {
        first   1 
        second  8 
        third  15 
        fourth 22 
        last    1
        teenth 13
    }
    set day [clock scan "$year-$month-[dict get $firstDay $nth]" -format {%Y-%m-%d}]

    if {$nth eq "last"} {
        set day [clock add $day 1 month -7 days]
    }

    foreach _ {1 2 3 4 5 6 7} {
        set wday [clock format $day -format {%A} -locale "en_US"]
        if {$wday eq $weekDay} {
            return [clock format $day -format {%Y-%m-%d}]
        }
        set day [clock add $day 1 day]
    }
    error "$nth $weekDay not found in $year-$month"
}

Tags:

construct:assignment
construct:biginteger
construct:comment
construct:date
construct:dict
construct:double
construct:error
construct:foreach
construct:floating-point-number
construct:if
construct:invocation
construct:lambda
construct:list
construct:locale
construct:number
construct:parameter
construct:proc
construct:return
construct:set
construct:string
construct:subtract
construct:variable
construct:visibility-modifiers
paradigm:functional
paradigm:imperative
paradigm:reflective
technique:enumeration
technique:higher-order-functions
uses:dict
uses:locale
uses:time
ErikSchierboom commented 11 months ago

Exercise: pov

Code

proc fromPov {treeInput label} {
    set pov [[Tree new $treeInput] fromPov $label]
    $pov toDict
}

proc path {treeInput fromLabel toLabel} {
    set path [[Tree new $treeInput] path $fromLabel $toLabel]
    lmap node $path {$node label}
}

############################################################
oo::class create Tree {
    variable label
    variable children

    constructor {input} {
        assert {[dict exists $input label]} "missing label: [list $input]"
        set label [dict get $input label]
        set children {}
        if {[dict exists $input children]} {
            foreach elem [dict get $input children] {
                lappend children [[self class] new $elem]
            }
        }
    }

    method label {} {return $label}

    method fromPov {label} {
        set path [my pathFromRoot $label]
        assert {[llength $path]} "no such target"

        set path [lassign $path root]
        foreach node $path {
            $root removeChild $node
            $node addChild $root
            set root $node
        }
        return $root
    }

    method path {fromLabel toLabel} {
        set fromPath [my pathFromRoot $fromLabel]
        set toPath   [my pathFromRoot $toLabel]
        assert {[llength $fromPath] && [llength $toPath]} "no such label"

        set commonPathLength -1
        foreach fromNode $fromPath toNode $toPath {
            if {$fromNode eq "" || $toNode eq "" || [$fromNode label] ne [$toNode label]} {
                break
            }
            incr commonPathLength
        }

        # the path "up"
        set path [lreverse [lrange $fromPath $commonPathLength end]]
        # the path "down"
        lappend path {*}[lrange $toPath $commonPathLength+1 end]
        return $path
    }

    method addChild {child} {
        lappend children $child
        return
    }

    method removeChild {child} {
        set idx -1
        for {set i 0} {$i < [llength $children]} {incr i} {
            if {[$child label] eq [[lindex $children $i] label]} {
                set idx $i
                break
            }
        }
        if {$idx != -1} {
            set children [lreplace $children $idx $idx]
        }
        return
    }

    method pathFromRoot {needle {path ""}} {
        set newPath [linsert $path end [self]]
        if {$needle eq $label} {
            return $newPath
        }
        foreach child $children {
            set thisPath [$child pathFromRoot $needle $newPath]
            if {$thisPath ne ""} {
                return $thisPath
            }
        }
        return
    }

    method toDict {} {
        set output {}
        dict set output label $label
        if {[llength $children] > 0} {
            foreach child $children {
                dict lappend output children [$child toDict]
            }
        }
        return $output
    }
}

############################################################
proc assert {condition errMsg} {
    if {![uplevel 1 [list expr $condition]]} {
        error $errMsg
    }
}

Tags:

construct:add
construct:assignment
construct:boolean
construct:break
construct:class
construct:comment
construct:constructor
construct:dict
construct:error
construct:for
construct:foreach
construct:if
construct:invocation
construct:lambda
construct:list
construct:logical-or
construct:method
construct:nested-call
construct:optional-parameter
construct:parameter
construct:proc
construct:procedure
construct:return
construct:set
construct:string
construct:variable
construct:visibility-modifiers
paradigm:functional
paradigm:imperative
paradigm:object-oriented
technique:boolean-logic
technique:higher-order-functions
technique:looping
technique:recursion
uses:Tree
uses:dict
uses:invocation
ErikSchierboom commented 11 months ago

Exercise: word-search

Code

proc wordSearch {grid words} {
    set gd [dict create]  

    set rcnt 0
    set ccnt 0

    set row 0
    # create a matrix-like dict for convenience
    foreach l [split $grid \n] {
        set sl [string trim $l]
        if { $sl eq "" } { continue }
        set col 0 
        foreach c [split [string trim $l] ""] {
            dict set gd "$row,$col" $c 
            incr col
            if { $col > $ccnt } { set ccnt $col }
        }
        incr row
        if { $row > $rcnt } { set rcnt $row }
    }

    set found [dict create]  
    foreach word $words {
        dict set found $word {}
    }

    # for every entry in the grid, search all directions
    for {set r 0} {$r < $row} {incr r} {
        for {set c 0} {$c < $col} {incr c} {
            foreach dir {n ne nw s se sw e w} { 
                set res [search $gd [list $r $c] [list $r $c] $dir \
                                    [dict get $gd "$r,$c"] $words]
                if { $res ne "" } {
                    lassign $res word sidx eidx
                    dict set found $word [list [_rev_idx [_bump_idx $sidx]] [_rev_idx [_bump_idx $eidx]]]
                }
            }
        }
    }
    return $found
}

proc _bump_idx { idx } {
    # indexes expected to start from 1,1
    return [list [expr {[lindex $idx 0] + 1}] [expr {[lindex $idx 1] + 1}]]
}

proc _rev_idx { idx } {
    # row/col indexes seem transposed in the tests!
    return [list [lindex $idx 1] [lindex $idx 0]]
}

# 0, 0 will be the top left of the grid
proc search { grid sidx cidx dir curstr words} {
    # modify the current index
    switch -exact -- $dir {
        "ne" {
            set delta {1 -1}
        }
        "n" {
            set delta {0 -1}
        }
        "s" {
            set delta {0 1}
        }
        "nw" {
            set delta {-1 -1}
        }
        "e" {
            set delta {1 0}
        }
        "w" {
            set delta {-1 0}
        }
        "sw" {
            set delta {-1 1}
        }
        "se" {
            set delta {1 1}
        }
    }

    set cidx [list [expr {[lindex $delta 0] + [lindex $cidx 0]}] \
                   [expr {[lindex $delta 1] + [lindex $cidx 1]}]]
    set dkey [join $cidx ,]
    if { ! [dict exists $grid $dkey] } {
        # off the grid
        return {}
    }
    set nc [dict get $grid $dkey]
    set nstr "${curstr}$nc"

    if { $nstr in $words } {
        # we have found a word
        return [list $nstr $sidx $cidx]
    }

    set matches [lmap word $words {if {[string match "${nstr}*" $word]} { set word} else continue}]
    if { [llength $matches] == 0 } {
        # no more words to find in this direction
        return {}
    }

    return [search $grid $sidx $cidx $dir "${curstr}$nc" $words]
}

Tags:

construct:string-interpolation
construct:assignment
construct:boolean
construct:comment
construct:continue
construct:dictionary
construct:double
construct:else
construct:expr
construct:floating-point-number
construct:for-loop
construct:foreach
construct:if
construct:implicit-conversion
construct:indexing
construct:invocation
construct:join
construct:lambda
construct:list
construct:method
construct:number
construct:parameter
construct:proc
construct:return
construct:set
construct:string
construct:subtract
construct:switch
construct:variable-visibility-modifiers
construct:visibility-modifiers
paradigm:functional
paradigm:imperative
paradigm:object-oriented
technique:higher-order-functions
technique:looping
technique:recursion
uses:dict
uses:double-precision-floating-point-numbers
uses:invocation
uses:lists
uses:string-interpolation
ErikSchierboom commented 11 months ago

This is an automated comment

Hello :wave: Next week we're going to start using the tagging work people are doing on these. If you've already completed the work, thank you! If you've not, but intend to this week, that's great! If you're not going to get round to doing it, and you've not yet posted a comment letting us know, could you please do so, so that we can find other people to do it. Thanks!

glennj commented 11 months ago

I will not have time for this one.