-
Notifications
You must be signed in to change notification settings - Fork 39
/
gen-doc.rkt
152 lines (142 loc) · 8.01 KB
/
gen-doc.rkt
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
#lang racket
(require "structure-data.rkt")
(require "static-text.rkt")
(require "paths.rkt")
(require "filters.rkt")
(require scribble/core)
(require scribble/base)
(require scribble/decode)
(require scribble/html-properties)
(require file/sha1)
(provide generate-document)
(define (generate-paper-list ps left-color right-color)
(if (empty? ps)
(para "Nothing here!")
(tabular
#:sep (hspace 1)
#:style (style #f
(list (table-columns (list (style #f '(right)) ;; NB: the style properties are found in table-cells
(style #f '(center))
(style #f '(left))
(style #f '(center))
(style #f '(left))
(style #f '(center))
(style #f (list 'center
(attributes
`((style . ,(string-append "background-color: #"
(color-list->color-string left-color)))))))
(style #f '(center))
(style #f (list 'center
(attributes
`((style . ,(string-append "background-color: #"
(color-list->color-string right-color)))))))))))
(map (lambda (p)
(list (paper-group p)
(paper-authors p)
(paper-title p)
(hyperlink
(build-notes-link (paper-path p))
"notes")
(list
(if (disputed? p)
(hyperlink (dispute-link (paper-path p)) "dispute!")
" ")
(linebreak)
(if (cleared? p)
(hyperlink (cleared-link (paper-path p)) "cleared?")
" ")
(linebreak)
(if (problem? p)
(hyperlink (problem-link (paper-path p)) "problem?")
" ")
(linebreak)
(if (misclassified? p)
(hyperlink (misclass-link (paper-path p)) "misclassified")
" ")
)))
ps))))
(define (color-string->color-list s)
(bytes->list (hex-string->bytes s)))
(define (color-list->color-string l)
(bytes->hex-string (list->bytes l)))
#| Colors from http://www.colourlovers.com/palette/3292950/Candy_colors by averagegirl |#
(define bad-color (color-string->color-list "F2BAD6"))
(define good-color (color-string->color-list "6BEEE2"))
(define neutral-color (color-string->color-list "D1FCFC"))
(define progress-color (color-string->color-list "BEE2F4"))
(define misclass-color (color-string->color-list "DDB7E2"))
(struct sec (title description filter left-col-color right-col-color))
;; hello!
(define report-sections
(list (sec "Purported Not Building; Disputed; Not Checked"
"The original study claimed that the paper did not build; someone has disputed this claim, but nobody has yet re-examined it."
(and-filters not-misclassified? not-building? disputed? not-checked?) bad-color neutral-color)
(sec "Purported Building; Disputed; Not Checked"
"The original study claimed that the paper did build; someone has disputed this claim, but nobody has yet re-examined it."
(and-filters not-misclassified? building? disputed? not-checked?) good-color neutral-color)
(sec "Conflicting Checks!"
"The re-examination has produced conflicting findings."
(and-filters not-misclassified? cleared? problem?) neutral-color bad-color)
(sec "Misclassified"
"On re-examination, this paper should not have been included in the original study at all."
misclassified? neutral-color misclass-color)
;; don't use disputed? for the next two, because people may have checked
;; without a formal dispute filed!
(sec "Purported Not Building But Found Building"
"The original study claimed that the paper did not build, but the re-examination has found it does build."
(and-filters not-misclassified? not-building? cleared? not-problem?) bad-color good-color)
(sec "Purported Building But Found Not Building"
"The original study claimed that the paper did build, but the re-examination has found it does not build."
(and-filters not-misclassified? building? not-cleared? problem?) good-color bad-color)
(sec "Purported Not Building; Confirmed"
"The original study claimed that the paper did not build, and the re-examination has confirmed this."
(and-filters not-misclassified? not-building? not-cleared? problem?) bad-color bad-color)
(sec "Purported Building; Confirmed"
"The original study claimed that the paper did build, and the re-examination has confirmed this."
(and-filters not-misclassified? building? cleared? not-problem?) good-color good-color)
(sec "All Others Purported Not Building"
"The original study claimed that the paper did not build, and nobody has initiated re-examination."
(and-filters not-misclassified? not-building? not-misclassified? not-disputed? not-checked? not-problem?) bad-color neutral-color)
(sec "All Other Purported Building"
"The original study claimed that the paper did build, and nobody has initiated re-examination."
(and-filters not-misclassified? building? not-misclassified? not-disputed? not-checked? not-problem?) good-color neutral-color)))
(define (generate-document papers)
(define (make-section title description relevant-papers left-color right-color)
(list (section title " (" (number->string (length relevant-papers)) ")")
(para (emph description))
(generate-paper-list (shuffle relevant-papers) left-color right-color)))
(define paper-count (length papers))
(decode
(list
(title "Examining ``Reproducibility in Computer Science''")
(section "What We Are Doing")
top-matter
(section "Progress")
(tabular #:sep (hspace 1)
#:style (style #f
(list (background-color-property progress-color)
(table-columns (list (style #f '(right)) ;; NB: the style properties are found in table-cells
(style #f '(center))
(style #f '(right))
(style #f '(center))
(style #f '(left))))))
(map
(lambda (s)
(define these-papers-count (length (filter (sec-filter s) papers)))
(define ratio (floor (* 100 (/ these-papers-count paper-count))))
(list (sec-title s)
(string-append (number->string ratio) "%")
(make-string (if (> these-papers-count 0)
(max ratio 1)
0)
#\•)))
report-sections))
(section "How to Review")
review-protocol
review-format
(map (lambda (s)
(make-section (sec-title s) (sec-description s) (filter (sec-filter s) papers) (sec-left-col-color s) (sec-right-col-color s)))
report-sections)
(section "Threats to Validity")
threats-to-validity
)))