extra/quiz/quiz.factor

   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
   7 unicode.flags.images ;
   8 IN: quiz
   9
  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 )
  15
  16 TUPLE: question generator generated answer response parsed-response correct? ;
  17
  18 TUPLE: true-false-question < question ;
  19 : <true-false-question> ( generator -- question )
  20     true-false-question new
  21         swap >>generator ;
  22
  23 TUPLE: string-question < question ;
  24 : <string-question> ( generator -- question )
  25     string-question new
  26         swap >>generator ;
  27
  28 TUPLE: number-question < question ;
  29 : <number-question> ( generator -- question )
  30     number-question new
  31         swap >>generator ;
  32
  33 TUPLE: multiple-choice-question < question n choices ;
  34
  35 : <multiple-choice-question> ( generator n -- multiple-choice-question )
  36     multiple-choice-question new
  37         swap >>n
  38         swap >>generator ;
  39
  40 TUPLE: true-false-response ;
  41 TUPLE: string-response ;
  42 TUPLE: number-response ;
  43
  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 ;
  48
  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 ;
  54
  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 ;
  61
  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 ;
  69
  70 M: multiplication generate-question*
  71     [ count>> random ] [ n>> ] bi '[ _ random 2 + ] replicate
  72     '[ _ product ] ;
  73 M: sqrt-question generate-question* random-choices>> random sq '[ _ sqrt >integer ] ;
  74 M: sq-question generate-question* random-choices>> random '[ _ sq ] ;
  75
  76
  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" }
  91 }
  92
  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 ;
  96
  97 M: country-from-flag generate-question* drop valid-flags random '[ _ flag>unicode ] ;
  98 M: country-from-flag parse-response drop trim-blanks >title ;
  99
 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 ;
 102
 103 CONSTANT: stack-shufflers { dup 2dup drop 2drop swap over rot -rot roll -roll 2dup pick dupd }
 104
 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 ] ;
 109
 110 M: question ask-question generated>> . ;
 111 M: string-response ask-question generated>> . ;
 112 M: number-response ask-question generated>> . ;
 113
 114 M: multiple-choice-question ask-question
 115     [ generated>> . ] [ choices>> [ first2 swap "  (" ") " surround write ... ] each ] bi ;
 116
 117 M: question check-response
 118     [ parsed-response>> ] [ answer>> ] bi = ;
 119 M: multiple-choice-question check-response
 120     [ parsed-response>> ] [ answer>> ] bi member? ;
 121
 122
 123 : score-question ( question input -- question/f )
 124     dup { f "q" } member? [
 125         2drop f
 126     ] [
 127         >>response
 128         dup [ response>> ] keep parse-response >>parsed-response
 129         dup check-response >>correct?
 130         dup answer>> dup string? [ print ] [ . ] if
 131     ] if ;
 132
 133 GENERIC: generate-question ( question -- )
 134
 135 ERROR: generator-needs-reponse-type generator ;
 136 M: object generate-question
 137     generator-needs-reponse-type ;
 138
 139 M: number-response generate-question
 140     <number-question> generate-question ;
 141
 142 M: string-response generate-question
 143     <string-question> generate-question ;
 144
 145 M: question generate-question
 146     dup generate-question* >>generated
 147     dup generated>> call( -- answer ) >>answer
 148     drop ;
 149
 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
 156     drop ;
 157
 158 : run-one-question ( question -- question/f )
 159     {
 160         [ generate-question ]
 161         [ ask-question ]
 162         [ readln score-question nl nl ]
 163     } cleave ;
 164
 165 GENERIC: run-quiz ( obj -- questions )
 166
 167 M: object run-quiz ( obj -- questions )
 168     1array run-quiz ;
 169
 170 M: sequence run-quiz ( seq -- questions )
 171     '[ _ random >question run-one-question ] loop>array ;
 172
 173 GENERIC#: run-multiple-choice-quiz 1 ( obj n -- questions )
 174
 175 M: object run-multiple-choice-quiz [ 1array ] dip run-multiple-choice-quiz ;
 176
 177 M: sequence run-multiple-choice-quiz ( seq n -- questions )
 178     '[ _ random _ <multiple-choice-question> run-one-question ] loop>array ;
 179
 180 : score-quiz ( seq -- )
 181     [ [ correct?>> ] count ]
 182     [ length ] bi
 183     [ drop 0.0 ] [ /f ] if-zero 100 * "SCORE: %d%%\n" printf ;
 184
 185 : run-states-quiz-hard ( -- )
 186     T{ state-capital-question } 5 run-multiple-choice-quiz score-quiz ;
 187
 188 : run-shuffler-quiz ( -- )
 189     {
 190         T{ stack-shuffler { n-shufflers 4 } }
 191     } 5 run-multiple-choice-quiz score-quiz ;
 192
 193 : run-country-from-flag-quiz ( -- )
 194     {
 195         T{ country-from-flag { n 4 } }
 196     } 5 run-multiple-choice-quiz score-quiz ;
 197
 198 : run-flag-from-countries-quiz ( -- )
 199     {
 200         T{ flag-from-countries { n 4 } }
 201     } 5 run-multiple-choice-quiz score-quiz ;
 202
 203 : run-main-quiz ( -- )
 204     {
 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 ;
 209
 210 MAIN: run-main-quiz