Andreas Motzek
Published © CC BY

Have an unused Raspberry Pi or other SBC?

If you have some unused Raspberry Pi or other single board computer waiting in the shelf, use it to build a computing grid.

IntermediateProtip4 hours1,277
Have an unused Raspberry Pi or other SBC?

Things used in this project

Story

Read more

Code

distributed-factorization.sheet.xml

XML
The sheet factorizes numbers with elliptic-curve factorization method. Open the file with Calc and enter the number in cell A1. You find the factors in cell B1.
<sheet><cell><column>A</column><row>1</row><formula>(+ (expt 3 65) (expt 4 65))</formula></cell><cell><column>B</column><row>1</row><formula>(sort (factorize @a1) less?)</formula></cell><cell><column>C</column><row>1</row><formula>(length (write-to-string @a1))</formula></cell><cell><column>D</column><row>1</row><formula>(apply * @b1)</formula></cell><cell><column>E</column><row>1</row><formula>(equal? @a1 @d1)</formula></cell><program>(defproc remote-search-factor (place product)
  (catch-and-apply
    (quote io-error)
    (lambda (name value)
      (if
        (member? place (get-places))
        (sleep 30000)
        (throw name value)))
    (at place (elliptic-curve-search-factor product))))

(defproc remote-thread-count (place)
   (catch-and-apply
     (quote io-error)
     (lambda (name value) 0)
     (max 1 (- (at place *thread-count*) 1)))
)

(defproc non-trivial-divisor? (factor product)
  (and
    (integer? factor)
    (greater? factor 1)
    (less? factor product)
    (integer? (/ product factor))))

(defproc remote-find-factor (place product channel)
  (dotimes (index (remote-thread-count place))
    (go
      (loop
        (when (closed-channel? channel)
          (return nil))
        (awhen
          (remote-search-factor place product)
          (when
            (non-trivial-divisor? it product)
            (send-on-channel channel it nil))
          (return nil))))))

(defproc distributed-find-factor (product)
  (let
    ((channel (make-channel 1))) 
    (ensure
      (dolist (place (cons nil (get-places)) (receive-from-channels (list channel) nil))
        (remote-find-factor place product channel))
      (close-channel channel))))

(defproc factorize (number)
  (if
    (less? number 2)
    nil
    (if
      (prime? number)
      (list number)
      (aif
        (trial-division-search-factors number)
        (append it (factorize (/ number (apply * it))))
        (let
          ((factor (distributed-find-factor number)))
          (append
            (factorize factor)
            (factorize (/ number factor))))))))</program><module><name>expt</name><version>1</version><uri>local:expt</uri><comment-de>Die Funktion expt erwartet zwei Argumente. Sie berechnet die Potenz erstes Argument hoch zweites Argument.</comment-de><comment-en></comment-en><export>expt</export><body>(defproc expt (x e)
  (cond
    ((not (integer? e))
      (throw (quote error) &quot;exponent must be an integer&quot;))
    ((= e 0) 
      1)
    ((= e 1) 
      x)
    ((&lt; 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><module><name>residue-class</name><version>4</version><uri>local:residue-class</uri><comment-de>Klassen und Methoden fr Restklassenringe</comment-de><comment-en></comment-en><export>residue-class-ring</export><export>residue-class</export><export>initialize</export><export>get-modulus</export><export>get-ring</export><export>same-ring?</export><export>get-value</export><export>zero?</export><export>add</export><export>sub</export><export>times</export><export>quotient</export><body>(defstruct residue-class-ring (modulus)
  (and
    (integer? modulus)
    (greater? modulus 1)))

(defmethod get-modulus ((this residue-class-ring))
  t
  (. this modulus))

#| residue class |#

(defclass residue-class ())

(defmethod initialize ((this residue-class) (ring residue-class-ring) value)
  (integer? value)
  (progn
    (.= this ring ring)
    (.= this value
      (with-slots-read-only (modulus) ring
        (if
          (&lt; value 0)
          (let
            ((pos-value (+ modulus (rem value modulus))))
              (if
                (= pos-value modulus)
                0
                pos-value))
            (rem value modulus))))
    (freeze this)))

(defmethod get-ring ((this residue-class))
  t
  (. this ring))

(defmethod get-value ((this residue-class))
  t
  (. this value))

(defmethod same-ring? ((this residue-class) (that residue-class))
  t
  (= (get-ring this) (get-ring that)))

(defmethod add ((this residue-class) (that residue-class))
  (same-ring? this that)
  (new residue-class
    (get-ring this)
    (+ (get-value this) (get-value that))))

(defmethod sub ((this residue-class) (that residue-class))
  (same-ring? this that)
  (new residue-class
    (get-ring this)
    (- (get-value this) (get-value that))))
  
(defmethod times ((this residue-class) (that residue-class))
  (same-ring? this that)
  (new residue-class
    (get-ring this)
    (* (get-value this) (get-value that))))

(defmethod quotient ((this residue-class) (that residue-class))
  (same-ring? this that)
  (new residue-class
    (get-ring this)
    (* (get-value this) 
       (catch-and-apply
         nil
         (lambda (name value)
           (throw 
             (quote no-multiplicative-inverse)
             (get-value that)))
         (modinv 
           (get-value that)
           (get-modulus (get-ring this)))))))

(defmethod zero? ((this residue-class))
  t
  (zero? (get-value this)))

#| unit test |#

(assert &quot;4 + 6 = 3 modulo 7&quot;
  (let
    ((ring (new residue-class-ring 7)))
    (= 
      (get-value 
        (+ (new residue-class ring 4) 
           (new residue-class ring 6)))
      3)))

(assert &quot;1 - 5 = 3 modulo 7&quot;
  (let
    ((ring (new residue-class-ring 7)))
    (= 
      (get-value 
        (- (new residue-class ring 1) 
           (new residue-class ring 5)))
      3)))

(assert &quot;2 * 4 = 1 modulo 7&quot;
  (let
    ((ring (new residue-class-ring 7)))
    (= 
      (get-value 
        (* (new residue-class ring 2) 
           (new residue-class ring 4)))
      1)))

(assert &quot;1 / 4 = 2 modulo 7&quot;
  (let
    ((ring (new residue-class-ring 7)))
    (= 
      (get-value 
        (/ (new residue-class ring 1) 
           (new residue-class ring 4)))
      2)))</body></module><module><name>elliptic-curve</name><version>0</version><uri>local:elliptic-curve</uri><comment-de>Eine elliptische Kurve E(A, B) mit 4 A + 27 B != 0 ist eine Kurve in der Ebene. Sie enthlt die Punkte (x y), die die Bedingung y = x + A x + B erfllen.

Instanzen der Klasse elliptic-curve speichern die Parameter a und b der Kurve und eine Instanz des Punktes in der Unendlichkeit.

Die Instanzen der Klassen point, finite-point und infinite-point reprsentieren Punkte, entweder auf der Kurve oder den unendlich fernen Punkt. Der Initialisierer fr Punkte prft, ob die Koordinaten des Punkts zur Kurve passen.

Die Methode add addiert zwei Punkte.</comment-de><comment-en></comment-en><export>elliptic-curve</export><export>get-infinite-point</export><export>point</export><export>finite-point</export><export>infinite-point</export><export>initialize</export><export>make-point</export><export>get-curve</export><export>add</export><body>#| elliptic curve |#

(defclass elliptic-curve ())

(defmethod initialize ((this elliptic-curve) (a residue-class) (b residue-class)) 
  (and
    (same-ring? a b)
    (not (zero? 
      (+ (* (new residue-class (get-ring a) 4) a a a)
        (* (new residue-class (get-ring b) 27) b b)))))
  (progn
    (.= this a a)
    (.= this b b)
    (.= this infinite-point (new infinite-point this))
    (freeze this)))

(defmethod get-infinite-point ((this elliptic-curve)) 
  t
  (. this infinite-point))

(defmethod make-point ((this elliptic-curve) (x residue-class) (y residue-class)) 
  t
  (new finite-point this x y))

(defmethod add-points ((this elliptic-curve) (x1 residue-class) (y1 residue-class) (x2 residue-class) (y2 residue-class))
  (not 
    (and 
      (= x1 x2) 
      (= y1 (- (new residue-class (get-ring y2) 0) y2))))
  (let
   ((m (if
     (= x1 x2)
     (/ (+ (* (new residue-class (get-ring x1) 3) x1 x1) (. this a)) (+ y1 y1))
     (/ (- y2 y1) (- x2 x1)))))
    (let
      ((x3 (- (* m m) x1 x2)))
      (let
        ((y3 (- (* (- x1 x3) m) y1)))
        (make-point this x3 y3)))))

#| point on elliptic curve or point at infinity |#

(deftrait point ())

(defclass finite-point (point))

(defclass infinite-point (point))

(defmethod initialize ((this finite-point) (curve elliptic-curve) (x residue-class) (y residue-class))
  (with-slots-read-only (a b) curve
    (=
      (* y y) 
      (+ (* x x x) (* a x) b)))
  (progn
    (.= this curve curve)
    (.= this x x)
    (.= this y y)
    (freeze this))))

(defmethod initialize ((this infinite-point) (curve elliptic-curve)) 
  t
  (progn
    (.= this curve curve)
    (freeze this)))

(defmethod get-curve ((this point))
  t
  (. this curve))

(defmethod same-curve? ((point-1 point) (point-2 point))
  t
  (= (get-curve point-1) (get-curve point-2)))

(defmethod add ((point-1 infinite-point) (point-2 point)) 
  (same-curve? point-1 point-2)
  point-2)

(defmethod add ((point-1 point) (point-2 infinite-point)) 
  (same-curve? point-1 point-2)
  point-1)

(defmethod add ((point-1 finite-point) (point-2 finite-point))
  (same-curve? point-1 point-2)
  (let
    ((curve (get-curve point-1))
     (x1 (. point-1 x))
     (y1 (. point-1 y))
     (x2 (. point-2 x))
     (y2 (. point-2 y)))
    (if
      (or
        (and (= x1 x2) (zero? y1) (zero? y2))
        (and (= x1 x2) (not (= y1 y2))))
      (get-infinite-point curve)
      (add-points curve x1 y1 x2 y2))))</body><dependency><name>residue-class</name><minimum-required-version>4</minimum-required-version><uri>local:residue-class</uri></dependency></module><module><name>factorize</name><version>13</version><uri>local:factorize</uri><comment-de>Das Modul faktorisiert Zahlen mit der Methode der elliptischen Kurven.</comment-de><comment-en></comment-en><export>trial-division-search-factors</export><export>elliptic-curve-search-factor</export><export>elliptic-curve-find-factor</export><export>factorize</export><body>(setq *small-primes*
  (quote 
    (2 3 5 7 11 13 17 19
     23 29 31 37 41 43 47
     53 59 61 67 71 73 79
     83 89 97)))

(defproc trial-division-search-factors (n)
  (select-if
    (lambda (p) (integer? (/ n p)))
    *small-primes*))

(defproc binary-logarithm (n)
  (if
    (&lt; n 2)
    1
    (+ 1 (binary-logarithm (floor (/ n 2))))))

(defproc newton-root (n e a)
  (let
    ((b (- a (floor (/ (- (expt a e) n) (* e (expt a (- e 1))))))))
    (if
      (= a b)
      a
      (newton-root n e b))))

(defproc non-zero-random (n)
  (+ 1 (random (- n 1))))

(defproc random-multiplier (n)
  (let
    ((lblb (binary-logarithm (binary-logarithm n))))
    (let
      ((r (newton-root n lblb 1))
       (m 1))
      (dotimes (i (* 8 lblb) m)
        (setq m (lcm m (non-zero-random r)))))))

(defproc make-random-point (n)
  (let
    ((ring (new residue-class-ring n)))
    (let
      ((a (new residue-class ring (non-zero-random n)))
       (x (new residue-class ring (non-zero-random n)))
       (y (new residue-class ring (non-zero-random n))))
      (let
        ((curve (new elliptic-curve a (- (* y y) (* x x x) (* a x)))))
        (make-point curve x y)))))

(defmethod repeated-addition (k (p finite-point) s)
  (and
    (integer? k)
    (&gt;= k 0))
  (cond
    ((= k 0) 
      s)
    ((odd? k) 
      (repeated-addition (/ (- k 1) 2) (+ p p) (+ s p)))
    (t 
      (repeated-addition (/ k 2) (+ p p) s))))

(defmethod repeated-addition (k (p infinite-point) s)
  t
  s)

(defmethod repeated-addition (k (p point))
  (and
    (integer? k)
    (&gt;= k 0))
  (repeated-addition k p (get-infinite-point (get-curve p))))

(defproc elliptic-curve-search-factor (product)
  (let
    ((multiplier (random-multiplier product))
     (curve-count 0))
    (loop
      (let
        ((point (make-random-point product)))
        (catch-and-apply
          (quote no-multiplicative-inverse)
          (lambda (name value) (return (gcd value product)))
          (repeated-addition multiplier point)))
      (setq curve-count (+ curve-count 1))
      (when (greater? curve-count 10)
        (return nil)))))

(defproc elliptic-curve-factor-generator (channel product)
  (loop
    (when (closed-channel? channel)
      (return nil))
    (awhen (elliptic-curve-search-factor product)
      (send-on-channel channel it nil)
      (return nil))))

(defproc elliptic-curve-find-factor (product)
  (let
    ((channel (make-channel 0)))
    (progn
      (dotimes (i *thread-count*)
        (go 
          (elliptic-curve-factor-generator channel product)))
      (ensure
        (receive-from-channels (list channel) nil)
        (close-channel channel)))))

(defproc factorize (number)
  (if
    (&lt; number 2)
    nil
    (if
      (prime? number)
      (list number)
      (aif
        (trial-division-search-factors number)
        (append it (factorize (/ number (apply * it))))
        (let
          ((factor (elliptic-curve-find-factor number)))
          (append
            (factorize factor)
            (factorize (/ number factor))))))))</body><dependency><name>expt</name><minimum-required-version>1</minimum-required-version><uri>local:expt</uri></dependency><dependency><name>residue-class</name><minimum-required-version>4</minimum-required-version><uri>local:residue-class</uri></dependency><dependency><name>elliptic-curve</name><minimum-required-version>0</minimum-required-version><uri>local:elliptic-curve</uri></dependency></module><module-exports></module-exports></sheet>

Credits

Andreas Motzek

Andreas Motzek

16 projects • 9 followers
I love mathematics and computer science. I work for an international consulting company.

Comments