5. Hashes

array set age {
    Nat   24
    Jules 25
    Josh  17
}
 
set age(Nat)   24
set age(Jules) 25
set age(Josh)  17

 
array set foodColor {
    Apple   red
    Banana  yellow
    Lemon   yellow
    Carrot  orange
}

set array(foo) bar
 
# or
 
set key foo
set value bar
set array($key) $value
 
# or
 
array set array [list $key $value]

 
# foodColor defined per the introduction
set foodColor(Raspberry) pink
puts "Known foods:"
foreach food {[array names foodColor]} {
    puts $food
}

if {[info exists array($key)]} {
    # it exists
} else {
    # it doesn't
}

 
# foodColor per the introduction
foreach name {Banana Martini} {
    if {[info exists foodColor($name)]} {
        puts "$name is a food."
    } else {
        puts "$name is a drink.";
    }
}

 
array unset age
set age(Toddler)  3
set age(Unborn)   0
set age(Phantasm) false

foreach thing {Toddler Unborn Phantasm Relic} {
        set result "$thing:"
        if {[info exists age($thing)]} {
                append result " Exists"  
                if {$age($thing)} {
                        append result " True"
                } 
                if {$age($thing) != 0} {
                        append result " Non-zero"
                }
        }
        puts $result
} ;# improved by Bob Techentin

# remove $KEY and its value from ARRAY
array unset ARRAY $KEY

# foodColor as per Introduction
proc print-foods {} {
    variable foodColor
    set foods [array names foodColor]
    set food {}
     
    puts "Keys: $foods"
    puts -nonewline "Values: "
     
    foreach food $foods {
        set color $foodColor($food)
         
        if {$color ne {}} {
            puts -nonewline "$color "
        } else {
            puts -nonewline {(empty) }
        }
    }
    puts {}
}
puts "Initially:"
print-foods
puts "\nWith Banana empty"
set foodColor(Banana) {}
print-foods
puts "\nWith Banana deleted"
array unset foodColor Banana
print-foods
# => Initially:
# => Keys: Banana Apple Carrot Lemon
# => Values: yellow red orange yellow 
# => 
# => With Banana empty
# => Keys: Banana Apple Carrot Lemon
# => Values: (empty) red orange yellow 
# => 
# => With Banana deleted
# => Keys: Apple Carrot Lemon
# => Values: red orange yellow 

# several members can be deleted in one
# go if their names match a glob pattern,
# otherwise the [array unset] command must
# be called once for each name.
array unset foodColor ?a*
print-foods
# => Keys: Apple Lemon
# => Values: red yellow 

foreach {key value} [array get ARRAY] {
    # do something with $key and $value
}

# another way
set searchId [array startsearch ARRAY]
while {[set key [array nextelement ARRAY $searchId]] ne {}} {
    set value $ARRAY($key)
    # do something with $key and $value
}

foreach {food color} [array get foodColor] {
    puts "$food is $color."
}
# => Banana is yellow.
# => Apple is red.
# => Carrot is orange.
# => Lemon is yellow.

set searchId [array startsearch foodColor]
while {[set food [array nextelement foodColor $searchId]] ne {}} {
    set color $foodColor($food)
    puts "$food is $color."
}
# => Banana is yellow.
# => Apple is red.
# => Carrot is orange.
# => Lemon is yellow.


# countfrom - count number of messages from each sender
if {[llength $argv] > 0} {
    if {[catch {set f [open [lindex $argv 0]]} err]} {
        error $err
    }
} else {
    set f stdin
}
 
while {[gets $f line] >= 0} {
    if {[regexp {^From: (.*)} $line --> name]} {
        if {[info exists from($name)]} {
            incr from($name)
        } else {
            set from($name) 1
        }
    }
}

if {[array size from] == 0} {
    puts "No senders found"
    exit
}
 
foreach person [lsort [array names from]] {
    puts "$person: $from($person)"
}

# print each member of the array...
foreach {k v} [array get ARRAY] {
    puts "$k => $v"
}

# ...or print all of it at once...
puts [array get ARRAY]

# ...or copy it to a list variable and print that...
set temp [array get ARRAY]
puts $temp

# ...or use the inspection command [parray]
parray ARRAY

# print with sorted keys
foreach {k} [lsort [array names ARRAY]] {
    puts "$k => $ARRAY($k)"
}

# @@INCOMPLETE@@
# @@INCOMPLETE@@

# A list is a string in Tcl, so there is
# no problem storing multiple values as an
# array ("hash") item.



array set ttys [list]
 
set WHO [open "|who"]
while {[gets $WHO line] > -1} {
    foreach {user tty} [split $line] break
    lappend ttys($user) $tty
}
close $WHO
 
foreach user [lsort [array names ttys]] {
    puts "$user: $ttys($user)"
}

# dummy code; there is no getpwuid command
foreach user [lsort [array names ttys]] {
    puts "$user: [llength $ttys($user)] ttys."
     
    foreach tty [lsort $ttys($user)] {
        if {![catch {file stat /dev/$tty stat}]} {
            set user [lindex [getpwuid $stat(uid)] 0]
        } else {
            set user "(not available)"
        }
        puts "\t$tty (owned by $user)" 
    }
}

proc multihash_delete {arrayname key value} {
    upvar $arrayname array
    set i {}
     
    set len [llength $array($key)]
    for {set i 0} {$i < $len} {incr i} {
        if {[lindex $array($key) $i] eq $value} {
            lset array($key) [lreplace $array($key) $i $i]
            break
        }
    }
     
    if {[llength $array($key)] <= 0} {
        array unset array $key
    }
}

#-----------------------------
package require struct 1.4
array set REVERSE [::struct::list reverse [array get LOOKUP]]
#-----------------------------

# foodfind - find match for food or color
package require struct 1.4
proc foodfind foodOrColor {
        array set color {
                Apple   red
                Banana  yellow
                Lemon   yellow
                Carrot  orange
        }
        array set food [::struct::list reverse [array get color]]
        if {[info exists color($foodOrColor)]} {
                puts "$foodOrColor is a food with color $color($foodOrColor)."
        }
        if {[info exists food($foodOrColor)]} {
                puts "$food($foodOrColor) is a food with color $foodOrColor."
        }
}

foreach {f c} [array get color] {
        lappend food($c) $f
}
puts "[join $food(yellow)] were yellow foods."

#-----------------------------
# a is the array to sort
set keys [lsort OPTIONS [array names a]]
foreach key $keys {
        set value $a($key)
        # do something with $key, $value
}
#-----------------------------
foreach food [lsort [array names foodColor]] {
        puts "$food is $foodColor($food)."
}
#-----------------------------
proc sortFoods {a b} {
        expr {[string length $a] - [string length $b]}
}
foreach food [lsort -command sortFoods [array names foodColor]] {
        lappend foods $food
}
foreach food $foods {
        puts "$food is $foodColor($food)."
}
#-----------------------------

#-----------------------------
array set merged [concat [array get A] [array get B]]
#-----------------------------
array unset merged
foreach {k v} [array get A] {
        set merged($k) $v
}
foreach {k v} [array get B] {
        set merged($k) $v
}
#-----------------------------
# foodColor as per the introduction
array set drinkColor {
        Galliano        yellow
        "Mai Tai"       blue
}
array set ingestedColor [concat [array get drinkColor] [array get foodColor]]
#-----------------------------
# foodColor per the introduction, then
array set drinkColor {
        Galliano        yellow
        "Mai Tai"       blue
}
array unset ingestedColor
foreach {k v} [array get foodColor] {
        set ingestedColor($k) $v
}
foreach {k v} [array get drinkColor] {
        set ingestedColor($k) $v
}
#-----------------------------
foreach substanceref {foodColor drinkColor} {
        foreach {k v} [array get $substanceref] {
                set substanceColor($k) $v
        }
}
#-----------------------------
foreach substanceref {foodColor drinkColor} {
        foreach {k v} [array get $substanceref] {
                if {[info exists substanceColor($k)]} {
                        puts "Warning: $k seen twice.  Using the first definition."
                        continue
                }
                set substanceColor($k) $v
        }
}

#-----------------------------

#-----------------------------
set common {}
foreach k [array names arr1] {
        if {[info exists arr2($k)]} {
                lappend common $k
        }
}
# common now contains common keys
#-----------------------------
set thisNotThat {}
foreach k [array names arr1] {
        if {![info exists arr2($k)]} {
                lappend thisNotThat $k
        }
}
#-----------------------------
# foodColor per the introduction

# citrusColor is an array mapping citrus food name to its color.
array set citrusColor {
        Lemon   yellow
        Orange  orange
        Lime    green
}

# build up a list of non-citrus foods
set nonCitrus {}

foreach k [array names foodColor] {
        if {![info exists citrusColor($k)]} {
                lappend nonCitrus $k
        }
}
#-----------------------------

#-----------------------------

#-----------------------------

# @@INCOMPLETE@@
# @@INCOMPLETE@@

#-----------------------------

#-----------------------------

# @@INCOMPLETE@@
# @@INCOMPLETE@@

#-----------------------------

#-----------------------------

array unset count
foreach element $LIST {
        if {![info exists count($element)]} {
                set count($element) 1
        } else {
                incr count($element)
        }
}

#-----------------------------

#-----------------------------

array set father {
        Cain            Adam
        Abel            Adam
        Seth            Adam
        Enoch           Cain
        Irad            Enoch
        Mehujael        Irad
        Methusael       Mehujael
        Lamech          Methusael
        Jabal           Lamech
        Jubal           Lamech
        Tubalcain       Lamech
        Enos            Seth
}
#-----------------------------
foreach name {Adam Tubalcain Elvis Enos} {
        set fathers {}
        while {[info exists father($name)]} {    ;# if <name> has a father
                lappend fathers $name            ;# add it to the list
                set name $father($name)         ;# and check the father's father
        }
        puts $fathers
}
#-----------------------------

foreach {k v} [array get father] {
        lappend children($v) $k
}
set sep {, }                ;# separate output with commas
foreach name {Adam Tubalcain Elvis Lamech} {
        if {[info exists children($name)] && [llength children($name)]} {
                set res $children($name)
        } else {
                set res nobody
        }
        puts "$name begat [join $res $sep]"
}
#-----------------------------

foreach file $files {
        if {[catch {open $file} F]} {
                puts stderr "Couldn't read $file: $F; skipping."
                continue
        }
        while {[gets $F line] >= 0} {
                if {![regexp {^\s*#\s*include\s*<([^>]+)>} $line --> name]} {
                        continue
                }
                lappend includes($name) $file
        }
        close $F
}
#-----------------------------

set includeFree {}                  ;# list of files that don't include others
foreach k [array names includes] {
        set uniq($k) {}
}
forech file [lsort [array names uniq]] {
        if {![info exists includes($file)]} {
                lappend includeFree $file
        }
}

#-----------------------------

#-----------------------------

# @@INCOMPLETE@@
# @@INCOMPLETE@@

#-----------------------------