tests/benchmark/pidigits.slate

   1
   2 prototypes ensureNamespace: #benchmark &delegate: True.
   3
   4 benchmark define: #Transformation &slots: {
   5   #q -> 0. #r -> 0. #s -> 0. #t -> 0. #k -> 0.
   6 }.
   7
   8 benchmark define: #PiDigitSpigot &slots: {
   9   #z. #x. #inverse.
  10 }.
  11
  12 t@(Transformation traits) unity
  13 [
  14   t clone `>> [q := 1. r := 0. s := 0. t := 1. ]
  15 ].
  16
  17 t1@(Transformation traits) * t2@(Transformation traits)
  18 [
  19   t1 clone `>> [
  20     q := t1 q * t2 q.
  21     r := (t1 q * t2 r) + (t1 r * t2 t).
  22     s := (t1 s * t2 q) + (t1 t * t2 s).
  23     t := (t1 s * t2 r) + (t1 t * t2 t). ]
  24 ].
  25
  26 t@(Transformation traits) extract: i@(Integer traits)
  27 [
  28   ((t q * i + t r) / (t s * i + t t)) floor
  29 ].
  30
  31 t@(Transformation traits) next
  32 [
  33   t `>> [k := t k + 1. q := t k. r := 4 * t k + 2. s := 0. t := 2 * t k + 1. ]
  34 ].
  35
  36 s@(PiDigitSpigot traits) new
  37 [
  38   s clone `>> [
  39     z := Transformation unity.
  40     x := Transformation clone.
  41     inverse := Transformation clone. ]
  42 ].
  43
  44 s@(PiDigitSpigot traits) next
  45 [
  46   (s isSafe: (y ::= s digit))
  47     ifTrue: [s z := s produce: y. y]
  48     ifFalse: [s z := s consume: s x next. s next]
  49 ].
  50
  51 s@(PiDigitSpigot traits) digit
  52 [
  53   s z extract: 3
  54 ].
  55
  56 s@(PiDigitSpigot traits) isSafe: i@(Integer traits)
  57 [
  58   i = (s z extract: 4)
  59 ].
  60
  61 s@(PiDigitSpigot traits) produce: i@(Integer traits)
  62 [
  63   (inv ::= s inverse) `>> [q := 10. r := -10 * i. s := 0. t := 1. ].
  64   inv * (s z)
  65 ].
  66
  67 s@(PiDigitSpigot traits) consume: t@(Transformation traits)
  68 [
  69   s z * t
  70 ].
  71
  72 n@(Integer traits) piDigitsTo: s@(Stream traits)
  73 [| length pidigits stream i |
  74   length := 10.
  75   i := 0.
  76   pidigits := PiDigitSpigot new.
  77   [n > 0] whileTrue:
  78     [n < length
  79        ifTrue:
  80          [n timesRepeat: [s ; (pidigits next as: String)].
  81           n upTo: length - 1 do: [| :each | s ; ' '].
  82           i += n]
  83        ifFalse:
  84          [length timesRepeat: [s ; (pidigits next as: String)].
  85           i += length].
  86      s ; '\t :' ; (i as: String) ; '\n'.
  87      n -= length].
  88 ].
  89
  90 n@(Integer traits) pidigits
  91 [
  92   (File newNamed: 'tests/benchmark/pidigits.out' &mode: File CreateWrite)
  93     sessionDo: [| :f | n piDigitsTo: f writer]
  94 ].