1 ! Copyright (C) 2021 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors arrays assocs combinators combinators.smart
4 continuations formatting io kernel math math.functions
5 math.parser prettyprint quotations random sequences
6 sequences.extras splitting strings unicode unicode.flags
10 GENERIC: generate-question* ( question -- quot )
11 GENERIC: parse-response ( input question -- answer )
12 GENERIC: ask-question ( question -- )
13 GENERIC: check-response ( question -- correct? )
14 GENERIC: >question ( obj -- question )
16 TUPLE: question generator generated answer response parsed-response correct? ;
18 TUPLE: true-false-question < question ;
19 : <true-false-question> ( generator -- question )
20 true-false-question new
23 TUPLE: string-question < question ;
24 : <string-question> ( generator -- question )
28 TUPLE: number-question < question ;
29 : <number-question> ( generator -- question )
33 TUPLE: multiple-choice-question < question n choices ;
35 : <multiple-choice-question> ( generator n -- multiple-choice-question )
36 multiple-choice-question new
40 TUPLE: true-false-response ;
41 TUPLE: string-response ;
42 TUPLE: number-response ;
44 M: true-false-response >question <true-false-question> ;
45 M: string-response >question <string-question> ;
46 M: number-response >question <number-question> ;
47 M: object >question clone ;
49 M: callable generate-question* call( -- quot ) ;
50 M: question generate-question* generator>> generate-question* ;
51 M: multiple-choice-question generate-question*
52 [ n>> ] [ generator>> ] bi
53 '[ _ generate-question* ] replicate ;
55 : trim-blanks ( seq -- seq' ) split-words harvest join-words ;
56 : first-n-letters ( n -- seq ) <iota> [ CHAR: a + 1string ] map ;
57 : alphabet-zip ( seq -- zip ) [ length <iota> [ CHAR: a + 1string ] { } map-as ] keep zip ;
58 M: question parse-response drop trim-blanks ;
59 M: true-false-question parse-response drop trim-blanks >lower "t" = ;
60 M: number-question parse-response drop string>number ;
62 TUPLE: multiplication < number-response count n ;
63 TUPLE: sqrt-question < number-response random-choices ;
64 TUPLE: sq-question < number-response random-choices ;
65 TUPLE: stack-shuffler < string-response n-shufflers ;
66 TUPLE: state-capital-question < string-response ;
67 TUPLE: country-from-flag < string-response n ;
68 TUPLE: flag-from-countries < string-response n ;
70 M: multiplication generate-question*
71 [ count>> random ] [ n>> ] bi '[ _ random 2 + ] replicate
73 M: sqrt-question generate-question* random-choices>> random sq '[ _ sqrt >integer ] ;
74 M: sq-question generate-question* random-choices>> random '[ _ sq ] ;
77 CONSTANT: state-capitals H{
78 { "Alabama" "Montgomery" } { "Alaska" "Juneau" } { "Arizona" "Phoenix" } { "Arkansas" "Little Rock" }
79 { "California" "Sacramento" } { "Colorado" "Denver" } { "Connecticut" "Hartford" } { "Delaware" "Dover" }
80 { "Florida" "Tallahassee" } { "Georgia" "Atlanta" } { "Hawaii" "Honolulu" } { "Idaho" "Boise" }
81 { "Illinois" "Springfield" } { "Indiana" "Indianapolis" } { "Iowa" "Des Moines" } { "Kansas" "Topeka" }
82 { "Kentucky" "Frankfort" } { "Louisiana" "Baton Rouge" } { "Maine" "Augusta" } { "Maryland" "Annapolis" }
83 { "Massachusetts" "Boston" } { "Michigan" "Lansing" } { "Minnesota" "Saint Paul" } { "Mississippi" "Jackson" }
84 { "Missouri" "Jefferson City" } { "Montana" "Helena" } { "Nebraska" "Lincoln" } { "Nevada" "Carson City" }
85 { "New Hampshire" "Concord" } { "New Jersey" "Trenton" } { "New Mexico" "Santa Fe" } { "New York" "Albany" }
86 { "North Carolina" "Raleigh" } { "North Dakota" "Bismarck" } { "Ohio" "Columbus" } { "Oklahoma" "Oklahoma City" }
87 { "Oregon" "Salem" } { "Pennsylvania" "Harrisburg" } { "Rhode Island" "Providence" } { "South Carolina" "Columbia" }
88 { "South Dakota" "Pierre" } { "Tennessee" "Nashville" } { "Texas" "Austin" } { "Utah" "Salt Lake City" }
89 { "Vermont" "Montpelier" } { "Virginia" "Richmond" } { "Washington" "Olympia" } { "West Virginia" "Charleston" }
90 { "Wisconsin" "Madison" } { "Wyoming" "Cheyenne" }
93 : state-capital ( state -- capital ) state-capitals at ;
94 M: state-capital-question generate-question* drop state-capitals keys random '[ _ state-capital ] ;
95 M: state-capital-question parse-response drop trim-blanks >title ;
97 M: country-from-flag generate-question* drop valid-flags random '[ _ flag>unicode ] ;
98 M: country-from-flag parse-response drop trim-blanks >title ;
100 M: flag-from-countries generate-question* drop valid-flag-names random '[ _ unicode>flag ] ;
101 M: flag-from-countries parse-response drop trim-blanks >title ;
103 CONSTANT: stack-shufflers { dup 2dup drop 2drop swap over rot -rot roll -roll 2dup pick dupd }
105 M: stack-shuffler generate-question*
106 n-shufflers>> [ stack-shufflers random ] [ ] replicate-as
107 [ inputs first-n-letters ] keep
108 '[ _ _ with-datastack join-words ] ;
110 M: question ask-question generated>> . ;
111 M: string-response ask-question generated>> . ;
112 M: number-response ask-question generated>> . ;
114 M: multiple-choice-question ask-question
115 [ generated>> . ] [ choices>> [ first2 swap " (" ") " surround write ... ] each ] bi ;
117 M: question check-response
118 [ parsed-response>> ] [ answer>> ] bi = ;
119 M: multiple-choice-question check-response
120 [ parsed-response>> ] [ answer>> ] bi member? ;
123 : score-question ( question input -- question/f )
124 dup { f "q" } member? [
128 dup [ response>> ] keep parse-response >>parsed-response
129 dup check-response >>correct?
130 dup answer>> dup string? [ print ] [ . ] if
133 GENERIC: generate-question ( question -- )
135 ERROR: generator-needs-reponse-type generator ;
136 M: object generate-question
137 generator-needs-reponse-type ;
139 M: number-response generate-question
140 <number-question> generate-question ;
142 M: string-response generate-question
143 <string-question> generate-question ;
145 M: question generate-question
146 dup generate-question* >>generated
147 dup generated>> call( -- answer ) >>answer
150 M: multiple-choice-question generate-question
151 dup generate-question*
152 [ random >>generated ]
153 [ [ call( -- answer ) ] map alphabet-zip >>choices ] bi
154 dup [ choices>> ] [ generated>> call( -- answer ) ] bi
155 '[ second _ = ] find-all values keys >>answer
158 : run-one-question ( question -- question/f )
160 [ generate-question ]
162 [ readln score-question nl nl ]
165 GENERIC: run-quiz ( obj -- questions )
167 M: object run-quiz ( obj -- questions )
170 M: sequence run-quiz ( seq -- questions )
171 '[ _ random >question run-one-question ] loop>array ;
173 GENERIC#: run-multiple-choice-quiz 1 ( obj n -- questions )
175 M: object run-multiple-choice-quiz [ 1array ] dip run-multiple-choice-quiz ;
177 M: sequence run-multiple-choice-quiz ( seq n -- questions )
178 '[ _ random _ <multiple-choice-question> run-one-question ] loop>array ;
180 : score-quiz ( seq -- )
181 [ [ correct?>> ] count ]
183 [ drop 0.0 ] [ /f ] if-zero 100 * "SCORE: %d%%\n" printf ;
185 : run-states-quiz-hard ( -- )
186 T{ state-capital-question } 5 run-multiple-choice-quiz score-quiz ;
188 : run-shuffler-quiz ( -- )
190 T{ stack-shuffler { n-shufflers 4 } }
191 } 5 run-multiple-choice-quiz score-quiz ;
193 : run-country-from-flag-quiz ( -- )
195 T{ country-from-flag { n 4 } }
196 } 5 run-multiple-choice-quiz score-quiz ;
198 : run-flag-from-countries-quiz ( -- )
200 T{ flag-from-countries { n 4 } }
201 } 5 run-multiple-choice-quiz score-quiz ;
203 : run-main-quiz ( -- )
205 T{ multiplication { count 10 } { n 10 } }
206 T{ sqrt-question { random-choices 100 } }
207 T{ sq-question { random-choices 100 } }
208 } 5 run-multiple-choice-quiz score-quiz ;