Skip to content

Commit bfe4593

Browse files
mflattmflatt
committed
Racket CS report for February 2020
1 parent b2d3bc5 commit bfe4593

25 files changed

+7142
-0
lines changed

‎blog/_src/posts/2020-02-19-racket-on-chez-status.scrbl

+409
Large diffs are not rendered by default.

‎blog/_src/posts/racket-on-chez-status-feb2020/alog.rkt

+240
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,240 @@
1+
#lang racket/base
2+
(require racket/list
3+
racket/date
4+
racket/draw
5+
racket/class
6+
pict)
7+
8+
(provide alog-plots)
9+
10+
(define scales '())
11+
(define (learn-scale! as bs)
12+
(for ([a (in-list as)]
13+
[b (in-list bs)])
14+
(set! scales (cons (/ a b) scales)))
15+
as)
16+
(define (use-scale bs)
17+
(define s (/ (apply + scales) (length scales)))
18+
(for/list ([b (in-list bs)])
19+
(* b s)))
20+
21+
(define alog2-times
22+
(list
23+
(list '(2018 12 6)
24+
'(245.54
25+
4.69
26+
21.16
27+
59.86
28+
93.34
29+
171.27
30+
95.77)
31+
'(508.48
32+
15.37
33+
37.51
34+
59.71
35+
150.3
36+
176.41
37+
143.08))
38+
(list '(2019 1 19)
39+
'(226.43
40+
4.53
41+
20.24
42+
59.76
43+
88.13
44+
150.26
45+
92.82)
46+
'(486.16
47+
14.57
48+
34.2
49+
63.13
50+
139.7
51+
173.36
52+
127.29))
53+
#;
54+
(list '(2019 1 27)
55+
'(224
56+
4.56
57+
20.98
58+
59.8
59+
92.59
60+
159.78
61+
97.79)
62+
'(509.96
63+
11.84
64+
35.48
65+
85.69
66+
142.56
67+
180.47
68+
134.55))
69+
(list '(2019 6 20) ; 7.3
70+
(learn-scale!
71+
'(231.18 ; original
72+
4.84
73+
20.68
74+
59.87
75+
91.16
76+
164.89
77+
95)
78+
'(229.03 ; newer
79+
4.51
80+
17.82
81+
46.05
82+
83.19
83+
158.38
84+
85.36))
85+
'(320.7
86+
6.66
87+
25.44
88+
60.57
89+
93.78
90+
185.25
91+
108.58))
92+
(list '(2019 10 18) ; 7.4
93+
(learn-scale!
94+
'(223.05 ; original
95+
4.37
96+
19.47
97+
46.73
98+
89.16
99+
159.05
100+
88.11)
101+
'(207.77 ; newer
102+
3.72
103+
16.49
104+
59.69
105+
71.97
106+
137.55
107+
75.10))
108+
(learn-scale!
109+
'(320.07 ; original
110+
6.7
111+
24.21
112+
58.6
113+
83.57
114+
150.12
115+
97.93)
116+
'(266.55 ; newer
117+
5.68
118+
20.68
119+
49.53
120+
77.72
121+
133.56
122+
85.77)))
123+
(list '(2020 02 14)
124+
(use-scale
125+
'(207.70
126+
3.72
127+
16.97
128+
59.52
129+
74.77
130+
130.26
131+
76.01))
132+
(use-scale
133+
'(234.99
134+
4.37
135+
16.71
136+
62.67
137+
66.75
138+
93.61
139+
73.39)))))
140+
141+
(define alog2-labels
142+
'("build"
143+
"df-test"
144+
"db-test"
145+
"db-upgrade-test"
146+
"trends-test"
147+
"aggregate-test"
148+
"fit-test"))
149+
150+
(define (stamp->seconds l)
151+
(find-seconds 0 0 0 (caddr l) (cadr l) (car l)))
152+
153+
(define (date->pict dt)
154+
(define mo
155+
(case (cadr dt)
156+
[(12) "Dec"]
157+
[(10) "Oct"]
158+
[(6) "Jun"]
159+
[(1) "Jan"]
160+
[(2) "Feb"]))
161+
(vc-append 1
162+
(text (format "~a" (car dt)) 'swiss 12)
163+
(text mo 'swiss 12)))
164+
165+
(define (plots)
166+
(define dot (filled-ellipse 20 20))
167+
(for/list ([label (in-list alog2-labels)]
168+
[i (in-naturals)])
169+
(define start-x (stamp->seconds (car (car alog2-times))))
170+
(define end-x (stamp->seconds (car (last alog2-times))))
171+
(define xs (for/list ([at (in-list alog2-times)])
172+
(stamp->seconds (car at))))
173+
(define r-ys (for/list ([at (in-list alog2-times)])
174+
(list-ref (cadr at) i)))
175+
(define rcs-ys (for/list ([at (in-list alog2-times)])
176+
(list-ref (caddr at) i)))
177+
(define hi-y (* 1.1 (apply max (append r-ys rcs-ys))))
178+
(define H 250)
179+
(define W 400)
180+
(define-values (r rcs)
181+
(for/fold ([r null]
182+
[rcs null])
183+
([x (in-list xs)]
184+
[r-y (in-list r-ys)]
185+
[rcs-y (in-list rcs-ys)])
186+
(define dx (* (- x start-x) (/ W (- end-x start-x))))
187+
(values (cons (cons dx
188+
(- H (* r-y (/ H hi-y))))
189+
r)
190+
(cons (cons dx
191+
(- H (* rcs-y (/ H hi-y))))
192+
rcs))))
193+
(define p
194+
(dc (lambda (dc x y)
195+
(define p (send dc get-pen))
196+
(send dc draw-line x y x (+ y H))
197+
(send dc draw-line x (+ y H) (+ x W) (+ y H))
198+
(send dc set-pen (make-pen #:color "red" #:width 5))
199+
(send dc draw-lines r x y)
200+
(send dc set-pen (make-pen #:color "blue" #:width 5))
201+
(send dc draw-lines rcs x y)
202+
(send dc set-pen p))
203+
W H))
204+
(define q (for/fold ([p p]) ([x (in-list (reverse (map car r)))]
205+
[at (in-list alog2-times)])
206+
(define dt (car at))
207+
(define lbl (vc-append (vline 0 5) (date->pict dt)))
208+
(pin-over p
209+
x H
210+
(inset lbl (* -1/2 (pict-width lbl)) 0))))
211+
(define (add-label p lbl pts)
212+
(define left? (> (/ (abs (- (cdr (last r)) (cdr (last rcs)))) H) 0.03))
213+
(cond
214+
[left?
215+
(pin-over p
216+
(- (car (last pts)) 5 (pict-width lbl)) (- (cdr (last pts)) 5)
217+
lbl)]
218+
[else
219+
(pin-over p
220+
(+ (car (first pts)) 5) (- (cdr (first pts)) 5)
221+
lbl)]))
222+
(let* ([q (add-label q (colorize (text "R/BC" '(bold . swiss) 12) "red") r)]
223+
[q (add-label q (colorize (text "R/CS" '(bold . swiss) 12) "blue") rcs)]
224+
[q (rt-superimpose q (text label 'swiss 24))]
225+
[q (refocus (ht-append (text (format "~a s " (inexact->exact (round hi-y))) 'swiss 12)
226+
q)
227+
q)])
228+
(inset q 45 0 35 40))))
229+
230+
(define (alog-plots)
231+
(define l (plots))
232+
(scale (table 2
233+
(cons (car l) (cons (blank) (cdr l)))
234+
cc-superimpose cc-superimpose
235+
12 12)
236+
0.6))
237+
238+
(module+ main
239+
(require slideshow)
240+
(for-each (lambda (p) (slide (scale p 2))) (plots)))

‎blog/_src/posts/racket-on-chez-status-feb2020/better.rkt

+11
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,11 @@
1+
#lang slideshow
2+
3+
(provide title/better)
4+
5+
(define (title/better content #:shorter-better? [shorter-better? #t])
6+
(let ([p (titlet content)])
7+
(refocus (hbl-append gap-size p (scale (t (format "(~a is better)" (if shorter-better?
8+
"shorter"
9+
"longer")))
10+
0.8))
11+
p)))

0 commit comments

Comments
 (0)