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 io kernel math math.functions math.parser
5 prettyprint quotations random sequences sequences.extras
6 splitting strings unicode ;
9 GENERIC: generate-question* ( question -- quot )
10 GENERIC: parse-response ( input question -- answer )
11 GENERIC: ask-question ( question -- )
12 GENERIC: check-response ( question -- correct? )
13 GENERIC: >question ( obj -- question )
15 TUPLE: question generator generated answer response parsed-response correct? ;
17 TUPLE: true-false-question < question ;
18 : <true-false-question> ( generator -- question )
19 true-false-question new
22 TUPLE: string-question < question ;
23 : <string-question> ( generator -- question )
27 TUPLE: number-question < question ;
28 : <number-question> ( generator -- question )
32 TUPLE: multiple-choice-question < question n choices ;
34 : <multiple-choice-question> ( generator n -- multiple-choice-question )
35 multiple-choice-question new
39 TUPLE: true-false-response ;
40 TUPLE: string-response ;
41 TUPLE: number-response ;
43 M: true-false-response >question <true-false-question> ;
44 M: string-response >question <string-question> ;
45 M: number-response >question <number-question> ;
46 M: object >question clone ;
48 M: callable generate-question* call( -- quot ) ;
49 M: question generate-question* generator>> generate-question* ;
50 M: multiple-choice-question generate-question*
51 [ n>> ] [ generator>> ] bi
52 '[ _ generate-question* ] replicate ;
54 : trim-blanks ( seq -- seq' ) words harvest unwords ;
55 : first-n-letters ( n -- seq ) <iota> [ CHAR: a + 1string ] map ;
56 : alphabet-zip ( seq -- zip ) [ length <iota> [ CHAR: a + 1string ] { } map-as ] keep zip ;
57 M: question parse-response drop trim-blanks ;
58 M: true-false-question parse-response drop trim-blanks >lower "t" = ;
59 M: number-question parse-response drop string>number ;
61 TUPLE: multiplication < number-response count n ;
62 TUPLE: sqrt-question < number-response random-choices ;
63 TUPLE: sq-question < number-response random-choices ;
64 TUPLE: stack-shuffler < string-response n-shufflers ;
65 TUPLE: state-capital-question < string-response ;
67 M: multiplication generate-question*
68 [ count>> random ] [ n>> ] bi '[ _ random 2 + ] replicate
70 M: sqrt-question generate-question* random-choices>> random sq '[ _ sqrt >integer ] ;
71 M: sq-question generate-question* random-choices>> random '[ _ sq ] ;
74 CONSTANT: state-capitals H{
75 { "Alabama" "Montgomery" } { "Alaska" "Juneau" } { "Arizona" "Phoenix" } { "Arkansas" "Little Rock" }
76 { "California" "Sacramento" } { "Colorado" "Denver" } { "Connecticut" "Hartford" } { "Delaware" "Dover" }
77 { "Florida" "Tallahassee" } { "Georgia" "Atlanta" } { "Hawaii" "Honolulu" } { "Idaho" "Boise" }
78 { "Illinois" "Springfield" } { "Indiana" "Indianapolis" } { "Iowa" "Des Moines" } { "Kansas" "Topeka" }
79 { "Kentucky" "Frankfort" } { "Louisiana" "Baton Rouge" } { "Maine" "Augusta" } { "Maryland" "Annapolis" }
80 { "Massachusetts" "Boston" } { "Michigan" "Lansing" } { "Minnesota" "Saint Paul" } { "Mississippi" "Jackson" }
81 { "Missouri" "Jefferson City" } { "Montana" "Helena" } { "Nebraska" "Lincoln" } { "Nevada" "Carson City" }
82 { "New Hampshire" "Concord" } { "New Jersey" "Trenton" } { "New Mexico" "Santa Fe" } { "New York" "Albany" }
83 { "North Carolina" "Raleigh" } { "North Dakota" "Bismarck" } { "Ohio" "Columbus" } { "Oklahoma" "Oklahoma City" }
84 { "Oregon" "Salem" } { "Pennsylvania" "Harrisburg" } { "Rhode Island" "Providence" } { "South Carolina" "Columbia" }
85 { "South Dakota" "Pierre" } { "Tennessee" "Nashville" } { "Texas" "Austin" } { "Utah" "Salt Lake City" }
86 { "Vermont" "Montpelier" } { "Virginia" "Richmond" } { "Washington" "Olympia" } { "West Virginia" "Charleston" }
87 { "Wisconsin" "Madison" } { "Wyoming" "Cheyenne" }
90 : state-capital ( state -- capital ) state-capitals at ;
91 M: state-capital-question generate-question* drop state-capitals keys random '[ _ state-capital ] ;
92 M: state-capital-question parse-response drop trim-blanks >title ;
94 CONSTANT: stack-shufflers { dup 2dup drop 2drop swap over rot -rot roll -roll 2dup pick dupd }
96 M: stack-shuffler generate-question*
97 n-shufflers>> [ stack-shufflers random ] [ ] replicate-as
98 [ inputs first-n-letters ] keep
99 '[ _ _ with-datastack unwords ] ;
101 M: question ask-question generated>> . ;
102 M: string-response ask-question generated>> . ;
103 M: number-response ask-question generated>> . ;
105 M: multiple-choice-question ask-question
106 [ generated>> . ] [ choices>> [ ... ] each ] bi ;
108 M: question check-response
109 [ parsed-response>> ] [ answer>> ] bi = ;
110 M: multiple-choice-question check-response
111 [ parsed-response>> ] [ answer>> ] bi member? ;
114 : score-question ( question input -- question/f )
115 dup { f "q" } member? [
119 dup [ response>> ] keep parse-response >>parsed-response
120 dup check-response >>correct?
121 dup answer>> dup string? [ print ] [ . ] if
124 GENERIC: generate-question ( question -- )
126 ERROR: generator-needs-reponse-type generator ;
127 M: object generate-question
128 generator-needs-reponse-type ;
130 M: number-response generate-question
131 <number-question> generate-question ;
133 M: string-response generate-question
134 <string-question> generate-question ;
136 M: question generate-question
137 dup generate-question* >>generated
138 dup generated>> call( -- answer ) >>answer
141 M: multiple-choice-question generate-question
142 dup generate-question*
143 [ random >>generated ]
144 [ [ call( -- answer ) ] map alphabet-zip >>choices ] bi
145 dup [ choices>> ] [ generated>> call( -- answer ) ] bi
146 '[ second _ = ] find-all values keys >>answer
149 : run-one-question ( question -- question/f )
151 [ generate-question ]
153 [ readln score-question nl nl ]
156 GENERIC: run-quiz ( obj -- questions )
158 M: object run-quiz ( obj -- questions )
161 M: sequence run-quiz ( seq -- questions )
162 '[ _ random >question run-one-question ] loop>array ;
164 GENERIC#: run-multiple-choice-quiz 1 ( obj n -- questions )
166 M: object run-multiple-choice-quiz [ 1array ] dip run-multiple-choice-quiz ;
168 M: sequence run-multiple-choice-quiz ( seq n -- questions )
169 '[ _ random _ <multiple-choice-question> run-one-question ] loop>array ;
171 : score-quiz ( seq -- )
172 [ [ correct?>> ] count ]
174 [ drop 0.0 ] [ /f ] if-zero . ;
176 : run-states-quiz-hard ( -- )
177 T{ state-capital-question } 5 run-multiple-choice-quiz score-quiz ;
179 : run-shuffler-quiz ( -- )
181 T{ stack-shuffler { n-shufflers 4 } }
182 } 5 run-multiple-choice-quiz score-quiz ;
184 : run-main-quiz ( -- )
186 T{ multiplication { count 10 } { n 10 } }
187 T{ sqrt-question { random-choices 100 } }
188 T{ sq-question { random-choices 100 } }
189 } 5 run-multiple-choice-quiz score-quiz ;