Commit | Line | Data |
---|---|---|
eee0877c AW |
1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
2 | ;;;;; PEG benchmark suite (minimal right now). | |
3 | ;; Parses very long equations several times; outputs the average time | |
4 | ;; it took and the standard deviation of times. | |
5 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; | |
6 | ||
7 | (use-modules (ice-9 pretty-print)) | |
8 | (use-modules (srfi srfi-1)) | |
9 | (use-modules (ice-9 peg)) | |
10 | (use-modules (ice-9 popen)) | |
11 | ||
12 | ;; Generate random equations. | |
13 | (define (gen-rand-eq len) | |
14 | (if (= len 0) | |
15 | (random 1000) | |
16 | (let ((len (if (even? len) (+ len 1) len))) | |
17 | (map (lambda (x) | |
18 | (if (odd? x) | |
19 | (gen-rand len 'op) | |
20 | (gen-rand len 'number))) | |
21 | (iota len))))) | |
22 | (define (gen-rand len type) | |
23 | (cond ((eq? type 'number) | |
24 | (cond | |
25 | ((= (random 5) 0) (gen-rand-eq (floor (/ len 5)))) | |
26 | (#t (random 1000)))) | |
27 | (#t (list-ref '(+ - * /) (random 4))))) | |
28 | ||
29 | ;; Generates a random equation string (len is a rough indicator of the | |
30 | ;; resulting length). | |
31 | (define (gen-str len) | |
32 | (with-output-to-string (lambda () (write (gen-rand-eq len))))) | |
33 | ||
34 | ;; Generates a left-associative parser (see tutorial). | |
35 | (define (make-left-parser next-func) | |
36 | (lambda (sum first . rest) | |
37 | (if (null? rest) | |
38 | (apply next-func first) | |
39 | (if (string? (cadr first)) | |
40 | (list (string->symbol (cadr first)) | |
41 | (apply next-func (car first)) | |
42 | (apply next-func (car rest))) | |
43 | (car | |
44 | (reduce | |
45 | (lambda (l r) | |
46 | (list (list (cadr r) (car r) (apply next-func (car l))) | |
47 | (string->symbol (cadr l)))) | |
48 | 'ignore | |
49 | (append | |
50 | (list (list (apply next-func (caar first)) | |
51 | (string->symbol (cadar first)))) | |
52 | (cdr first) | |
53 | (list (append rest '("done")))))))))) | |
54 | ||
55 | ;; Functions for parsing equations (see tutorial). | |
56 | (define (parse-value value first . rest) | |
57 | (if (null? rest) | |
58 | (string->number (cadr first)) | |
59 | (apply parse-sum (car rest)))) | |
60 | (define parse-product (make-left-parser parse-value)) | |
61 | (define parse-sum (make-left-parser parse-product)) | |
62 | (define parse-expr parse-sum) | |
8022f502 | 63 | (define (eq-parse str) (apply parse-expr (peg:tree (match-pattern expr str)))) |
eee0877c AW |
64 | |
65 | ;; PEG for parsing equations (see tutorial). | |
3ebd5786 | 66 | (define-peg-string-patterns |
eee0877c AW |
67 | "expr <- sum |
68 | sum <-- (product ('+' / '-'))* product | |
69 | product <-- (value ('*' / '/'))* value | |
70 | value <-- sp number sp / sp '(' expr ')' sp | |
71 | number <-- [0-9]+ | |
72 | sp < [ \t\n]*") | |
73 | ||
74 | ;; gets the time in seconds (with a fractional part) | |
75 | (define (canon-time) | |
76 | (let ((pair (gettimeofday))) | |
77 | (+ (+ (car pair) (* (cdr pair) (expt 10 -6))) 0.0))) | |
78 | ||
79 | ;; Times how long it takes for FUNC to complete when called on ARGS. | |
80 | ;; **SIDE EFFECT** Writes the time FUNC took to stdout. | |
81 | ;; Returns the return value of FUNC. | |
82 | (define (time-func func . args) | |
83 | (let ((start (canon-time))) | |
84 | (let ((res (apply func args))) | |
85 | (pretty-print `(took ,(- (canon-time) start) seconds)) | |
86 | res))) | |
87 | ;; Times how long it takes for FUNC to complete when called on ARGS. | |
88 | ;; Returns the time FUNC took to complete. | |
89 | (define (time-ret-func func . args) | |
90 | (let ((start (canon-time))) | |
91 | (let ((res (apply func args))) | |
92 | (- (canon-time) start)))) | |
93 | ||
94 | ;; test string (randomly generated) | |
95 | (define tst1 "(621 - 746 * 945 - 194 * (204 * (965 - 738 + (846)) - 450 / (116 * 293 * 543) + 858 / 693 - (890 * (260) - 855) + 875 - 684 / (749 - (846) + 127) / 670) - 293 - 815 - 628 * 93 - 662 + 561 / 645 + 112 - 71 - (286 - ((324) / 424 + 956) / 190 + ((848) / 132 * 602) + 5 + 765 * 220 - ((801) / 191 - 299) * 708 + 151 * 682) + (943 + 847 - 145 - 816 / 550 - 217 / 9 / 969 * 524 * 447 / 323) * 991 - 283 * 915 / 733 / 478 / (680 + 343 * 186 / 341 * ((571) * 848 - 47) - (492 + 398 * (616)) + 270 - 539 * 34 / 47 / 458) * 417 / 406 / 354 * 678 + 524 + 40 / 282 - 792 * 570 - 305 * 14 + (248 - 678 * 8 - 53 - 215 / 677 - 665 / 216 - 275 - 462 / 502) - 24 - 780 + (967 / (636 / 400 * 823) + 933 - 361 - 620 - 255 / 372 + 394 * 869 / 839 * 727) + (436 + 993 - 668 + 772 - 33 + 64 - 252 * 957 * 320 + 540 / (23 * 74 / (422))) + (516 / (348 * 219 * 986) * 85 * 149 * 957 * 602 / 141 / 80 / 456 / 92 / (443 * 468 * 466)) * 568 / (271 - 42 + 271 + 592 + 71 * (766 + (11) * 946) / 728 / 137 / 111 + 557 / 962) * 179 - 936 / 821 * 101 - 206 / (267 - (11 / 906 * 290) / 722 / 98 - 987 / 989 - 470 * 833 - (720 / 34 - 280) + 638 / 940) - 889 * 84 * 630 + ((214 - 888 + (46)) / 540 + 941 * 724 / 759 * (679 / 527 - 764) * 413 + 831 / 559 - (308 / 796 / 737) / 20))") | |
96 | ||
97 | ;; appends two equations (adds them together) | |
98 | (define (eq-append . eqs) | |
99 | (if (null? eqs) | |
100 | "0" | |
101 | (if (null? (cdr eqs)) | |
102 | (car eqs) | |
103 | (string-append | |
104 | (car eqs) | |
105 | " + " | |
106 | (apply eq-append (cdr eqs)))))) | |
107 | ||
108 | ;; concatenates an equation onto itself n times using eq-append | |
109 | (define (string-n str n) | |
110 | (if (<= n 0) | |
111 | "0" | |
112 | (if (= n 1) | |
113 | str | |
114 | (eq-append str (string-n str (- n 1)))))) | |
115 | ||
116 | ;; standard deviation (no bias-correction) | |
117 | ;; (also called population standard deviation) | |
118 | (define (stddev . lst) | |
119 | (let ((llen (length lst))) | |
120 | (if (<= llen 0) | |
121 | 0 | |
122 | (let* ((avg (/ (reduce + 0 lst) llen)) | |
123 | (mapfun (lambda (x) (real-part (expt (- x avg) 2))))) | |
124 | (sqrt (/ (reduce + 0 (map mapfun lst)) llen)))))) | |
125 | ||
126 | ;; average | |
127 | (define (avg . lst) | |
128 | (if (null? lst) | |
129 | 0 | |
130 | (/ (reduce + 0 lst) (length lst)))) | |
131 | ||
132 | (pretty-print "Parsing equations (see PEG in tutorial). Sample size of 10 for each test.") | |
133 | (pretty-print | |
134 | (let ((lst | |
135 | (map | |
136 | (lambda (ignore) | |
137 | (reduce-right | |
138 | append | |
139 | 0 | |
140 | (map | |
141 | (lambda (x) | |
142 | (let* ((mstr (string-n tst1 x)) | |
143 | (strlen (string-length mstr))) | |
8022f502 | 144 | (let ((func (lambda () (begin (match-pattern expr mstr) |
eee0877c AW |
145 | 'done)))) |
146 | `(((string of length ,strlen first pass) | |
147 | ,(time-ret-func func)) | |
148 | ((string of length ,strlen second pass) | |
149 | ,(time-ret-func func)))))) | |
150 | (filter (lambda (x) (= (modulo x 25) 0)) (iota 100))))) | |
151 | (iota 10)))) | |
152 | (let ((compacted | |
153 | (reduce-right | |
154 | (lambda (accum conc) | |
155 | (map (lambda (l r) (append l (cdr r))) accum conc)) | |
156 | 0 | |
157 | lst))) | |
158 | (map | |
159 | (lambda (els) | |
160 | `(,(car els) | |
161 | (average time in seconds ,(apply avg (cdr els))) | |
162 | (standard deviation ,(apply stddev (cdr els))))) | |
163 | compacted)))) | |
164 | ||
165 | (define (sys-calc str) | |
166 | (let* ((pipe (open-input-pipe (string-append "echo \"" str "\" | bc -l"))) | |
167 | (str (read pipe))) | |
168 | (close-pipe pipe) | |
169 | str)) | |
170 | (define (lisp-calc str) | |
171 | (+ (eval (eq-parse str) (interaction-environment)) 0.0)) | |
172 | ||
8022f502 | 173 | ;; (pretty-print `(,(sys-calc tst1) ,(lisp-calc tst1))) |