Version 9 of foreach little friends

Updated 2007-01-08 09:25:58 by suchenwi

iu2 - started on Jan 7 2007


1. Enjoying coding: Pressing letter keys, not arrow keys

There is often a need to introduce a new variable inside a foreach loop. For example, given:

 foreach x $list {
   puts $x
 }

in order to count the list's items during the loop I may do:

 set c -1
 foreach x $list {
   incr c
   puts "$c. $x"
 }

While not so bad I still prefer not introducing new variables because

  • Having to go backwards to set new variables doesn't feel very pleasant. Coding feels good when it flows forward, especially inside loops. By coding I mean typing the code.
  • If there is a need for more than one variable it begins to feel messy
  • It makes me feel like coding in C... from tcl I would expect something else

I think this what mapping lists, filtering lists, lists comprehension and lambdas are all about: Make code typing flow forward. They also make the code clearer, beacuse understanding syntax is easier than exploring algorithms.

This is a valid syntax (in python)

 res = [2*x for x in lis]

but this is an algorithm:

 res = []
 for x in lis:
   res += [2*x]

and it remains an algorithms even if it is written like this

  set res {}; foreach x $lis {lappend res $x}

This is better

 proc mult2 x {expr $x*2}
 set res [struct::list map $res mult2]

but not as good as this one

 set res [struct::list map $res {apply {x {expr $x*2}}}

I guess this is why there are so many pages here about looping, lambdas, etc.. Well, this is another one.. ;-)

2. Introducing a counter inside a foreach

We start straight from eliminating set c -1

  set list {a b c d e f g}

  foreach x $list c [struct::list iota [llength $list]] {
    puts "$c. $x"
  }

With a little help from

  proc counters list {
    for {set c 0} {$c < [llength $list]} {incr c} {
      lappend res $c
    }
    return $res
  }

we can go

  foreach x $list c [counters $list] {
    puts "$c. $x"
  }

This is the Python way

  proc enumerate list {
    set c 0
    foreach x $list {
      lappend res $c $x
      incr c
    }
    return $res
  }

  foreach {c x} [enumerate $list] {
    puts "$c. $x"
  }

but I prefer the previous one, which is more foreach-y.

3. First iteration commands

This code

  foreach x $list first 1 {
   if {$first == 1} {set c 0} else {incr c}
   puts "$c. $x"
  }

introduces the a variable first which is set to 1 in the first iteration and then becomes "" for all the rest. Since first is in foreach's arguments list, it doesn't realy seem like going back and setting a new variable.

This code sums up a list

  set numbers {1 2 3 4 5 6 7 8 9 10}

  foreach x $numbers first 1 {
    if {$first == 1} {set sum $x} else {incr sum $x}
  }
  puts $sum

  Result
  55

and this one finds the maximum

  set numbers2 {-2 -4 -1 -3 0 10 3}

  foreach x $numbers2 first 1 {
    if {$first == 1 || $x > $max} {set max $x}
  }
  puts $max

  Result
  10

4. Little functions giving a Common Lisp flavour

Instead of first, let's call that variable enablecl, standing for Enable Common Lisp.

  proc incrementing {var} {
    uplevel 1 [list if {$enablecl == 1} [list set $var 0] else [list incr $var]]
  }

  # test
  foreach x $list enablecl 1 {
    incrementing c1
    puts "$c1. $x"
  }

Let's add more functions like that

  proc summing {exp into var} {
    uplevel 1 [list if {$enablecl == 1} [list set $var $exp] else [list incr $var $exp]]
  }

  proc counting {cond into var} {
    uplevel 1 [list if {$enablecl == 1} [list set $var 0]]
    uplevel 1 [list if $cond [list incr $var]]
  }

and give them a try

  set numbers {1 2 3 4 5 6 7 8 9 10 11}

  # test
  foreach x $numbers enablecl 1 {
    summing $x into sum1
    summing [expr 2*$x] into sum2
    counting 1 into count
    counting {int($x)/2*2 == $x} into even
    counting "int($x)/2*2 != $x" into odd
  }
  puts "$sum1, $sum2, $count steps, $even evens, $odd odds"

  Result:
  66, 132, 11 steps, 5 evens, 6 odds  

Nice.

Maximum and minimum took me a while to figure out...

  proc maximizing {exp into var} {
    uplevel 1 [list if {$enablecl == 1} [list set $var $exp]]
    uplevel [list if [concat $exp > $$var] [list set $var $exp]]
  }

  proc minimizing {exp into var} {
    uplevel 1 [list if {$enablecl == 1} [list set $var $exp]]
    uplevel [list if [concat $exp < $$var] [list set $var $exp]]
  }

  set numbers2 {-2 -4 -1 -3 0 10 3}

  # test
  foreach x $numbers2 enablecl 1 {
    maximizing $x into max
    minimizing $x into min
    puts $x,$max,$min
  }
  puts $max,$min

We advance towards list comprehension by introducing appending

  proc appending {exp into var} {
    uplevel 1 [list if {$enablecl == 1} [list set $var [list $exp]] else [list lappend $var $exp]]
  }

  # test
  foreach x $numbers enablecl 1 {
    appending $x into nums
    appending "Number $x" into strings
    if {$x > 5} {appending [expr 2*$x] into twice}  ;# a list comprehension...
    if {[set res [expr $x+1]] > 5} {appending $res into plus1} ;# and an improvement
  }
  puts [join $nums ,]
  puts [join $strings \n]
  puts [join $twice ", "]
  puts [join $plus1 ", "]

Adding a bit more syntax to appending makes it more intersting

  proc appending {exp into var {if if} {cond 1}} {
    uplevel 1 [list if {$enablecl == 1} [list set $var {}]]
    set res [uplevel 1 [list subst $exp]]
    uplevel 1 [regsub -all -- {%\yr\y} [list if $cond [list lappend $var $res]] $res]
  }

  # test
  foreach x {1 2 3 4} y {5 6 7 8} enablecl 1 {
    appending [expr $x+$y] into sums2 if {%r > 8}
  }
  puts [join $sums2]

More stuff

  proc toggling {into var} {
    uplevel 1 [list if {$enablecl == 1} [list set $var 0]]
    uplevel 1 [list if {$enablecl != 1} [list set $var [uplevel 1 [list expr 1-$$var]]]]
  }

  # test
  foreach x {1 2 3 4} enablecl 1 {
    toggling into togl
    puts "$x - $togl"
  }

This is a general form of updating a variable each iteration

  proc updating {init exp into var} {
    uplevel 1 [list if {$enablecl == 1} [list set $var $init]]
    uplevel 1 [list set $var [uplevel 1 $exp]]
  }

  # test
  foreach x {1 2 3 4 5} enablecl 1 {
    updating 0 {expr $count+1} into count
    updating 0 {expr $sum2+$x} into sum2
    updating 1 {expr $mult*$x} into mult
    updating {} {lappend mult2 [expr 2*$x]} into mult2
  }

  # print result
  foreach x {count sum2 mult mult2} {puts "$x: [set $x]"}

  Result:
  count: 5
  sum2: 15
  mult: 120
  mult2: 2 4 6 8 10  

  # another test
  foreach x {1 2 3 4 5 6 7 8 9 10 11 12} enablecl 1 {
    updating -1 {expr ($cyc+1)%3} into cyc
    puts "x: $x, cyc: $cyc"
  }

The last test leads to another idea

  proc cycling {exp into var} {
    uplevel 1 [list if {$enablecl == 1} [list set $var -1]]
    uplevel 1 [list set $var [uplevel 1 [list expr ($$var+1)%$exp]]]
  }

  # test  
  foreach x {1 2 3 4 5 6 7 8 9 10 11 12} enablecl 1 {
    cycling 3 into cyc
    puts "x: $x, cyc: $cyc"
  }

I often write lists as rows, each row having col_count items, so

  foreach number $list enablecl 1 {
    puts -nonewline "$number "
    cycling $col_count into cyc
    if {$cyc == $col_count-1} {puts ""}
  }

because of that last example, I just can't resist extending cycling a little bit...

  proc cycling {exp into var args} {
    uplevel 1 [list if {$enablecl == 1} [list set $var -1]]
    uplevel 1 [list set $var [uplevel 1 [list expr ($$var+1)%$exp]]]
    set condcount 0
    foreach {on list what} $args {
      # if {[uplevel 1 [list set $var]] in $list} tcl 8.5
      if {[lsearch $list [uplevel 1 [list set $var]]] > -1} {uplevel 1 $what; incr condcount} else {
        if {$on eq "else" && $condcount == 0} {uplevel 1 $list}
      }
    }
  }

  # test  
  foreach x {1 2 3 4 5 6 7 8 9 10 11 12} enablecl 1 {
    puts -nonewline "$x "
    cycling 3 into cyc on 2 {puts ""}
  }

  # or even this
  foreach x {1 2 3 4 5 6 7 8 9 10 11 12} enablecl 1 {
    puts -nonewline "$x"
    cycling 3 into cyc on 2 {puts ""} else {puts -nonewline " "}
  }

  # another test
  foreach x {1 2 3 4 5 6 7 8 9 10 11 12} enablecl 1 {
    cycling 4 into cyc on 0 {puts "start: cyc=$cyc"} on 3 {puts "last: cyc=$cyc"} on {1 2} {puts "middle: cyc=$cyc"}
    puts $cyc
  }

5. Helper functions with a helper variable

The following example uses another variable besides var

  proc cyclelist {hlpvar list into var} {
    uplevel 1 [list if {$enablecl == 1} [list set $hlpvar -1]]
    set len [llength $list]
    set index [uplevel 1 [list set $hlpvar]]
    set index [expr ($index+1)%$len]
    uplevel 1 [list set $hlpvar $index]
    uplevel 1 [list set $var [lindex $list $index]]
  }

  # test  
  foreach x {1 2 3 4 5 6 7 8 9 10 11 12 13 14} enablecl 1 {
    cyclelist cyc1 {one two three four} into cyc2
    puts "$x $cyc2 ($cyc1)"
  }

6. Summary

  • With these little helpers foreach-ing can be more readable, more fun and more press letter keys, not arrow keys ;-)
  • I'm sure more functions of this type can be introduced
  • There still may be bugs in them, so bug fixes are welcome
  • I'm not sure the uplevel 1 [list if... way I use is the best. Shorter or more readable formats will be appreciated.

LES on same day:

 set res [struct::list map $res {apply {x {expr $x*2}}}

You call that "readable"?


iu2 well, yes, beacuse I recognize a structure: map-list-apply.


RS Due to the path structure, the first part is a bit cluttered. If you seriously use map, it might help to

 interp alias {} map {} struct::list map

and then code (remember to brace your expr-essions :^)

 set res [map $res {apply {x {expr {$x*2}}}}]