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
