Sync

Task/Zeckendorf-arithmetic/00DESCRIPTION

@@ -1,4 +1,4 @@
-This task is a total immersion zeckendorf task, using decimal numbers will attract serious disapprobation.
+This task is a ''total immersion'' zeckendorf task; using decimal numbers will attract serious disapprobation.
 
 The task is to implement addition, subtraction, multiplication, and division using [[Zeckendorf number representation]]. [[Zeckendorf number representation#Using_a_C.2B.2B11_User_Defined_Literal|Optionally]] provide decrement, increment and comparitive operation functions.
 
@@ -55,7 +55,7 @@ Here you teach your computer its zeckendorf tables. eg. 101 * 1001:
 </pre>
 
 ;Division
-Lets try 1000101 divided by 101, so we can use the same table used for addition.
+Lets try 1000101 divided by 101, so we can use the same table used for multiplication.
 <pre>
   1000101 -
    101010 subtract d (1000 * 101)
@@ -65,3 +65,5 @@ Lets try 1000101 divided by 101, so we can use the same table used for addition.
      ____
         1 so 1000101 divided by 101 is d + a (1001) remainder 1
 </pre>
+
+[http://arxiv.org/pdf/1207.4497.pdf Efficient algorithms for Zeckendorf arithmetic] is interesting. The sections on addition and subtraction are particularly relevant for this task.

Task/Zeckendorf-arithmetic/00META.yaml

@@ -0,0 +1,2 @@
+---
+note: Arithmetic operations

Task/Zeckendorf-arithmetic/Perl-6/zeckendorf-arithmetic.pl6

@@ -1,20 +1,15 @@
 my $z1 = '1'; # glyph to use for a '1'
 my $z0 = '0'; # glyph to use for a '0'
 
-# helper sub to translate constants into the particular glyphs you used
-sub z($a) { $a.trans([<1 0>] => [$z1, $z0]) };
+sub zorder($a) { ($z0 lt $z1) ?? $a !! $a.trans([$z0, $z1] => [$z1, $z0]) };
 
 ######## Zeckendorf comparison operators #########
 
 # less than
-sub infix:<ltz>($a, $b) { ($z0 lt $z1) ?? ($a lt $b) !!
-    ($a.trans([$z1, $z0] => [<1 0>]) lt $b.trans([$z1, $z0] => [<1 0>]))
-};
+sub infix:<ltz>($a, $b) { $a.&zorder lt $b.&zorder };
 
 # greater than
-sub infix:<gtz>($a, $b) { ($z0 lt $z1) ?? ($a gt $b) !!
-    ($a.trans([$z1, $z0] => [<1 0>]) gt $b.trans([$z1, $z0] => [<1 0>]))
-};
+sub infix:<gtz>($a, $b) { $a.&zorder gt $b.&zorder };
 
 # equal
 sub infix:<eqz>($a, $b) { $a eq $b };
@@ -47,9 +42,9 @@ sub infix:<-z>($a is copy, $b is copy) { $a--z while $b--z nez $z0; $a };
 
 # multiplication
 sub infix:<*z>($a, $b) {
-    return $z0 if $a eq $z0 or $b eq $z0;
-    return $a if $b eq $z1;
-    return $b if $a eq $z1;
+    return $z0 if $a eqz $z0 or $b eqz $z0;
+    return $a if $b eqz $z1;
+    return $b if $a eqz $z1;
     my $c = $a;
     my $d = $z1;
     repeat {
@@ -77,6 +72,9 @@ sub infix:</z>($a is copy, $b is copy) {
 
 ###################### Testing ######################
 
+# helper sub to translate constants into the particular glyphs you used
+sub z($a) { $a.trans([<1 0>] => [$z1, $z0]) };
+
 say "Using the glyph '$z1' for 1 and '$z0' for 0\n";
 
 my $fmt = "%-22s = %15s  %s\n";

Task/Zeckendorf-arithmetic/Racket/zeckendorf-arithmetic.rkt

@@ -0,0 +1,195 @@
+#lang racket (require math)
+
+(define sqrt5 (sqrt 5))
+(define phi (* 0.5 (+ 1 sqrt5)))
+
+;; What is the nth fibonnaci number, shifted by 2 so that
+;; F(0) = 1, F(1) = 2, ...?
+;;
+(define (F n)
+  (fibonacci (+ n 2)))
+
+;; What is the largest n such that F(n) <= m?
+;;
+(define (F* m)
+  (let ([n (- (inexact->exact (round (/ (log (* m sqrt5)) (log phi)))) 2)])
+    (if (<= (F n) m) n (sub1 n))))
+
+(define (zeck->natural z)
+  (for/sum ([i (reverse z)]
+            [j (in-naturals)])
+    (* i (F j))))
+
+(define (natural->zeck n)
+  (if (zero? n)
+      null
+      (for/list ([i (in-range (F* n) -1 -1)])
+        (let ([f (F i)])
+          (cond [(>= n f) (set! n (- n f))
+                          1]
+                [else 0])))))
+
+; Extend list to the right to a length of len with repeated padding elements
+;
+(define (pad lst len [padding 0])
+  (append lst (make-list (- len (length lst)) padding)))
+
+; Strip padding elements from the left of the list
+;
+(define (unpad lst [padding 0])
+  (cond [(null? lst) lst]
+        [(equal? (first lst) padding) (unpad (rest lst) padding)]
+        [else lst]))
+
+;; Run a filter function across a window in a list from left to right
+;;
+(define (left->right width fn)
+  (λ (lst)
+    (let F ([a lst])
+      (if (< (length a) width)
+          a
+          (let ([f (fn (take a width))])
+            (cons (first f) (F (append (rest f) (drop a width)))))))))
+
+;; Run a function fn across a window in a list from right to left
+;;
+(define (right->left width fn)
+  (λ (lst)
+    (let F ([a lst])
+      (if (< (length a) width)
+          a
+          (let ([f (fn (take-right a width))])
+            (append (F (append (drop-right a width) (drop-right f 1)))
+                    (list (last f))))))))
+
+;; (a0 a1 a2 ... an) -> (a0 a1 a2 ... (fn ... an))
+;;
+(define (replace-tail width fn)
+  (λ (lst)
+    (append (drop-right lst width) (fn (take-right lst width)))))
+
+(define (rule-a lst)
+  (match lst
+    [(list 0 2 0 x) (list 1 0 0 (add1 x))]
+    [(list 0 3 0 x) (list 1 1 0 (add1 x))]
+    [(list 0 2 1 x) (list 1 1 0 x)]
+    [(list 0 1 2 x) (list 1 0 1 x)]
+    [else lst]))
+
+(define (rule-a-tail lst)
+  (match lst
+    [(list x 0 3 0) (list x 1 1 1)]
+    [(list x 0 2 0) (list x 1 0 1)]
+    [(list 0 1 2 0) (list 1 0 1 0)]
+    [(list x y 0 3) (list x y 1 1)]
+    [(list x y 0 2) (list x y 1 0)]
+    [(list x 0 1 2) (list x 1 0 0)]
+    [else lst]))
+
+(define (rule-b lst)
+  (match lst
+    [(list 0 1 1) (list 1 0 0)]
+    [else lst]))
+
+(define (rule-c lst)
+  (match lst
+    [(list 1 0 0) (list 0 1 1)]
+    [(list 1 -1 0) (list 0 0 1)]
+    [(list 1 -1 1) (list 0 0 2)]
+    [(list 1 0 -1) (list 0 1 0)]
+    [(list 2 0 0) (list 1 1 1)]
+    [(list 2 -1 0) (list 1 0 1)]
+    [(list 2 -1 1) (list 1 0 2)]
+    [(list 2 0 -1) (list 1 1 0)]
+    [else lst]))
+
+(define (zeck-combine op y z [f identity])
+  (let* ([bits (max (add1 (length y)) (add1 (length z)) 4)]
+         [f0 (λ (x) (pad (reverse x) bits))]
+         [f1 (left->right 4 rule-a)]
+         [f2 (replace-tail 4 rule-a-tail)]
+         [f3 (right->left 3 rule-b)]
+         [f4 (left->right 3 rule-b)])
+    ((compose1 unpad f4 f3 f2 f1 f reverse) (map op (f0 y) (f0 z)))))
+
+(define (zeck+ y z)
+  (zeck-combine + y z))
+
+(define (zeck- y z)
+  (when (zeck< y z) (error (format "~a" `(zeck-: cannot subtract since ,y < ,z))))
+  (zeck-combine - y z (left->right 3 rule-c)))
+
+(define (zeck* y z)
+  (define (M ry Zn Zn_1 [acc null])
+    (if (null? ry)
+        acc
+        (M (rest ry) (zeck+ Zn Zn_1) Zn
+           (if (zero? (first ry)) acc (zeck+ acc Zn)))))
+  (cond [(zeck< z y) (zeck* z y)]
+        [(null? y) null]               ; 0 * z -> 0
+        [else (M (reverse y) z z)]))
+
+(define (zeck-quotient/remainder y z)
+  (define (M Zn acc)
+    (if (zeck< y Zn)
+        (drop-right acc 1)
+        (M (zeck+ Zn (first acc)) (cons Zn acc))))
+  (define (D x m [acc null])
+    (if (null? m)
+        (values (reverse acc) x)
+        (let* ([v (first m)]
+               [smaller (zeck< v x)]
+               [bit (if smaller 1 0)]
+               [x_ (if smaller (zeck- x v) x)])
+          (D x_ (rest m) (cons bit acc)))))
+  (D y (M z (list z))))
+
+(define (zeck-quotient y z)
+  (let-values ([(quotient _) (zeck-quotient/remainder y z)])
+    quotient))
+
+(define (zeck-remainder y z)
+  (let-values ([(_ remainder) (zeck-quotient/remainder y z)])
+    remainder))
+
+(define (zeck-add1 z)
+  (zeck+ z '(1)))
+
+(define (zeck= y z)
+  (equal? (unpad y) (unpad z)))
+
+(define (zeck< y z)
+  ; Compare equal-length unpadded zecks
+  (define (LT a b)
+    (if (null? a)
+        #f
+        (let ([a0 (first a)] [b0 (first b)])
+          (if (= a0 b0)
+              (LT (rest a) (rest b))
+              (= a0 0)))))
+
+  (let* ([a (unpad y)] [len-a (length a)]
+         [b (unpad z)] [len-b (length b)])
+    (cond [(< len-a len-b) #t]
+          [(> len-a len-b) #f]
+          [else (LT a b)])))
+
+(define (zeck> y z)
+  (not (or (zeck= y z) (zeck< y z))))
+
+
+;; Examples
+;;
+(define (example op-name op a b)
+  (let* ([y (natural->zeck a)]
+         [z (natural->zeck b)]
+         [x (op y z)]
+         [c (zeck->natural x)])
+    (printf "~a ~a ~a = ~a ~a ~a = ~a = ~a\n"
+            a op-name b y op-name z x c)))
+
+(example '+ zeck+ 888 111)
+(example '- zeck- 888 111)
+(example '* zeck* 8 111)
+(example '/ zeck-quotient 9876 1000)
+(example '% zeck-remainder 9876 1000)

Task/Zeckendorf-arithmetic/Scala/zeckendorf-arithmetic.scala

@@ -0,0 +1,251 @@
+object ZA extends App {
+  import Stream._
+  import scala.collection.mutable.ListBuffer
+
+object Z {
+  // only for comfort and result checking:
+  val fibs: Stream[BigInt] = {def series(i:BigInt,j:BigInt):Stream[BigInt] = i #:: series(j,i+j); series(1,0).tail.tail.tail }
+  val z2i: Z => BigInt = z => (z.z.abs.toString.map(_.asDigit).reverse.zipWithIndex.map{case (v,i)=>v*fibs(i)}:\BigInt(0))(_+_)*z.z.signum
+
+  var fmts = Map(Z("0")->List[Z](Z("0")))   //map of Fibonacci multiples table of divisors
+
+  // get multiply table from fmts
+  def mt(z: Z): List[Z] = {fmts.getOrElse(z,Nil) match {case Nil => {val e = mwv(z); fmts=fmts+(z->e); e}; case l => l}}
+
+  // multiply weight vector
+  def mwv(z: Z): List[Z] = {
+    val wv = new ListBuffer[Z]; wv += z; wv += (z+z)
+    var zs = "11"; val upper = z.z.abs.toString
+    while ((zs.size<upper.size)) {wv += (wv.toList.last + wv.toList.reverse.tail.head); zs = "1"+zs}
+    wv.toList
+  }
+
+  // get division table (division weight vector)
+  def dt(dd: Z, ds: Z): List[Z] = {
+    val wv = new ListBuffer[Z]; mt(ds).copyToBuffer(wv)
+    var zs = ds.z.abs.toString; val upper = dd.z.abs.toString
+    while ((zs.size<upper.size)) {wv += (wv.toList.last + wv.toList.reverse.tail.head); zs = "1"+zs}
+    wv.toList
+  }
+}
+
+case class Z(var zs: String) {
+  import Z._
+  require ((zs.toSet--Set('-','0','1')==Set()) && (!zs.contains("11")))
+
+  var z: BigInt = BigInt(zs)
+  override def toString = z+"Z(i:"+z2i(this)+")"
+  def size = z.abs.toString.size
+
+  //--- fa(summand1.z,summand2.z) --------------------------
+  val fa: (BigInt,BigInt) => BigInt = (z1, z2) => {
+    val v =z1.toString.map(_.asDigit).reverse.padTo(5,0).zipAll(z2.toString.map(_.asDigit).reverse, 0, 0)
+    val arr1 = (v.map(p=>p._1+p._2):+0 reverse).toArray
+    (0 to arr1.size-4) foreach {i=>     //stage1
+      val a = arr1.slice(i,i+4).toList
+      val b = (a:\"")(_+_) dropRight 1
+      val a1 = b match {
+          case "020" => List(1,0,0, a(3)+1)
+          case "030" => List(1,1,0, a(3)+1)
+          case "021" => List(1,1,0, a(3))
+          case "012" => List(1,0,1, a(3))
+          case _     => a
+      }
+      0 to 3 foreach {j=>arr1(j+i) = a1(j)}
+    }
+    val arr2 = (arr1:\"")(_+_)
+      .replace("0120","1010").replace("030","111").replace("003","100").replace("020","101")
+      .replace("003","100").replace("012","101").replace("021","110")
+      .replace("02","10").replace("03","11")
+      .reverse.toArray
+    (0 to arr2.size-3) foreach {i=>     //stage2, step1
+      val a = arr2.slice(i,i+3).toList
+      val b = (a:\"")(_+_)
+      val a1 = b match {
+          case "110" => List('0','0','1')
+          case _     => a
+      }
+      0 to 2 foreach {j=>arr2(j+i) = a1(j)}
+    }
+    val arr3 = (arr2:\"")(_+_).concat("0").reverse.toArray
+    (0 to arr3.size-3) foreach {i=>     //stage2, step2
+      val a = arr3.slice(i,i+3).toList
+      val b = (a:\"")(_+_)
+      val a1 = b match {
+          case "011" => List('1','0','0')
+          case _     => a
+      }
+      0 to 2 foreach {j=>arr3(j+i) = a1(j)}
+    }
+    BigInt((arr3:\"")(_+_))
+  }
+
+  //--- fs(minuend.z,subtrahend.z) -------------------------
+  val fs: (BigInt,BigInt) => BigInt = (min,sub) => {
+    val zmvr = min.toString.map(_.asDigit).reverse
+    val zsvr = sub.toString.map(_.asDigit).reverse.padTo(zmvr.size,0)
+    val v = zmvr.zipAll(zsvr, 0, 0).reverse
+    val last = v.size-1
+    val zma = zmvr.reverse.toArray; val zsa = zsvr.reverse.toArray
+    for (i <- 0 to last reverse) {
+      val e = zma(i)-zsa(i)
+      if (e<0) {
+        zma(i-1) = zma(i-1)-1
+        zma(i) = 0
+        val part = Z((((i to last).map(zma(_))):\"")(_+_))
+        val carry = Z(("1".padTo(last-i,"0"):\"")(_+_))
+        val sum = part + carry; val sums = sum.z.toString
+        (1 to sum.size) foreach {j=>zma(last-sum.size+j)=sums(j-1).asDigit}
+        if (zma(i-1)<0) {
+          for (j <- 0 to i-1 reverse) {
+            if (zma(j)<0) {
+              zma(j-1) = zma(j-1)-1
+              zma(j) = 0
+              val part = Z((((j to last).map(zma(_))):\"")(_+_))
+              val carry = Z(("1".padTo(last-j,"0"):\"")(_+_))
+              val sum = part + carry; val sums = sum.z.toString
+              (1 to sum.size) foreach {k=>zma(last-sum.size+k)=sums(k-1).asDigit}
+            }
+          }
+        }
+      }
+      else zma(i) = e
+      zsa(i) = 0
+    }
+    BigInt((zma:\"")(_+_))
+  }
+
+  //--- fm(multiplicand.z,multplier.z) ---------------------
+  val fm: (BigInt,BigInt) => BigInt = (mc, mp) => {
+    val mct = mt(Z(mc.toString))
+    val mpxi = mp.toString.reverse.map(_.asDigit).zipWithIndex.filter(_._1 != 0).map(_._2)
+    (mpxi:\Z("0"))((fi,sum)=>sum+mct(fi)).z
+  }
+
+  //--- fd(dividend.z,divisor.z) ---------------------------
+  val fd: (BigInt,BigInt) => BigInt = (dd, ds) => {
+    val dst = dt(Z(dd.toString),Z(ds.toString)).reverse
+    var diff = Z(dd.toString)
+    val zd = ListBuffer[String]()
+    (0 to dst.size-1) foreach {i=>
+      if (dst(i)>diff) zd+="0" else {diff = diff-dst(i); zd+="1"}
+    }
+    BigInt(zd.mkString)
+  }
+
+  val fasig: (Z, Z) => Int = (z1, z2) => if (z1.z.abs>z2.z.abs) z1.z.signum else z2.z.signum
+  val fssig: (Z, Z) => Int = (z1, z2) =>
+    if ((z1.z.abs>z2.z.abs && z1.z.signum>0)||(z1.z.abs<z2.z.abs && z1.z.signum<0)) 1 else -1
+
+  def +(that: Z): Z =
+    if (this==Z("0")) that
+    else if (that==Z("0")) this
+    else if (this.z.signum == that.z.signum) Z((fa(this.z.abs.max(that.z.abs),this.z.abs.min(that.z.abs))*this.z.signum).toString)
+    else if (this.z.abs == that.z.abs) Z("0")
+    else Z((fs(this.z.abs.max(that.z.abs),this.z.abs.min(that.z.abs))*fasig(this, that)).toString)
+
+  def ++ : Z = {val za = this + Z("1"); this.zs = za.zs; this.z = za.z; this}
+
+  def -(that: Z): Z =
+    if (this==Z("0")) Z((that.z*(-1)).toString)
+    else if (that==Z("0")) this
+    else if (this.z.signum != that.z.signum) Z((fa(this.z.abs.max(that.z.abs),this.z.abs.min(that.z.abs))*this.z.signum).toString)
+    else if (this.z.abs == that.z.abs) Z("0")
+    else Z((fs(this.z.abs.max(that.z.abs),this.z.abs.min(that.z.abs))*fssig(this, that)).toString)
+
+  def -- : Z = {val zs = this - Z("1"); this.zs = zs.zs; this.z = zs.z; this}
+
+  def * (that: Z): Z =
+    if (this==Z("0")||that==Z("0")) Z("0")
+    else if (this==Z("1")) that
+    else if (that==Z("1")) this
+    else Z((fm(this.z.abs.max(that.z.abs),this.z.abs.min(that.z.abs))*this.z.signum*that.z.signum).toString)
+
+  def / (that: Z): Option[Z] =
+    if (that==Z("0")) None
+    else if (this==Z("0")) Some(Z("0"))
+    else if (that==Z("1")) Some(Z("1"))
+    else if (this.z.abs < that.z.abs) Some(Z("0"))
+    else if (this.z == that.z) Some(Z("1"))
+    else Some(Z((fd(this.z.abs.max(that.z.abs),this.z.abs.min(that.z.abs))*this.z.signum*that.z.signum).toString))
+
+  def % (that: Z): Option[Z] =
+    if (that==Z("0")) None
+    else if (this==Z("0")) Some(Z("0"))
+    else if (that==Z("1")) Some(Z("0"))
+    else if (this.z.abs < that.z.abs) Some(this)
+    else if (this.z == that.z) Some(Z("0") )
+    else this/that match {case None => None; case Some(z) => Some(this-z*that)}
+
+  def <  (that: Z): Boolean = this.z <  that.z
+  def <= (that: Z): Boolean = this.z <= that.z
+  def >  (that: Z): Boolean = this.z >  that.z
+  def >= (that: Z): Boolean = this.z >= that.z
+
+}
+
+val elapsed: (=> Unit) => Long = f => {val s = System.currentTimeMillis; f; (System.currentTimeMillis - s)/1000}
+
+val add:      (Z,Z) => Z = (z1,z2) => z1+z2
+val subtract: (Z,Z) => Z = (z1,z2) => z1-z2
+val multiply: (Z,Z) => Z = (z1,z2) => z1*z2
+val divide:   (Z,Z) => Option[Z] = (z1,z2) => z1/z2
+val modulo:   (Z,Z) => Option[Z] = (z1,z2) => z1%z2
+
+val ops = Map(("+",add),("-",subtract),("*",multiply),("/",divide),("%",modulo))
+
+val calcs = List(
+  (Z("101"),"+",Z("10100"))
+, (Z("101"),"-",Z("10100"))
+, (Z("101"),"*",Z("10100"))
+, (Z("101"),"/",Z("10100"))
+, (Z("-1010101"),"+",Z("10100"))
+, (Z("-1010101"),"-",Z("10100"))
+, (Z("-1010101"),"*",Z("10100"))
+, (Z("-1010101"),"/",Z("10100"))
+, (Z("1000101010"),"+",Z("10101010"))
+, (Z("1000101010"),"-",Z("10101010"))
+, (Z("1000101010"),"*",Z("10101010"))
+, (Z("1000101010"),"/",Z("10101010"))
+, (Z("10100"),"+",Z("1010"))
+, (Z("100101"),"-",Z("100"))
+, (Z("1010101010101010101"),"+",Z("-1010101010101"))
+, (Z("1010101010101010101"),"-",Z("-1010101010101"))
+, (Z("1010101010101010101"),"*",Z("-1010101010101"))
+, (Z("1010101010101010101"),"/",Z("-1010101010101"))
+, (Z("1010101010101010101"),"%",Z("-1010101010101"))
+, (Z("1010101010101010101"),"+",Z("101010101010101"))
+, (Z("1010101010101010101"),"-",Z("101010101010101"))
+, (Z("1010101010101010101"),"*",Z("101010101010101"))
+, (Z("1010101010101010101"),"/",Z("101010101010101"))
+, (Z("1010101010101010101"),"%",Z("101010101010101"))
+, (Z("10101010101010101010"),"+",Z("1010101010101010"))
+, (Z("10101010101010101010"),"-",Z("1010101010101010"))
+, (Z("10101010101010101010"),"*",Z("1010101010101010"))
+, (Z("10101010101010101010"),"/",Z("1010101010101010"))
+, (Z("10101010101010101010"),"%",Z("1010101010101010"))
+, (Z("1010"),"%",Z("10"))
+, (Z("1010"),"%",Z("-10"))
+, (Z("-1010"),"%",Z("10"))
+, (Z("-1010"),"%",Z("-10"))
+, (Z("100"),"/",Z("0"))
+, (Z("100"),"%",Z("0"))
+)
+
+// just for result checking:
+import Z._
+val iadd: (BigInt,BigInt) => BigInt = (a,b) => a+b
+val isub: (BigInt,BigInt) => BigInt = (a,b) => a-b
+val imul: (BigInt,BigInt) => BigInt = (a,b) => a*b
+val idiv: (BigInt,BigInt) => Option[BigInt] = (a,b) => if (b==0) None else Some(a/b)
+val imod: (BigInt,BigInt) => Option[BigInt] = (a,b) => if (b==0) None else Some(a%b)
+val iops = Map(("+",iadd),("-",isub),("*",imul),("/",idiv),("%",imod))
+
+println("elapsed time: "+elapsed{
+    calcs foreach {case (op1,op,op2) => println(op1+" "+op+" "+op2+" = "
+      +{(ops(op))(op1,op2) match {case None => None; case Some(z) => z; case z => z}}
+        .ensuring{x=>(iops(op))(z2i(op1),z2i(op2)) match {case None => None == x; case Some(i) => i == z2i(x.asInstanceOf[Z]); case i => i == z2i(x.asInstanceOf[Z])}})}
+  }+" sec"
+)
+
+}

Task/Zeckendorf-arithmetic/Tcl/zeckendorf-arithmetic-1.tcl

@@ -0,0 +1,75 @@
+namespace eval zeckendorf {
+    # Want to use alternate symbols? Change these
+    variable zero "0"
+    variable one "1"
+
+    # Base operations: increment and decrement
+    proc zincr var {
+	upvar 1 $var a
+	namespace upvar [namespace current] zero 0 one 1
+	if {![regsub "$0$" $a $1$0 a]} {append a $1}
+	while {[regsub "$0$1$1" $a "$1$0$0" a]
+		|| [regsub "^$1$1" $a "$1$0$0" a]} {}
+	regsub ".$" $a "" a
+	return $a
+    }
+    proc zdecr var {
+	upvar 1 $var a
+	namespace upvar [namespace current] zero 0 one 1
+	regsub "^$0+(.+)$" [subst [regsub "${1}($0*)$" $a "$0\[
+		string repeat {$1$0} \[regsub -all .. {\\1} {} x]]\[
+		string repeat {$1} \[expr {\$x ne {}}]]"]
+	    ] {\1} a
+	return $a
+    }
+
+    # Exported operations
+    proc eq {a b} {
+	expr {$a eq $b}
+    }
+    proc add {a b} {
+	variable zero
+	while {![eq $b $zero]} {
+	    zincr a
+	    zdecr b
+	}
+	return $a
+    }
+    proc sub {a b} {
+	variable zero
+	while {![eq $b $zero]} {
+	    zdecr a
+	    zdecr b
+	}
+	return $a
+    }
+    proc mul {a b} {
+	variable zero
+	variable one
+	if {[eq $a $zero] || [eq $b $zero]} {return $zero}
+	if {[eq $a $one]} {return $b}
+	if {[eq $b $one]} {return $a}
+	set c $a
+	while {![eq [zdecr b] $zero]} {
+	    set c [add $c $a]
+	}
+	return $c
+    }
+    proc div {a b} {
+	variable zero
+	variable one
+	if {[eq $b $zero]} {error "div zero"}
+	if {[eq $a $zero] || [eq $b $one]} {return $a}
+	set r $zero
+	while {![eq $a $zero]} {
+	    if {![eq $a [add [set a [sub $a $b]] $b]]} break
+	    zincr r
+	}
+	return $r
+    }
+    # Note that there aren't any ordering operations in this version
+
+    # Assemble into a coherent API
+    namespace export \[a-y\]*
+    namespace ensemble create
+}

Task/Zeckendorf-arithmetic/Tcl/zeckendorf-arithmetic-2.tcl

@@ -0,0 +1,5 @@
+puts [zeckendorf add "10100" "1010"]
+puts [zeckendorf sub "10100" "1010"]
+puts [zeckendorf mul "10100" "1010"]
+puts [zeckendorf div "10100" "1010"]
+puts [zeckendorf div [zeckendorf mul "10100" "1010"] "1010"]