1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
|
#lang racket/base
;; This code solves Problem 17 from Project Euler
;; http://projecteuler.net/index.php?section=problems&id=17
;;
;; It not just solve it, it actually make graphs with the results of timing
;; different implementations of solutions.
;;
;;--------------------------------------------------------------------------
;; If the numbers 1 to 5 are written out in words: one, two, three,
;; four, five, then there are 3 + 3 + 5 + 4 + 4 = 19 letters used in total.
;;
;; If all the numbers from 1 to 1000 (one thousand) inclusive were written
;; out in words, how many letters would be used?
;;--------------------------------------------------------------------------
;; Rodolfo Carvalho, 2011/07/24
;; --- change here ---
(define max-n 100000)
;; --------//---------
(require (planet williams/describe/describe)
(planet stephanh/mathsymbols/mathsymbols)
plot
slideshow)
; Solve the problem by generating the values and then summing
(define (fat-letter-count-of-integers-up-to n)
(apply + (build-list n (compose string-length integer->string add1))))
; Solve iteratively without building a list in memory
(define (slim-letter-count-of-integers-up-to n)
(for/fold ([sum 0])
([i (in-range 1 (add1 n))])
(+ sum (string-length (integer->string i)))))
; Solve using summation
(define (greek-letter-count-of-integers-up-to n)
(Σ ([i (in-range 1 (add1 n))])
(string-length (integer->string i))))
; Solve recursively
(define (recur-letter-count-of-integers-up-to n)
(if (zero? n)
0
(+ ((compose string-length integer->string) n)
(recur-letter-count-of-integers-up-to (sub1 n)))))
; Solve recursively, tail call
(define (tail-letter-count-of-integers-up-to n [acc 0])
(if (zero? n)
acc
(tail-letter-count-of-integers-up-to
(sub1 n)
(+ (string-length (integer->string n))
acc))))
; Solve using a named-let
(define (let-letter-count-of-integers-up-to n)
(let f ([i n]
[acc 0])
(if (zero? i)
acc
(f (sub1 i) (+ (string-length (integer->string i))
acc)))))
(define (call-with-time f . args)
(call-with-values (λ () (time-apply f args)) list))
(define (median lst)
(list-ref (sort lst <) (ceiling (/ (length lst) 2))))
(define (generate-data f)
(displayln (format "Generating data for ~a" (object-name f)))
(time
(let* ([min 1000]
[max max-n]
[points# 10]
[repeat# 7])
(for/list ([n (in-range min (add1 max) (/ (- max min) (sub1 points#)))])
(list n
(apply map (λ elms
(if (list? (car elms))
(car elms)
(median elms)))
(for/list ([i (in-range repeat#)])
(call-with-time f n))))))))
; TODO: "datum" should be a struct and all these below would come for free
(define (datum-n datum)
(car datum))
(define (datum-result datum)
(caaadr datum))
(define (datum-cpu-time datum)
(cadadr datum))
(define (datum-real-time datum)
(car (cddadr datum)))
(define (datum-gc-time datum)
(cadr (cddadr datum)))
(define (data->points data getter color)
(points
(for/list ([datum (in-list data)])
(vector (datum-n datum) (getter datum)))
#:sym 'plus
#:color color))
(define (find-max-value . data-lst)
; to be properly implemented...
(let ([max-time (apply max (filter number? (apply append (filter list? (apply append (apply append data-lst))))))])
(list (+ (* 55.56 (- max-n 1000.0)) 24527) ; max n
(* 6/5 max-time) ; max cpu time
(* 6/5 max-time) ; max real time
(* 1/5 max-time) ; max gc time
)))
(define (make-data-table getter . data-lst)
(apply map list
(append
(list (map datum-n (car data-lst)))
(map (λ (lst) (map getter lst)) data-lst))))
;; Slideshow definitions
(set-page-numbers-visible! #f)
(define (with-height h pict)
(scale pict (/ h (pict-height pict))))
(slide
#:title "Project Euler - Problem 17"
(para "If the numbers 1 to 5 are written out in words: one, two, three, four, five, then there are 3 + 3 + 5 + 4 + 4 = 19 letters used in total.")
(para "If all the numbers from 1 to 1000 (one thousand) inclusive were written out in words, how many letters would be used?"))
(displayln "Computing data may take a while...")
;; Compute data, create plots and slides
(let ([slim-data (generate-data slim-letter-count-of-integers-up-to)]
[fat-data (generate-data fat-letter-count-of-integers-up-to)]
[greek-data (generate-data greek-letter-count-of-integers-up-to)]
[recur-data (generate-data recur-letter-count-of-integers-up-to)]
[tail-data (generate-data tail-letter-count-of-integers-up-to)]
[let-data (generate-data let-letter-count-of-integers-up-to)])
(for ([title (list "number of letters used" "CPU time" "Real time" "GC time")]
[y-max (find-max-value slim-data
fat-data
greek-data
recur-data
tail-data
let-data)]
[getter (list datum-result datum-cpu-time datum-real-time datum-gc-time)])
(let ([slim-points (data->points slim-data getter 'blue)]
[fat-points (data->points fat-data getter 'red)]
[greek-points (data->points greek-data getter 'yellow)]
[recur-points (data->points recur-data getter 'green)]
[tail-points (data->points tail-data getter 'violet)]
[let-points (data->points let-data getter 'turquoise)])
(slide
#:title (format "~a" title)
(frame
(inset
(table 7
(append
(list (t "N")
(colorize (t "slim") "blue")
(colorize (t "fat") "red")
(colorize (t "greek") "yellow")
(colorize (t "recur") "green")
(colorize (t "tail") "violet")
(colorize (t "let") "turquoise"))
(map (λ (v) (text (format "~a" v) (current-main-font) 16))
(flatten
(make-data-table getter
slim-data
fat-data
greek-data
recur-data
tail-data
let-data))))
rc-superimpose cc-superimpose
gap-size gap-size)
gap-size)))
(slide
(bitmap
(plot
(mix
slim-points
fat-points
greek-points
recur-points
tail-points
let-points)
#:width client-w
#:height client-h
#:x-min 0
#:x-max max-n
#:y-min 0
#:y-max y-max
#:x-label "N"
#:y-label title
#:title (format "~a x N" title)))))))
(displayln "Enjoy the slides!")
|