134 lines
3.8 KiB
Plaintext
134 lines
3.8 KiB
Plaintext
(seed (in "/dev/urandom" (rd 8)))
|
|
|
|
(de unpad (Lst)
|
|
(while (=0 (car Lst))
|
|
(pop 'Lst) )
|
|
Lst )
|
|
|
|
(de numz (N)
|
|
(let Fibs (1 1)
|
|
(while (>= N (+ (car Fibs) (cadr Fibs)))
|
|
(push 'Fibs (+ (car Fibs) (cadr Fibs))) )
|
|
(make
|
|
(for I (uniq Fibs)
|
|
(if (> I N)
|
|
(link 0)
|
|
(link 1)
|
|
(dec 'N I) ) ) ) ) )
|
|
|
|
(de znum (Lst)
|
|
(let Fibs (1 1)
|
|
(do (dec (length Lst))
|
|
(push 'Fibs (+ (car Fibs) (cadr Fibs))) )
|
|
(sum
|
|
'((X Y) (unless (=0 X) Y))
|
|
Lst
|
|
(uniq Fibs) ) ) )
|
|
|
|
(de incz (Lst)
|
|
(addz Lst (1)) )
|
|
|
|
(de decz (Lst)
|
|
(subz Lst (1)) )
|
|
|
|
(de addz (Lst1 Lst2)
|
|
(let Max (max (length Lst1) (length Lst2))
|
|
(reorg
|
|
(mapcar + (need Max Lst1 0) (need Max Lst2 0)) ) ) )
|
|
|
|
(de subz (Lst1 Lst2)
|
|
(use (@A @B)
|
|
(let
|
|
(Max (max (length Lst1) (length Lst2))
|
|
Lst (mapcar - (need Max Lst1 0) (need Max Lst2 0)) )
|
|
(loop
|
|
(while (match '(@A 1 0 0 @B) Lst)
|
|
(setq Lst (append @A (0 1 1) @B)) )
|
|
(while (match '(@A 1 -1 0 @B) Lst)
|
|
(setq Lst (append @A (0 0 1) @B)) )
|
|
(while (match '(@A 1 -1 1 @B) Lst)
|
|
(setq Lst (append @A (0 0 2) @B)) )
|
|
(while (match '(@A 1 0 -1 @B) Lst)
|
|
(setq Lst (append @A (0 1 0) @B)) )
|
|
(while (match '(@A 2 0 0 @B) Lst)
|
|
(setq Lst (append @A (1 1 1) @B)) )
|
|
(while (match '(@A 2 -1 0 @B) Lst)
|
|
(setq Lst (append @A (1 0 1) @B)) )
|
|
(while (match '(@A 2 -1 1 @B) Lst)
|
|
(setq Lst (append @A (1 0 2) @B)) )
|
|
(while (match '(@A 2 0 -1 @B) Lst)
|
|
(setq Lst (append @A (1 1 0) @B)) )
|
|
(while (match '(@A 1 -1) Lst)
|
|
(setq Lst (append @A (0 1))) )
|
|
(while (match '(@A 2 -1) Lst)
|
|
(setq Lst (append @A (1 1))) )
|
|
(NIL (match '(@A -1 @B) Lst)) )
|
|
(reorg (unpad Lst)) ) ) )
|
|
|
|
(de mulz (Lst1 Lst2)
|
|
(let (Sums (list Lst1) Mulz (0))
|
|
(mapc
|
|
'((X)
|
|
(when (= 1 (car X))
|
|
(setq Mulz (addz (cdr X) Mulz)) )
|
|
Mulz )
|
|
(mapcar
|
|
'((X)
|
|
(cons
|
|
X
|
|
(push 'Sums (addz (car Sums) (cadr Sums))) ) )
|
|
(reverse Lst2) ) ) ) )
|
|
|
|
(de divz (Lst1 Lst2)
|
|
(let Q 0
|
|
(while (lez Lst2 Lst1)
|
|
(setq Lst1 (subz Lst1 Lst2))
|
|
(setq Q (incz Q)) )
|
|
(list Q (or Lst1 (0))) ) )
|
|
|
|
(de reorg (Lst)
|
|
(use (@A @B)
|
|
(let Lst (reverse Lst)
|
|
(loop
|
|
(while (match '(@A 1 1 @B) Lst)
|
|
(if @B
|
|
(inc (nth @B 1))
|
|
(setq @B (1)) )
|
|
(setq Lst (append @A (0 0) @B) ) )
|
|
(while (match '(@A 2 @B) Lst)
|
|
(inc
|
|
(if (cdr @A)
|
|
(tail 2 @A)
|
|
@A ) )
|
|
(if @B
|
|
(inc (nth @B 1))
|
|
(setq @B (1)) )
|
|
(setq Lst (append @A (0) @B)) )
|
|
(NIL
|
|
(or
|
|
(match '(@A 1 1 @B) Lst)
|
|
(match '(@A 2 @B) Lst) ) ) )
|
|
(reverse Lst) ) ) )
|
|
|
|
(de lez (Lst1 Lst2)
|
|
(let Max (max (length Lst1) (length Lst2))
|
|
(<= (need Max Lst1 0) (need Max Lst2 0)) ) )
|
|
|
|
(let (X 0 Y 0)
|
|
(do 1024
|
|
(setq X (rand 1 1024))
|
|
(setq Y (rand 1 1024))
|
|
(test (numz (+ X Y)) (addz (numz X) (numz Y)))
|
|
(test (numz (* X Y)) (mulz (numz X) (numz Y)))
|
|
(test (numz (+ X 1)) (incz (numz X))) )
|
|
|
|
(do 1024
|
|
(setq X (rand 129 1024))
|
|
(setq Y (rand 1 128))
|
|
(test (numz (- X Y)) (subz (numz X) (numz Y)))
|
|
(test (numz (/ X Y)) (car (divz (numz X) (numz Y))))
|
|
(test (numz (% X Y)) (cadr (divz (numz X) (numz Y))))
|
|
(test (numz (- X 1)) (decz (numz X))) ) )
|
|
|
|
(bye)
|