Andreas Motzek
Published

Calc - The Lisp Spreadsheet

Did you ever wanted a spreadsheet that can do more than calculating with numbers? I did. And of course it can calculate many digits of Pi.

IntermediateProtip8 hours1,226
Calc - The Lisp Spreadsheet

Story

Read more

Custom parts and enclosures

Introduction

Please see this PDF for example use cases and download instructions.

Code

Calc.jar

Java
A spreadsheet that uses Lisp. Needs Java 11. Start with java -jar Calc.jar on the command line.
No preview (download only).

Example Spreadsheet 1

Lisp
This spreadsheet calculates 500 digits of Pi with the spigot algorithm of Stanley Rabinowitz and Stan Wagon. Open the sheet with Calc. Wait until the calculation is finished. Then double click cell A1 to see the digits of Pi.
<sheet><cell><column>A</column><row>1</row><formula>(pi 500)</formula></cell><program>(defproc pi (n)
  (let
    ((p 1)
     (s 0))
  (dotimes (i (* 4 n) (approximate s (expt 1/10 n)))
    (setq s (+ s p p))
    (setq p (* p (+ i 1) (/ (+ i i 3)))))))

(assert &quot;ten digits of pi&quot;
  (less? (abs (- (pi 10) 3.1415926535)) 0.0000000001))</program><module><name>expt</name><version>0</version><url>local:expt</url><description>Die Funktion expt erwartet zwei Argumente. Sie berechnet die Potenz erstes Argument hoch zweites Argument.</description><exports>expt</exports><body>(defproc expt (x e)
  (cond
    ((not (integer? e))
      (throw (quote error) &quot;exponent must be an integer&quot;))
    ((equal? e 0) 
      1)
    ((equal? e 1) 
      x)
    ((less? e 0) 
      (/ 1 (expt x (- e))))
    (t
      (let
        ((half-e (/ e 2)))
        (if
          (integer? half-e)
          (let
            ((half-expt (expt x half-e)))
            (* half-expt half-expt))
          (* x (expt x (- e 1))))))))

(assert &quot;raised by zero&quot;
  (equal? (expt 0 0) 1))

(assert &quot;raised by one&quot;
  (equal? (expt 3 1) 3))

(assert &quot;two raised by five&quot;
  (equal? (expt 2 5) 32))

(assert &quot;two raised by minus 2&quot;
  (equal? (expt 2 -2) 1/4))</body></module></sheet>

Example Spreadsheet 2

Lisp
The spreadsheet contains the module for turtle graphics. The module is used to draw a dragon curve. Open the sheet with Calc. Double click cell B1 after the calculation is finished to see the curve.
<sheet><cell><column>A</column><row>1</row><formula>8</formula></cell><cell><column>B</column><row>1</row><formula>(dragon-curve @a1)</formula></cell><program>#| dragon curve |#

(defproc dragon-curve (count)
  (let
    ((system 
      (new lindenmayer 
        (quote (f l r))
        (quote (x y)) 
        (quote (f x))  
        (quote (((x) (x l y f l)) ((y) (r f x r y))))))
     (graphics (new turtle)))
   (progn
     (left graphics 90)
     (pen-down graphics)
     (dolist (element (get-expansion system count) (get-picture graphics))
       (cond
         ((= element (quote f))
           (forward graphics 10))
         ((= element (quote l))
           (left graphics 90))
         ((= element (quote r))
           (right graphics 90))))))))</program><module><name>complex</name><version>7</version><url>local:complex</url><description>Dieses Modul definiert eine Datenstruktur fr komplexe Zahlen (complex), und die passenden Methoden fr die Grundrechenarten (add, sub, times und quotient). 

Die Methoden real und imaginary greifen auf den Real- und Imaginrteil der Zahl zu.

Die Funktion conjugate konjugiert eine komplexe Zahl. 

Die Methode zero? prft, ob eine komplexe Zahl 0 ist. 

Die Methode approximate nhert eine komplexe Zahl auf eine angegebene Genauigkeit.</description><exports>complex initialize real imaginary add sub times quotient conjugate zero? approximate</exports><body>(defstruct complex 
  (real imaginary) 
  (and (number? real) (number? imaginary)))

(defmethod simplify ((this complex))
  t
  (if
    (zero? (. this imaginary))
    (. this real)
    this))

(defmethod real (r) 
  (number? r)
  r)

(defmethod real ((this complex)) 
  t
  (. this real))

(defmethod imaginary (r) 
  (number? r)
  0)

(defmethod imaginary ((this complex)) 
  t
  (. this imaginary))

(defmethod add ((this complex) (that complex))
  t
  (simplify
    (new complex
      (+ (. this real) (. that real))
      (+ (. this imaginary) (. that imaginary)))))

(defmethod add ((this complex) r)
  (number? r)
  (add this (new complex r 0)))

(defmethod add (r (this complex))
  (number? r)
  (add (new complex r 0) this))

(defmethod sub ((this complex) (that complex))
  t
  (simplify
    (new complex
      (- (. this real) (. that real))
      (- (. this imaginary) (. that imaginary)))))

(defmethod sub ((this complex) r)
  (number? r)
  (sub this (new complex r 0)))

(defmethod sub (r (this complex))
  (number? r)
  (sub (new complex r 0) this))

(defmethod times ((this complex) (that complex))
  t
  (simplify 
    (new complex
      (- (* (. this real) (. that real))
         (* (. this imaginary) (. that imaginary)))
      (+ (* (. this real) (. that imaginary))
         (* (. this imaginary) (. that real))))))

(defmethod times ((this complex) r)
  (number? r)
  (times this (new complex r 0)))

(defmethod times (r (this complex))
  (number? r)
  (times (new complex r 0) this))

(defmethod conjugate ((this complex))
  t
  (if
    (zero? (. this imaginary))
    (. this real)
    (new complex
      (. this real)
      (- (. this imaginary)))))

(defmethod conjugate (r)
  (number? r)
  r)

(defmethod quotient ((this complex) r)
  (number? r)
  (simplify
    (new complex
      (/ (. this real) r)
      (/ (. this imaginary) r))))

(defmethod quotient ((this complex) (that complex))
  t
  (/ (* this (conjugate that))
     (* that (conjugate that))))

(defmethod quotient (r (this complex))
  (number? r)
  (quotient (new complex r 0) this))

(defmethod zero? ((this complex))
  t
  (and
    (zero? (. this real)) 
    (zero? (. this imaginary))))

(defmethod approximate ((this complex) precision)
  t
  (simplify
    (new complex
      (approximate (. this real) precision)
      (approximate (. this imaginary) precision))))</body></module><module><name>lindenmayer</name><version>3</version><url>local:lindenmayer</url><description>Die Klasse lindenmayer reprsentiert kontextfreie Lindenmayer-Systeme. Der Konstruktor erwartet vier Argumente

- Zeichen, die Konstanten sind,
- Zeichen, die fr Variablen stehen,
- ein Startwort, das aus Variablen und Konstanten gebildet werden kann und
- mehrere Ersetzungsregeln, von denen jede ein Wort auf ein anderes abbildet.

Der Konstruktor berprft, ob die Angaben ein kontextfreies Lindenmayer-System spezifizieren. 

Die Methode get-expansion liefert die count-fache Anwendung der Ersetzungsregeln auf das Startwort.</description><exports>lindenmayer initialize get-expansion</exports><body>(defclass lindenmayer ())

(defmethod initialize ((this lindenmayer) constants variables start rules)
  (and
    (every? symbol? constants)
    (every? symbol? variables)
    (every? symbol? start)
    (disjoint? constants variables)
    (let
      ((alphabet (union constants variables)))
      (and
        (null? (set-difference start alphabet))
        (every?
          (lambda (rule)
            (and
              (single? (first rule))
              (member? (first (first rule)) variables)
              (null? (set-difference (second rule) alphabet))))
          rules))))
  (progn
    (.= this start start)
    (.= this compiled-rules (compile-rules rules))
    (freeze this)))

(defproc compile-rules (rules) 
  (let
    ((table (make-hash-table)))
    (dolist (rule rules (freeze table))
      (put-hash-table-value table
        (first (first rule))
        (second rule)))))

(defmethod apply-rules ((this lindenmayer) word) 
  t
  (with-slots-read-only (compiled-rules) this
    (apply append
      (map-with
        (lambda (element)
          (aif
            (get-hash-table-value compiled-rules element)
            it
            (list element)))
        word))))

(defmethod get-expansion ((this lindenmayer) count) 
  t
  (let
    ((word (. this start)))
    (dotimes (index count word)
      (setq word (apply-rules this word)))))</body></module><module><name>square-root</name><version>7</version><url>local:square-root</url><description>Die Funktion square-root berechnet die Quadratwurzel einer positiven Zahl (erstes Argument)  mit einer gewnschten Genauigkeit (zweites Argument).</description><exports>square-root</exports><body>(defproc halley-square-root-next (a x)
  (- x 
    (/ (* 2 (- (* x x x) (* a x))) 
       (+ (* 3 x x) a))))

(defproc halley-square-root-iteration (a x delta)
  (let
    ((x-next (approximate (halley-square-root-next a x) delta)))
    (if
      (&lt; (abs (- (* x-next x-next) a)) delta)
      x-next
      (halley-square-root-iteration a x-next delta))))

(defproc square-root (a delta)
  (if
    (&lt; a 0)
    (throw (quote error) &quot;negative argument for square-root&quot;)
    (approximate 
      (halley-square-root-iteration a 1 (* delta delta)) 
      delta)))</body></module><module><name>polar-coordinates</name><version>3</version><url>local:polar-coordinates</url><description>Die Methode to-polar wandet eine komplexe Zahl (erstes Argument) in die Darstellung mit Polarkoordinaten um. Die gewnschte Genauigkeit kann angegeben werden (zweites Argument). Bei den Polarkoordinaten handelt es sich um eine zweielementige Liste mit Radius und Winkel im Bogenma. 

Die Methode from-polar macht die umgekehrte Transformation von einer Liste (erstes Argument) zu einer komplexen Zahl mit einer gewnschten Genauigkeit (zweites Argument). 

Die Methode abs berechnet den Betrag einer komplexen Zahl (erstes Argument) mit einer gewnschte Genauigkeit (zweites Argument). 

Die Funktion pi berechnet die Kreiszahl mit einer gewnschten Genauigkeit (einziges Argument) ber den Arkustangens. 

Die Funktion cosine-sine berechnet Cosinus und Sinus eines Winkels im Bogenma (erstes Argument) ber die komplexe Exponentialfunktion mit einer gewnschten Genauigkeit (zweites Argument). Die beiden Funktionswerte werden zusammen als komplexe Zahl zurckgegeben - der Cosinus als Realteil und der Sinus als Imaginrteil.</description><exports>to-polar from-polar abs pi cosine-sine</exports><body>(defmethod to-polar ((this complex) precision)
  t
  (list
    (square-root
      (* this (conjugate this))
      precision)
    (quadrant-arctangent
      (. this real)
      (. this imaginary)
      precision)))

(defmethod from-polar (pair precision)
  (list? pair)
  (from-polar
    (first pair)
    (second pair)
    precision))

(defmethod from-polar (radius angle precision)
  (and
    (number? radius)
    (&gt;= radius 0)
    (number? angle))
  (* radius (cosine-sine angle precision)))

(defproc quadrant-arctangent (x y precision)
  (if
    (= x 0)
    (if
      (&lt; y 0)
      (* 3/2 (pi precision))
      (* 1/2 (pi precision)))
    (let
      ((a (arctangent (/ y x) precision)))
      (if
        (&lt; x 0)
        (+ a (pi precision))
        a))))
      
(defproc arctangent (x precision)
  (cond
    ((&lt; x 0)
      (- (arctangent (- x) precision)))
    ((&gt; x 1)
      (- (* 1/2 (pi precision)) (arctangent (/ x) precision)))
    ((= x 1)
      (* 2 (arctangent (/ x (+ 1 (square-root (+ 1 (* x x)) precision))) precision)))
    (t
      (let
        ((summand nil)
         (sum 0)
         (power x)
         (divisor 1))
        (loop
          (setq summand (/ power divisor))
          (setq sum (+ sum summand))
          (setq power (* power x x))
          (setq divisor (if (greater? divisor 0) (- (+ divisor 2)) (+ (- divisor) 2)))
          (when (&lt; (abs summand) precision)
            (return (approximate sum precision))))))))

(defmethod abs (r precision)
  (number? r)
  (approximate (abs r) precision))

(defmethod abs ((this complex) precision)
  t
  (first (to-polar this precision)))

(defproc pi (precision)
  (- (* 16 (arctangent 1/5 precision))
     (* 4 (arctangent 1/239 precision))))

(defproc cosine-sine (x precision)
  (if
    (&gt; (abs x) 1/4)
    (let
      ((y (cosine-sine (/ x 2) precision)))
      (* y y))
    (let
      ((summand nil)
       (imaginary-unit (new complex 0 1))
       (sum 0)
       (power 1)
       (divisor 1)
       (index 1))
      (loop
        (setq summand (/ power divisor))
        (setq sum (+ sum summand))
        (setq power (* power x imaginary-unit))
        (setq divisor (* divisor index))
        (setq index (+ 1 index))
        (when (&lt; (* summand (conjugate summand)) (* precision precision))
          (return (approximate sum precision)))))))</body><dependency><name>complex</name><minimum-required-version>7</minimum-required-version><url>local:complex</url></dependency><dependency><name>square-root</name><minimum-required-version>7</minimum-required-version><url>local:square-root</url></dependency></module><module><name>turtle</name><version>7</version><url>local:turtle</url><description>Die Klasse turtle simuliert eine Schildkrte mit einem Stift, die sich ber Kommandos steuern lsst: 

Stift hoch (pen-up), 
Stift runter (pen-down), 
nach links drehen (left), 
nach rechts drehen (right), 
bewegen (forward), 
zu einem Punkt bewegen (move-to). 

Die Methode get-picture liefert schlielich das entstandene Bild.</description><exports>turtle initialize pen-up pen-down is-pen-down? right left set-heading round forward move-to get-polylines  get-bounds get-picture</exports><body>(defclass turtle ())

(defmethod initialize ((this turtle)) 
  t
  (progn
    (.= this position 0)
    (.= this heading 0)
    (.= this pen-state (quote up))
    (.= this current-polyline nil)
    (.= this polylines nil)
    (.= this *pi* (pi 1e-30))
    this))

(defmethod pen-up ((this turtle)) 
  t
  (progn
    (when (. this current-polyline)
      (.= this polylines
        (cons
          (reverse (. this current-polyline))
          (. this polylines)))
      (.= this current-polyline nil))
    (.= this pen-state (quote up))))

(defmethod pen-down ((this turtle)) 
  t
  (.= this pen-state (quote down)))

(defmethod is-pen-down? ((this turtle)) 
  t
  (= (. this pen-state) (quote down)))

(defmethod right ((this turtle) degrees) 
  t
  (set-heading this
    (- (. this heading) degrees)))

(defmethod left ((this turtle) degrees) 
  t
  (set-heading this
    (+ degrees (. this heading))))

(defmethod set-heading ((this turtle) heading) 
  t
  (cond
    ((&lt; heading 0)
      (set-heading this (+ 360 heading)))
    ((&lt; heading 360)
      (.= this heading heading))
    (t
      (set-heading this (- heading 360)))))

(defmethod round (x) 
  (number? x) 
  (floor (+ x 1/2)))

(defmethod round ((c complex)) 
  t
  (new complex
    (round (. c real))
    (round (. c imaginary))))

(defmethod forward ((this turtle) distance) 
  t
  (move-to this 
    (round 
      (+ (. this position) 
         (get-movement this distance)))))

(defmethod move-to ((this turtle) (next complex))
  (and
    (integer? (. next real))
    (integer? (. next imaginary)))
  (progn
    (when (is-pen-down? this)
      (.= this current-polyline
        (aif
          (. this current-polyline)
          (cons next it)
          (list next (. this position)))))
    (.= this position next)))

(defmethod move-to ((this turtle) next-x next-y) 
  t
  (move-to this (new complex next-x next-y)))

(defmethod move-to ((this turtle) next-x)
  (number? next-x)
  (move-to this next-x 0))

(defmethod get-movement ((this turtle) distance) 
  t
  (* distance (cosine-sine (get-radiant this) 1e-30)))

(defmethod get-radiant ((this turtle)) 
  t
  (* 2/360 (. this *pi*) (. this heading)))

(defmethod get-polylines ((this turtle)) 
  t
  (with-slots-read-only (current-polyline polylines) this
    (if
      current-polyline
      (cons current-polyline polylines)
      polylines)))

(defmethod get-bounds ((this turtle)) 
  t
  (let
    ((min-x nil) (min-y nil) (max-x nil) (max-y nil))
    (dolist (polyline (get-polylines this) (list min-x min-y (- max-x min-x) (- max-y min-y)))
      (dolist (point polyline)
        (when (or (null? min-x) (&lt; (real point) min-x)) 
          (setq min-x (real point)))
        (when (or (null? min-y) (&lt; (imaginary point) min-y)) 
          (setq min-y (imaginary point)))
        (when (or (null? max-x) (&gt; (real point) max-x)) 
          (setq max-x (real point)))
        (when (or (null? max-y) (&gt; (imaginary point) max-y)) 
          (setq max-y (imaginary point)))))))

(defmethod get-picture ((this turtle)) 
  t
  (let
    ((bounds (get-bounds this)))
    (grid
      (third bounds)
      (fourth bounds)
      (map-with
        (lambda (polyline)
          (map-with
            (lambda (point)
              (list (- (real point) (first bounds))
                (- (imaginary point) (second bounds))))
            polyline))
        (get-polylines this)))))</body><dependency><name>complex</name><minimum-required-version>7</minimum-required-version><url>local:complex</url></dependency><dependency><name>square-root</name><minimum-required-version>7</minimum-required-version><url>local:square-root</url></dependency><dependency><name>polar-coordinates</name><minimum-required-version>3</minimum-required-version><url>local:polar-coordinates</url></dependency></module></sheet>

calc-11.0-jar-with-dependencies.jar

Here you can find the current version of Calc.jar fresh from the build pipeline.

Credits

Andreas Motzek

Andreas Motzek

16 projects • 9 followers
I like algorithms, code, statistics and decisions based on them, solving difficult problems and, if possible, avoiding them elegantly.

Comments