Fun with logicl set operations

# Logicl: fun with set operations in Tcl

# jcw, 15-02-2004

  package provide logicl 1
  package require Tcl 8.4

  proc logicl {args} { namespace eval logicl $args }

  namespace eval logicl {
    namespace export count enum union except intersect subset in

    proc count {x} {
      regexp -all 1 $x
    }

    proc enum {x} {
      set r {}
      foreach p [regexp -all -indices -inline 1 $x] {
        lappend r [lindex $p 0]
      }
      return $r
    }

    proc union {x y} {
      set i 0
      set r [split $x ""]
      foreach b [split $y ""] { if {$b} { lset r $i 1 }; incr i }
      join $r ""
    }  

    proc except {x y} {
      set i 0
      set r [split $x ""]
      foreach b [split $y ""] { if {$b} { lset r $i 0 }; incr i }
      join $r ""
    }  

    proc intersect {x y} {
      set i 0
      set r [split $x ""]
      foreach b [split $y ""] { if {!$b} { lset r $i 0 }; incr i }
      join $r ""
    }  

    proc subset {x y} {
      regsub -all 0 $x ? x
      string match $x $y
    }

    proc in {i x} {
      string index $x $i
    }
  }

# examples:

  set A 000001
  set B 000010
  set C 000101
  set D 001111
  set E 111100
  set F 111111
  set G 000000

  puts "A=$A B=$B C=$C D=$D E=$E F=$F G=$G"

  puts -nonewline "count: "
  foreach x {A B C D E F G} {
    puts -nonewline "  $x [logicl count [set $x]]"
  }
  puts ""

  puts -nonewline "enum:  "
  foreach x {A B C D E F G} {
    puts -nonewline "  $x [logicl enum [set $x]]"
  }
  puts ""

  foreach x {A A A C B D E F} y {A B C A A C D E} {
    puts -nonewline "$x vs $y:"
    foreach z {subset union except intersect} {
      puts -nonewline "  $z [logicl $z [set $x] [set $y]]"
    }
    puts ""
  }

  foreach x {0 1 2 3 4 5} {
    puts -nonewline "$x in:  "
    foreach y {A B C D E F G} {
      puts -nonewline "  $y [logicl in $x [set $y]]"
    }
    puts ""
  }

# output:

  #  A=000001 B=000010 C=000101 D=001111 E=111100 F=111111 G=000000
  #  counts:  A 1  B 1  C 2  D 4  E 4  F 6  G 0
  #  enum:    A 5  B 4  C 3 5  D 2 3 4 5  E 0 1 2 3  F 0 1 2 3 4 5  G 
  #  A vs A:  subset 1  union 000001  except 000000  intersect 000001
  #  A vs B:  subset 0  union 000011  except 000001  intersect 000000
  #  A vs C:  subset 1  union 000101  except 000000  intersect 000001
  #  C vs A:  subset 0  union 000101  except 000100  intersect 000001
  #  B vs A:  subset 0  union 000011  except 000010  intersect 000000
  #  D vs C:  subset 0  union 001111  except 001010  intersect 000101
  #  E vs D:  subset 0  union 111111  except 110000  intersect 001100
  #  F vs E:  subset 0  union 111111  except 000011  intersect 111100
  #  0 in:    A 0  B 0  C 0  D 0  E 1  F 1  G 0
  #  1 in:    A 0  B 0  C 0  D 0  E 1  F 1  G 0
  #  2 in:    A 0  B 0  C 0  D 1  E 1  F 1  G 0
  #  3 in:    A 0  B 0  C 1  D 1  E 1  F 1  G 0
  #  4 in:    A 0  B 1  C 0  D 1  E 0  F 1  G 0
  #  5 in:    A 1  B 0  C 1  D 1  E 0  F 1  G 0

Category Package