Zeckendorf arithmetic: Difference between revisions

From Rosetta Code
Content added Content deleted
(Added Racket)
Line 370: Line 370:
XOXOOOXOX *z XOXOOX = XOXOXOOOOOXOXOX # multiplication
XOXOOOXOX *z XOXOOX = XOXOXOOOOOXOXOX # multiplication
XOXOXOOOOOXOXOX /z XOO = XOOXOXOOOXOOX remainder XO # division
XOXOXOOOOOXOXOX /z XOO = XOOXOXOOOXOOX remainder XO # division
</pre>
</pre>

=={{header|Racket}}==
This implementation only handles natural (non-negative numbers). The algorithms for addition and subtraction use the techniques explained in the paper Efficient algorithms for Zeckendorf arithmetic (http://arxiv.org/pdf/1207.4497.pdf).

<lang racket> #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)
</lang>

{{output}}

<pre>888 + 111 = (1 0 1 0 0 0 1 0 0 1 0 1 0 0) + (1 0 0 1 0 0 0 0 0 1) = (1 0 0 0 0 0 0 0 0 0 1 0 1 0 1) = 999
888 - 111 = (1 0 1 0 0 0 1 0 0 1 0 1 0 0) - (1 0 0 1 0 0 0 0 0 1) = (1 0 0 1 0 0 0 1 0 0 0 0 1 0) = 777
8 * 111 = (1 0 0 0 0) * (1 0 0 1 0 0 0 0 0 1) = (1 0 1 0 0 0 1 0 0 1 0 1 0 0) = 888
9876 / 1000 = (1 0 1 0 0 0 1 0 1 0 0 0 0 0 0 1 0 0 1) / (1 0 0 0 0 0 0 0 0 1 0 0 0 0 0) = (1 0 0 0 1) = 9
9876 % 1000 = (1 0 1 0 0 0 1 0 1 0 0 0 0 0 0 1 0 0 1) % (1 0 0 0 0 0 0 0 0 1 0 0 0 0 0) = (1 0 1 0 0 0 0 1 0 1 0 1 0 1) = 876
</pre>


=={{header|Scala}}==
=={{header|Scala}}==

Revision as of 12:01, 23 July 2013

Task
Zeckendorf arithmetic
You are encouraged to solve this task according to the task description, using any language you may know.

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. Optionally provide decrement, increment and comparitive operation functions.

Addition

Like binary 1 + 1 = 10, note carry 1 left. There the similarity ends. 10 + 10 = 101, note carry 1 left and 1 right. 100 + 100 = 1001, note carry 1 left and 2 right, this is the general case.

Occurrences of 11 must be changed to 100. Occurrences of 111 may be changed from the right by replacing 11 with 100, or from the left converting 111 to 100 + 100;

Subtraction

10 - 1 = 1. The general rule is borrow 1 right carry 1 left. eg: 

  abcde
  10100 -
   1000
  _____
    100  borrow 1 from a leaves 100
  + 100  add the carry
  _____
   1001

A larger example: 

  abcdef
  100100 -
    1000
  ______
  1*0100 borrow 1 from b
   + 100 add the carry
  ______
  1*1001

Sadly we borrowed 1 from b which didn't have it to lend. So now b borrows from a:

    1001
  + 1000 add the carry
    ____
   10100
Multiplication

Here you teach your computer its zeckendorf tables. eg. 101 * 1001: 

  a = 1 * 101 = 101
  b = 10 * 101 = a + a = 10000
  c = 100 * 101 = b + a = 10101
  d = 1000 * 101 = c + b = 101010

  1001 = d + a therefore 101 * 1001 =
 
  101010
   + 101
  ______
 1000100
Division

Lets try 1000101 divided by 101, so we can use the same table used for addition. 

  1000101 -
   101010 subtract d (1000 * 101)
  _______
     1000 -
      101 b and c are too large to subtract, so subtract a
     ____
        1 so 1000101 divided by 101 is d + a (1001) remainder 1

C++

Works with: C++11

<lang cpp>// For a class N which implements Zeckendorf numbers: // I define an increment operation ++() // I define a comparison operation <=(other N) // I define an addition operation +=(other N) // I define a subtraction operation -=(other N) // Nigel Galloway October 28th., 2012

  1. include <iostream>

enum class zd {N00,N01,N10,N11}; class N { private: 

 int dVal = 0, dLen;
 void _a(int i) {
   for (;; i++) {
     if (dLen < i) dLen = i;
     switch ((zd)((dVal >> (i*2)) & 3)) {
       case zd::N00: case zd::N01: return;
       case zd::N10: if (((dVal >> ((i+1)*2)) & 1) != 1) return;
                     dVal += (1 << (i*2+1)); return;
       case zd::N11: dVal &= ~(3 << (i*2)); _b((i+1)*2);
 }}}
 void _b(int pos) {
   if (pos == 0) {++*this; return;}
   if (((dVal >> pos) & 1) == 0) {
     dVal += 1 << pos;
     _a(pos/2);
     if (pos > 1) _a((pos/2)-1);
     } else {
     dVal &= ~(1 << pos);
     _b(pos + 1);
     _b(pos - ((pos > 1)? 2:1));
 }}
 void _c(int pos) {
   if (((dVal >> pos) & 1) == 1) {dVal &= ~(1 << pos); return;}
   _c(pos + 1);
   if (pos > 0) _b(pos - 1); else ++*this;
   return;
 }

public: 

 N(char const* x = "0") {
   int i = 0, q = 1;
   for (; x[i] > 0; i++);
   for (dLen = --i/2; i >= 0; i--) {dVal+=(x[i]-48)*q; q*=2;
 }}
 const N& operator++() {dVal += 1; _a(0); return *this;}
 const N& operator+=(const N& other) {
   for (int GN = 0; GN < (other.dLen + 1) * 2; GN++) if ((other.dVal >> GN) & 1 == 1) _b(GN);
   return *this;
 }
 const N& operator-=(const N& other) {
   for (int GN = 0; GN < (other.dLen + 1) * 2; GN++) if ((other.dVal >> GN) & 1 == 1) _c(GN);
   for (;((dVal >> dLen*2) & 3) == 0 or dLen == 0; dLen--);
   return *this;
 }
 const N& operator*=(const N& other) {
   N Na = other, Nb = other, Nt, Nr;
   for (int i = 0; i <= (dLen + 1) * 2; i++) {
     if (((dVal >> i) & 1) > 0) Nr += Nb;
     Nt = Nb; Nb += Na; Na = Nt;
   }
   return *this = Nr;
 }
 const bool operator<=(const N& other) const {return dVal <= other.dVal;}
 friend std::ostream& operator<<(std::ostream&, const N&);

}; N operator "" N(char const* x) {return N(x);} std::ostream &operator<<(std::ostream &os, const N &G) { 

 const static std::string dig[] {"00","01","10"}, dig1[] {"","1","10"};
 if (G.dVal == 0) return os << "0";
 os << dig1[(G.dVal >> (G.dLen*2)) & 3];
 for (int i = G.dLen-1; i >= 0; i--) os << dig[(G.dVal >> (i*2)) & 3];
 return os;

} </lang>

Testing

The following tests addtition: <lang cpp>int main(void) { 

 N G;
 G = 10N;
 G += 10N;
 std::cout << G << std::endl;
 G += 10N;
 std::cout << G << std::endl;
 G += 1001N;
 std::cout << G << std::endl;
 G += 1000N;
 std::cout << G << std::endl;
 G += 10101N;
 std::cout << G << std::endl;
 return 0;

}</lang>

Output:
101
1001
10101
100101
1010000

The following tests subtraction: <lang cpp>int main(void) { 

 N G;
 G = 1000N;
 G -= 101N;
 std::cout << G << std::endl;
 G = 10101010N;
 G -= 1010101N;
 std::cout << G << std::endl;
 return 0;

}</lang>

Output:
1
1000000

The following tests multiplication: <lang cpp> int main(void) { 

 N G = 1001N;
 G *= 101N;
 std::cout << G << std::endl;

 G = 101010N;
 G += 101N;
 std::cout << G << std::endl;
 return 0;

}</lang>

Output:
1000100
1000100

Perl 6

This is a somewhat limited implementation of Zeckendorf arithmetic operators. They only handle positive integer values. There are no actual calculations, everything is done with string manipulations, so it doesn't matter what glyphs you use for 1 and 0.

Implemented arithmetic operators: 

 addition: +z
 subtraction: -z
 multiplication: *z
 division: /z (more of a divmod really)
 post increment: ++z
 post decrement: --z

Comparison operators: 

 equal eqz
 not equal nez
 greater than gtz
 less than ltz

<lang perl6> my $z1 = '1'; # glyph to use for a '1' my $z0 = '0'; # glyph to use for a '0'

sub zorder($a) { ($z0 lt $z1) ?? $a !! $a.trans([$z0, $z1] => [$z1, $z0]) };

                1. Zeckendorf comparison operators #########
  1. less than

sub infix:<ltz>($a, $b) { $a.&zorder lt $b.&zorder };

  1. greater than

sub infix:<gtz>($a, $b) { $a.&zorder gt $b.&zorder };

  1. equal

sub infix:<eqz>($a, $b) { $a eq $b };

  1. not equal

sub infix:<nez>($a, $b) { $a ne $b };


                1. Operators for Zeckendorf arithmetic ########
  1. post increment

sub postfix:<++z>($a is rw) { 

   $a = ("$z0$z0"~$a).subst(/("$z0$z0")($z1+ %% $z0)?$/, -> $/ { "$z0$z1" ~ $z0 x $1.chars });
   $a ~~ s/^$z0+//;
   $a

}

  1. post decrement

sub postfix:<--z>($a is rw) { 

   $a.=subst(/$z1($z0*)$/, -> $/ {$z0 ~ "$z1$z0" x $0.chars div 2 ~ $z1 x $0.chars mod 2});
   $a ~~ s/^$z0+(.+)$/$0/;
   $a

}

  1. addition

sub infix:<+z>($a is copy, $b is copy) { $a++z while $b--z nez $z0; $a };

  1. subtraction

sub infix:<-z>($a is copy, $b is copy) { $a--z while $b--z nez $z0; $a };

  1. multiplication

sub infix:<*z>($a, $b) { 

   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 { 
        my $e = $z0;
        repeat { $c++z; $e++z } until $e eqz $a;
        $d++z;
   } until $d eqz $b;
   $c

};

  1. division (really more of a div mod)

sub infix:</z>($a is copy, $b is copy) { 

   fail "Divide by zero" if $b eqz $z0;
   return $a if $a eqz $z0 or $b eqz $z1;
   my $c = $z0;
   repeat { 
       my $d = $b +z ($z1 ~ $z0);
       $c++z;
       $a--z while $d--z nez $z0
   } until $a ltz $b;
   $c ~= " remainder $a" if $a nez $z0;
   $c

};


                                            1. Testing ######################
  1. 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";

my $zeck = $z1;

printf( $fmt, "$zeck++z", $zeck++z, '# increment' ) for 1 .. 10;

printf $fmt, "$zeck +z {z('1010')}", $zeck +z= z('1010'), '# addition';

printf $fmt, "$zeck -z {z('100')}", $zeck -z= z('100'), '# subtraction';

printf $fmt, "$zeck *z {z('100101')}", $zeck *z= z('100101'), '# multiplication';

printf $fmt, "$zeck /z {z('100')}", $zeck /z= z('100'), '# division';

printf( $fmt, "$zeck--z", $zeck--z, '# decrement' ) for 1 .. 5;

printf $fmt, "$zeck *z {z('101001')}", $zeck *z= z('101001'), '# multiplication';

printf $fmt, "$zeck /z {z('100')}", $zeck /z= z('100'), '# division';</lang>

Testing Output 

Using the glyph '1' for 1 and '0' for 0

1++z                   =              10  # increment
10++z                  =             100  # increment
100++z                 =             101  # increment
101++z                 =            1000  # increment
1000++z                =            1001  # increment
1001++z                =            1010  # increment
1010++z                =           10000  # increment
10000++z               =           10001  # increment
10001++z               =           10010  # increment
10010++z               =           10100  # increment
10100 +z 1010          =          100101  # addition
100101 -z 100          =          100010  # subtraction
100010 *z 100101       =    100001000001  # multiplication
100001000001 /z 100    =       101010001  # division
101010001--z           =       101010000  # decrement
101010000--z           =       101001010  # decrement
101001010--z           =       101001001  # decrement
101001001--z           =       101001000  # decrement
101001000--z           =       101000101  # decrement
101000101 *z 101001    = 101010000010101  # multiplication
101010000010101 /z 100 = 1001010001001 remainder 10  # division

Output using 'X' for 1 and 'O' for 0: 

Using the glyph 'X' for 1 and 'O' for 0

X++z                   =              XO  # increment
XO++z                  =             XOO  # increment
XOO++z                 =             XOX  # increment
XOX++z                 =            XOOO  # increment
XOOO++z                =            XOOX  # increment
XOOX++z                =            XOXO  # increment
XOXO++z                =           XOOOO  # increment
XOOOO++z               =           XOOOX  # increment
XOOOX++z               =           XOOXO  # increment
XOOXO++z               =           XOXOO  # increment
XOXOO +z XOXO          =          XOOXOX  # addition
XOOXOX -z XOO          =          XOOOXO  # subtraction
XOOOXO *z XOOXOX       =    XOOOOXOOOOOX  # multiplication
XOOOOXOOOOOX /z XOO    =       XOXOXOOOX  # division
XOXOXOOOX--z           =       XOXOXOOOO  # decrement
XOXOXOOOO--z           =       XOXOOXOXO  # decrement
XOXOOXOXO--z           =       XOXOOXOOX  # decrement
XOXOOXOOX--z           =       XOXOOXOOO  # decrement
XOXOOXOOO--z           =       XOXOOOXOX  # decrement
XOXOOOXOX *z XOXOOX    = XOXOXOOOOOXOXOX  # multiplication
XOXOXOOOOOXOXOX /z XOO = XOOXOXOOOXOOX remainder XO  # division

Racket

This implementation only handles natural (non-negative numbers). The algorithms for addition and subtraction use the techniques explained in the paper Efficient algorithms for Zeckendorf arithmetic (http://arxiv.org/pdf/1207.4497.pdf).

<lang racket> #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) </lang>

Output:
888 + 111 = (1 0 1 0 0 0 1 0 0 1 0 1 0 0) + (1 0 0 1 0 0 0 0 0 1) = (1 0 0 0 0 0 0 0 0 0 1 0 1 0 1) = 999
888 - 111 = (1 0 1 0 0 0 1 0 0 1 0 1 0 0) - (1 0 0 1 0 0 0 0 0 1) = (1 0 0 1 0 0 0 1 0 0 0 0 1 0) = 777
8 * 111 = (1 0 0 0 0) * (1 0 0 1 0 0 0 0 0 1) = (1 0 1 0 0 0 1 0 0 1 0 1 0 0) = 888
9876 / 1000 = (1 0 1 0 0 0 1 0 1 0 0 0 0 0 0 1 0 0 1) / (1 0 0 0 0 0 0 0 0 1 0 0 0 0 0) = (1 0 0 0 1) = 9
9876 % 1000 = (1 0 1 0 0 0 1 0 1 0 0 0 0 0 0 1 0 0 1) % (1 0 0 0 0 0 0 0 0 1 0 0 0 0 0) = (1 0 1 0 0 0 0 1 0 1 0 1 0 1) = 876

Scala

Works with: Scala version 2.9.1

The addition is an implementation of an algorithm suggested in http[:]//arxiv.org/pdf/1207.4497.pdf: Efficient Algorithms for Zeckendorf Arithmetic. <lang Scala>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"

)

}</lang> Output: 

101Z(i:4) + 10100Z(i:11) = 100010Z(i:15)
101Z(i:4) - 10100Z(i:11) = -1010Z(i:-7)
101Z(i:4) * 10100Z(i:11) = 10010010Z(i:44)
101Z(i:4) / 10100Z(i:11) = 0Z(i:0)
-1010101Z(i:-33) + 10100Z(i:11) = -1000001Z(i:-22)
-1010101Z(i:-33) - 10100Z(i:11) = -10010010Z(i:-44)
-1010101Z(i:-33) * 10100Z(i:11) = -101010001010Z(i:-363)
-1010101Z(i:-33) / 10100Z(i:11) = -100Z(i:-3)
1000101010Z(i:109) + 10101010Z(i:54) = 10000101001Z(i:163)
1000101010Z(i:109) - 10101010Z(i:54) = 100000000Z(i:55)
1000101010Z(i:109) * 10101010Z(i:54) = 101000001000101001Z(i:5886)
1000101010Z(i:109) / 10101010Z(i:54) = 10Z(i:2)
10100Z(i:11) + 1010Z(i:7) = 101000Z(i:18)
100101Z(i:17) - 100Z(i:3) = 100001Z(i:14)
1010101010101010101Z(i:10945) + -1010101010101Z(i:-609) = 1010100000000000000Z(i:10336)
1010101010101010101Z(i:10945) - -1010101010101Z(i:-609) = 10000001010101010100Z(i:11554)
1010101010101010101Z(i:10945) * -1010101010101Z(i:-609) = -100010001000001001010010100100001Z(i:-6665505)
1010101010101010101Z(i:10945) / -1010101010101Z(i:-609) = -100101Z(i:-17)
1010101010101010101Z(i:10945) % -1010101010101Z(i:-609) = 1010100100100Z(i:592)
1010101010101010101Z(i:10945) + 101010101010101Z(i:1596) = 10000101010101010100Z(i:12541)
1010101010101010101Z(i:10945) - 101010101010101Z(i:1596) = 1010000000000000000Z(i:9349)
1010101010101010101Z(i:10945) * 101010101010101Z(i:1596) = 10001000100001010001001010001001001Z(i:17468220)
1010101010101010101Z(i:10945) / 101010101010101Z(i:1596) = 1001Z(i:6)
1010101010101010101Z(i:10945) % 101010101010101Z(i:1596) = 101000000001000Z(i:1369)
10101010101010101010Z(i:17710) + 1010101010101010Z(i:2583) = 100001010101010101001Z(i:20293)
10101010101010101010Z(i:17710) - 1010101010101010Z(i:2583) = 10100000000000000000Z(i:15127)
10101010101010101010Z(i:17710) * 1010101010101010Z(i:2583) = 1000100010001000000000001000100010001Z(i:45744930)
10101010101010101010Z(i:17710) / 1010101010101010Z(i:2583) = 1001Z(i:6)
10101010101010101010Z(i:17710) % 1010101010101010Z(i:2583) = 1010000000001000Z(i:2212)
1010Z(i:7) % 10Z(i:2) = 1Z(i:1)
1010Z(i:7) % -10Z(i:-2) = 1Z(i:1)
-1010Z(i:-7) % 10Z(i:2) = -1Z(i:-1)
-1010Z(i:-7) % -10Z(i:-2) = -1Z(i:-1)
100Z(i:3) / 0Z(i:0) = None
100Z(i:3) % 0Z(i:0) = None
elapsed time: 1 sec

Tcl

Translation of: Perl 6

<lang tcl>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

}</lang> Demonstrating: <lang tcl>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"]</lang>

Output:
101000
101
101000001
1
10100
Retrieved from "https://rosettacode.org/wiki/Zeckendorf_arithmetic?oldid=221062"