Version 20 of nested list

Updated 2009-02-25 16:24:23 by andy

A nested list is simply a list that occurs as an element of another list (which may of course itself be an element of another list, etc.).

Common reasons nested lists arise are:

  1. They're matrices (a list of rows, where each row is itself a list, or a list of columns where each column is itself a list).
  2. Lists are being used for what in other languages is known as structs, records, or tuples -- collections of data with a fixed structure.
  3. A tree is encoded as a list where the subtrees occur as elements (hence lists are nested as deeply as the tree is high).

[Discuss when using a nested list is important or useful - what are cases where it is a good solution]

Before Tcl 8.4, nested lists were quite difficult to work with -- getting nested elements required nesting lindex commands, and the nightmare of setting elements in nested lists without the help of lset is better forgotten -- and as a result older code often uses arrays even in cases where the first-class data status (being possible to pass by value) of a list would have been very useful.

[Discuss which Tcl built in commands can be used to build, search, and maintain the list]



LISP-style lists

In LISP, lists are built by linking "cons cells", which is simply a pair of values (typically implemented close to the hardware, e.g. as a C-struct of two pointers; a Tcl_Obj is a higher level concept) where the first (the head) by convention is the first list element and the second (the tail) is the rest of the list; in the last cell of a list the tail pointer is NULL. The following is (yet another) implementation of this, with Tcl lists of length 2 serving as cons cells. It is probably not of any practical interest.

FM: Maybe an higher concept level has some higher conceptuals properties. Who knows ? A Tcl'ers is always dealing with such things, so why do not have some proc to experiment with it ?

Purely nested list (constant length of 2):

#############################
# ensemble of commands      #
#############################
set nl2 {
        {} {append {} {}}        
        {} {assign {} {}}
        {} {concat {} {}}
        {} {flat {} {}}
        {} {index {} {}}
        {} {insert {} {}}
        is {
                {} {left {} {}}
                {} {right {} {}}
                {} {mixed {} {}}
        }
        {} {join {} {}}
        {} {left {} {}}
        {} {length {} {}}
        {} {merge {} {}}
        {} {merge-left {} {}}
        {} {merge-right {} {}}
        {} {merge-dict {} {}}
        {} {range {} {}}
        {} {repeat {} {}}
        {} {reverse {} {}}
        {} {right {} {}}
        {} {search {} {}}
        {} {sort {} {}}
        {} {set {} {}}
        {} {transpose {} {}}
        {} {type {} {}}
        {} {!{type} {} {}}
}

# extra tool
proc ::assemble {NS} {
    foreach ns [::concat [::namespace children $NS] $NS] {
        if {([::namespace children $ns] ne "") && ($ns ne $NS)} {
            ::assemble $ns
        } else {
            ::namespace eval "$ns" {
                ::set Map [list]
                foreach c [::info commands [namespace current]::*] {
                    ::lappend Map [namespace tail $c] $c
                }
                ::namespace ensemble create -map $Map
            }
        }
    }
}

console show
namespace eval nl2 {
    proc append {L args} {
        # nl2 append ...
        ::upvar $L nl
        ::if {[nl2 is left $nl]} {
                ::for {::set i 0} {[::llength [::lindex $nl {*}$i]]!=0} {::lappend i 0} {}
                ::lset nl {*}$i [nl2 left {*}$args]
        } elseif {[nl2 is right $nl]} {
                ::for {::set i 1} {[::llength [::lindex $nl {*}$i]]!=0} {::lappend i 1} {}
                ::lset nl {*}$i [nl2 right {*}$args]
        } else {
            ::foreach e $args {
                ::lappend nl $e
            }
        }      
    }
    proc assign {L varname args} {
        # nl2 assign ...
        if {[nl2 is left $L]} {
            return [nl2 left {*}[uplevel [subst {lassign {[nl2 flat $L]} $varname $args}]]]
        } elseif {[nl2 is right $L]} {
            return [nl2 right {*}[uplevel [subst {lassign {[nl2 flat $L]} $varname $args}]]]
        }
    }
    proc concat {} {
        # nl2 concat ...
        # to do
    }
    proc flat {L} {
        # nl2 flat ...
        ::if {[nl2 is left $L]} {
            ::for {::set i 1} {[::llength [::lindex $L {*}$i]]!=0} {::set i [::linsert $i 0 0]} {
                ::lappend Res {*}[::lindex $L {*}$i]
            }
            return $Res
        } elseif {[nl2 is right $L]} {
            ::for {::set i 0} {[::llength [::lindex $L {*}$i]]!=0} {::set i [::linsert $i 0 1]} {
                ::lappend Res {*}[::lindex $L {*}$i]
            }
            return $Res
        }
    }
    proc index {L args} {
        # nl2 index ...
        ::return [::lindex [nl2 flat $L] $args]     
    }
    proc insert {L index element args} {
        # nl2 insert ...
        if {[nl2 is left $L]} {
                ::return [nl2 left {*}[linsert [nl2 flat $L] $index $element {*}$args]]
        } elseif {[nl2 is right $L]} {
                ::return [nl2 right {*}[linsert [nl2 flat $L] $index $element {*}$args]]
        }  
    }
    namespace eval is {
        proc left {L} {
            # nl2 is left ...
            ::set res 1
            ::if {[::llength $L] == 2 && [::llength [::lindex $L 0]] == 0} {
                    ::set res 1
            } elseif {[::llength $L] == 2 && [::llength [::lindex $L 0]] == 2} {
                    ::set res [nl2 is left [::lindex $L 0]]
            } else {
                    ::set res 0
            }
            ::set res               
        }
        proc mixed {L} {
            # nl2 is mixed ...
            set res 0
            if {[set type [nl2 type $L]] eq ""} {return $res}
            set res 1
            foreach e [nl2 index $L] {
                expr {$res && ([nl2 !type $e] eq $type)}
            }
            return $res
        }
        proc right {L} {
            # nl2 is right ...
            ::set res 1
            ::if {[::llength $L] == 2 && [::llength [::lindex $L 1]] == 0} {
                    ::set res 1
            } elseif {[::llength $L] == 2 && [::llength [::lindex $L 1]] == 2} {
                    ::set res [nl2 is right [::lindex $L 1]]
            } else {
                    ::set res 0
            }
            ::set res            
        }
    }
    proc join {L {sz { }}} {
        # nl2 join ...
        ::join [nl2 flat $L] $sz
    }
    proc left {args} {
        # nl2 left ...
        ::set L [::list ""]
        ::set i 0
        ::foreach e $args {
            if {[llength $e] != 1} {
                ::lset L {*}$i [::list "" [list $e]]
            } else {
                ::lset L {*}$i [::list "" $e]
            }
            ::lappend i 0
        }
        ::return {*}$L  
    }
    proc length {L} {
        # nl2 length ...
        ::set j 1
        ::if {[nl2 is left $L]} {
                ::for {::set i 0} {[::llength [::lindex $L {*}$i]]!=0} {::lappend i 0; incr j} {}
        } elseif {[nl2 is right $L]} {
                ::for {::set i 1} {[::llength [::lindex $L {*}$i]]!=0} {::lappend i 1; incr j} {}
        } else {
            ::set res 0
        }
        ::return $j
    }
    proc merge {L0 L1} {
        if {[nl2 is left $L0] && [nl2 is right $L1]} {
            ::set L [list {}]; ::set i {}
            foreach x [nl2 index $L0] y [nl2 index $L1] {
                lset L 0 {*}$i [list $x {} $y]
                ::set i [linsert $i 0 1]
            }
            return $L
        } elseif {[nl2 is left $L1] && [nl2 is right $L0]} {
            ::set L [list {}]; ::set i {}
            foreach x [nl2 index $L1] y [nl2 index $L0] {
                lset L 0 {*}$i [list $x {} $y]
                ::set i [linsert $i 0 1]
            }
            return $L
        }
    }
    proc merge-dict {L0 L1} {
        if {[nl2 is left $L0] && [nl2 is right $L1]} {
            foreach e0 [nl2 index $L0] e1 [nl2 index $L1] {
                ::lappend L $e0 $e1
            }
            return $L
        } elseif {[nl2 is left $L1] && [nl2 is right $L0]} {
            foreach e0 [nl2 index $L0] e1 [nl2 index $L1] {
                ::lappend L $e0 $e1
            }
            return $L
        }
    }
    proc merge-left {L0 L1} {
        if {[nl2 is left $L0] && [nl2 is right $L1]} {
            ::set L [list {}]; ::set i {}
            foreach x [nl2 index $L0] y [nl2 index $L1] {
                lset L 0 {*}$i [list {} $x $y]
                ::set i [linsert $i 0 0]
            }
            return $L
        } elseif {[nl2 is left $L1] && [nl2 is right $L0]} {
            ::set L [list {}]; ::set i {}
            foreach x [nl2 index $L1] y [nl2 index $L0] {
                lset L 0 {*}$i [list {} $x $y]
                ::set i [linsert $i 0 0]
            }
            return $L
        }
    }

    proc merge-right {L0 L1} {
        if {[nl2 is left $L0] && [nl2 is right $L1]} {
            ::set L [list {}]; ::set i {}
            foreach x [nl2 index $L0] y [nl2 index $L1] {
                lset L 0 {*}$i [list $x $y {}]
                ::set i [linsert $i 0 2]
            }
            return $L
        } elseif {[nl2 is left $L1] && [nl2 is right $L0]} {
            ::set L [list {}]; ::set i {}
            foreach x [nl2 index $L1] y [nl2 index $L0] {
                lset L 0 {*}$i [list $x $y {}]
                ::set i [linsert $i 0 2]
            }
            return $L
        }
    }

    proc range {L debut fin} {
        # nl2 range ...
        if {[nl2 is left $L]} {
                ::return [nl2 left {*}[::lrange [nl2 flat $L] $debut $fin]]
        } elseif {[nl2 is right $L]} {
                ::return [nl2 right {*}[::lrange [nl2 flat $L] $debut $fin]]
        }   
    }
    namespace eval repeat {
        proc left {count element args} {
            # nl2 left repeat ...
            ::return [nl2 left {*}[lrepeat $count $element {*}$args]]
        }
        proc right {count element args} {
            # nl2 left repeat ...
            ::return [nl2 right {*}[lrepeat $count $element {*}$args]]
        }
    }
    proc reverse {L} {
        # nl2 reverse ...
        if {[nl2 is left $L]} {
            return [nl2 left {*}[lreverse [nl2 flat $L]]]
        } elseif {[nl2 is right $L]} {
            return [nl2 right {*}[lreverse [nl2 flat $L]]]
        }
    }
    proc right {args} {
        # nl2 right ...
        ::set L [::list ""]
        ::set i 0
        ::foreach e $args {
            if {[llength $e] != 1} {
                ::lset L {*}$i [::list [::list $e] ""]
            } else {
                ::lset L {*}$i [::list $e ""]
            }
            ::lappend i 1
        }
        ::return {*}$L 
    }
    proc search {args} {
        # nl2 search ...
        ::set options [lassign [lreverse $args] pattern L]
        if {"-inline" in $options} {
                if {[nl2 is left $L]} {
                        ::return [nl2 left {*}[::lsearch {*}$options [nl2 flat $L] $pattern]]
                } elseif {[nl2 is right $L]} {
                        ::return [nl2 right {*}[::lsearch {*}$options [nl2 flat $L] $pattern]]
                }
        } else {
                ::return [::lsearch {*}$options [nl2 flat $L] $pattern]
        }
    }
    proc sort {args} {
        # nl2 sort ...
        ::set options [lassign [lreverse $args] L]
        if {[nl2 is left $L]} {
                ::return [nl2 left {*}[lsort {*}$options [nl2 flat $L]]]
        } elseif {[nl2 is right $L]} {
                ::return [nl2 right {*}[lsort {*}$options [nl2 flat $L]]]
        }
    }
    proc set {args} {
        # nl2 set ...
        ::set args [lassign $args L]
        upvar $L nl
        ::set index [lassign [lreverse $args] newValue]
        if {[nl2 is left $nl]} {
                ::set nl [nl2 flat $nl]
                ::return [::set nl [nl2 left {*}[lset nl {*}$index $newValue]]]
        } elseif {[nl2 is right $nl]} {
                ::set nl [nl2 flat $nl]
                ::return [::set nl [nl2 right {*}[lset nl {*}$index $newValue]]]
        }
    }
    proc transpose {L} {
        # nl2 transpose ...
        ::if {[nl2 is left $L]} {
            ::return [nl2 right {*}[nl2 flat $L]]
        } elseif {[nl2 is right $L]} {
            ::return [nl2 left {*}[nl2 flat $L]]
        }
    }
    proc type {L} {
        if {[nl2 is right $L]} {
            return "right"
        } elseif {[nl2 is left $L]} {
            return "left"
        }
    }
    proc !type {L} {
        if {[nl2 is right $L]} {
            return "left"
        } elseif {[nl2 is left $L]} {
            return "right"
        }
    }
    ::assemble [namespace current]
}

package provide nl2 0.1

Closely the same interface than list, so easy to remember, with some extra func added. There is indoubtly some bugs, please tell me. let's test it :

puts [set Left [nl2 left 1 2 3]]
# {{{} 3} 2} 1
puts [nl2 is left $Left]
# 1
puts [nl2 type $Left]
# left
puts [nl2 !type $Left]
# right
puts "index 0 : [nl2 index $Left 0], index 1 : [nl2 index $Left 1], index 2 : [nl2 index $Left 2], index all : [nl2 index $Left]"
# index 0 : 1, index 1 : 2, index 2 : 3, index all : 1 2 3
puts [set Right [nl2 right A B C]]
# A {B {C {}}}
puts [expr {$Left eq $Right}]
# 0

The last command show the more interesting property : even with the same data, even sorted, Left nested list are always differents from Right nested list and that can be tested. It's like a basic type, since an extra information is encoding in the structure. Each kind of purely nested list could be seen as a different type, for instance

puts [nl2 merge $Left $Right]
# gives
# {1 {2 {3 {} C} B} A} 

ie a beautiful purely nested list of 3 constant length (look like a binary tree), which can be seen as another pseudo-type, different from 2-length-left-nested or 2-length-right-nested one. Let's imagine a proc which is use to configure a widget.

interp alias {} isOptions {} nl2 is left
interp alias {} isPack {} nl2 is right

proc confwidget {args} {
   foreach l $args {
      if {[isOptions $l]} {
         puts "widget configure {*}[nl2 index $l]"
      } elseif {[isPack $l]} {
         puts "pack configure widget {*}[nl2 index $l]"
      } else {  
         foreach {e0 e1} $l { 
            puts "bind widget $e0 $e1"
         }
      }
   }
}

set Option [nl2 left -bg red -borderwidth 2 -relief flat -text hello]
# {{{{{{{{} hello} -text} flat} -relief} 2} -borderwidth} red} -bg
set Pack [nl2 right -after Other -side left -expand 1 -fill both]
# -after {Other {-side {left {-expand {1 {-fill {both {}}}}}}}}
set Bind [dict create <Button-1> {script1} <Button-2> {script2}]
# <Button-1> script1 <Button-2> script2

confwidget $Option

# widget configure {*}-bg red -borderwidth 2 -relief flat -text hello

confwidget $Pack

# pack configure widget {*}-after Other -side left -expand 1 -fill both

confwidget $Bind

# bind widget <Button-1> script1
# bind widget <Button-2> script2

# or, doing with all kind :

confwidget $Pack $Option $Bind

# pack configure widget {*}-after Other -side left -expand 1 -fill both
# widget configure {*}-bg red -borderwidth 2 -relief flat -text hello
# bind widget <Button-1> script1
# bind widget <Button-2> script2

# in another order :

confwidget $Option $Pack $Bind

# widget configure {*}-bg red -borderwidth 2 -relief flat -text hello
# pack configure widget {*}-after Other -side left -expand 1 -fill both
# bind widget <Button-1> script1
# bind widget <Button-2> script2

Temporary conclusion : purely nested list can be used as a pseudo-type. Thats'not a big suprise. A C-struct can be easily indexed, and also verified, since its length in memory is constant. So should it-be for purely-nested list, since there llength are constant (at least if they are construct with a {} terminator). At each level of representation, high or low, this is the regularity of the structure which help programmer to deal with.