new files

Task/Balanced-ternary/Tcl/balanced-ternary-1.tcl

@@ -0,0 +1,57 @@
+package require Tcl 8.5
+
+proc bt-int b {
+    set n 0
+    foreach c [split $b ""] {
+	set n [expr {$n * 3}]
+	switch -- $c {
+	    + { incr n 1  }
+	    - { incr n -1 }
+	}
+    }
+    return $n
+}
+proc int-bt n {
+    if {$n == 0} {
+	return "0"
+    }
+    while {$n != 0} {
+	lappend result [lindex {0 + -} [expr {$n % 3}]]
+	set n [expr {$n / 3 + ($n%3 == 2)}]
+    }
+    return [join [lreverse $result] ""]
+}
+
+proc bt-neg b {
+    string map {+ - - +} $b
+}
+proc bt-sub {a b} {
+    bt-add $a [bt-neg $b]
+}
+proc bt-add-digits {a b c} {
+    if {$a eq ""} {set a 0}
+    if {$b eq ""} {set b 0}
+    if {$a ne 0} {append a 1}
+    if {$b ne 0} {append b 1}
+    lindex {{0 -1} {+ -1} {- 0} {0 0} {+ 0} {- 1} {0 1}} [expr {$a+$b+$c+3}]
+}
+proc bt-add {a b} {
+    set c 0
+    set result {}
+    foreach ca [lreverse [split $a ""]] cb [lreverse [split $b ""]] {
+	lassign [bt-add-digits $ca $cb $c] d c
+	lappend result $d
+    }
+    if {$c ne "0"} {lappend result [lindex {0 + -} $c]}
+    if {![llength $result]} {return "0"}
+    string trimleft [join [lreverse $result] ""] 0
+}
+proc bt-mul {a b} {
+    if {$a eq "0" || $a eq "" || $b eq "0"} {return "0"}
+    set sub [bt-mul [string range $a 0 end-1] $b]0
+    switch -- [string index $a end] {
+	0 { return $sub }
+	+ { return [bt-add $sub $b] }
+	- { return [bt-sub $sub $b] }
+    }
+}

Task/Balanced-ternary/Tcl/balanced-ternary-2.tcl

@@ -0,0 +1,10 @@
+for {set i 0} {$i<=10} {incr i} {puts "$i = [int-bt $i]"}
+puts "'+-+'+'+--' = [bt-add +-+ +--] = [bt-int [bt-add +-+ +--]]"
+puts "'++'*'++' = [bt-mul ++ ++] = [bt-int [bt-mul ++ ++]]"
+
+set a "+-0++0+"
+set b [int-bt -436]
+set c "+-++-"
+puts "a = [bt-int $a], b = [bt-int $b], c = [bt-int $c]"
+set abc [bt-mul $a [bt-sub $b $c]]
+puts "a*(b-c) = $abc (== [bt-int $abc])"