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 io kernel math math.functions math.parser
   5 prettyprint quotations random sequences sequences.extras
   6 splitting strings unicode ;
   7 IN: quiz
   8
   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 )
  14
  15 TUPLE: question generator generated answer response parsed-response correct? ;
  16
  17 TUPLE: true-false-question < question ;
  18 : <true-false-question> ( generator -- question )
  19     true-false-question new
  20         swap >>generator ;
  21
  22 TUPLE: string-question < question ;
  23 : <string-question> ( generator -- question )
  24     string-question new
  25         swap >>generator ;
  26
  27 TUPLE: number-question < question ;
  28 : <number-question> ( generator -- question )
  29     number-question new
  30         swap >>generator ;
  31
  32 TUPLE: multiple-choice-question < question n choices ;
  33
  34 : <multiple-choice-question> ( generator n -- multiple-choice-question )
  35     multiple-choice-question new
  36         swap >>n
  37         swap >>generator ;
  38
  39 TUPLE: true-false-response ;
  40 TUPLE: string-response ;
  41 TUPLE: number-response ;
  42
  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 ;
  47
  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 ;
  53
  54 : trim-blanks ( seq -- seq' ) " " split harvest " " join ;
  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 ;
  60
  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 ;
  66
  67 M: multiplication generate-question*
  68     [ count>> random ] [ n>> ] bi '[ _ random 2 + ] replicate
  69     '[ _ product ] ;
  70 M: sqrt-question generate-question* random-choices>> random sq '[ _ sqrt >integer ] ;
  71 M: sq-question generate-question* random-choices>> random '[ _ sq ] ;
  72
  73
  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" }
  88 }
  89
  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 ;
  93
  94 CONSTANT: stack-shufflers { dup 2dup drop 2drop swap over rot -rot roll -roll 2dup pick dupd }
  95
  96 M: stack-shuffler generate-question*
  97     n-shufflers>> [ stack-shufflers random ] [ ] replicate-as
  98     [ inputs first-n-letters ] keep
  99     '[ _ _ with-datastack " " join ] ;
 100
 101 M: question ask-question generated>> . ;
 102 M: string-response ask-question generated>> . ;
 103 M: number-response ask-question generated>> . ;
 104
 105 M: multiple-choice-question ask-question
 106     [ generated>> . ] [ choices>> [ ... ] each ] bi ;
 107
 108 M: question check-response
 109     [ parsed-response>> ] [ answer>> ] bi = ;
 110 M: multiple-choice-question check-response
 111     [ parsed-response>> ] [ answer>> ] bi member? ;
 112
 113
 114 : score-question ( question input -- question/f )
 115     dup { f "q" } member? [
 116         2drop f
 117     ] [
 118         >>response
 119         dup [ response>> ] keep parse-response >>parsed-response
 120         dup check-response >>correct?
 121         dup answer>> dup string? [ print ] [ . ] if
 122     ] if ;
 123
 124 GENERIC: generate-question ( question -- )
 125
 126 ERROR: generator-needs-reponse-type generator ;
 127 M: object generate-question
 128     generator-needs-reponse-type ;
 129
 130 M: number-response generate-question
 131     <number-question> generate-question ;
 132
 133 M: string-response generate-question
 134     <string-question> generate-question ;
 135
 136 M: question generate-question
 137     dup generate-question* >>generated
 138     dup generated>> call( -- answer ) >>answer
 139     drop ;
 140
 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
 147     drop ;
 148
 149 : run-one-question ( question -- question/f )
 150     {
 151         [ generate-question ]
 152         [ ask-question ]
 153         [ readln score-question nl nl ]
 154     } cleave ;
 155
 156 GENERIC: run-quiz ( obj -- questions )
 157
 158 M: object run-quiz ( obj -- questions )
 159     1array run-quiz ;
 160
 161 M: sequence run-quiz ( seq -- questions )
 162     '[ _ random >question run-one-question ] loop>array ;
 163
 164 GENERIC#: run-multiple-choice-quiz 1 ( obj n -- questions )
 165
 166 M: object run-multiple-choice-quiz [ 1array ] dip run-multiple-choice-quiz ;
 167
 168 M: sequence run-multiple-choice-quiz ( seq n -- questions )
 169     '[ _ random _ <multiple-choice-question> run-one-question ] loop>array ;
 170
 171 : score-quiz ( seq -- )
 172     [ [ correct?>> ] count ]
 173     [ length ] bi
 174     [ drop 0.0 ] [ /f ] if-zero . ;
 175
 176 : run-states-quiz-hard ( -- )
 177     T{ state-capital-question } 5 run-multiple-choice-quiz score-quiz ;
 178
 179 : run-shuffler-quiz ( -- )
 180     {
 181         T{ stack-shuffler { n-shufflers 4 } }
 182     } 5 run-multiple-choice-quiz score-quiz ;
 183
 184 : run-main-quiz ( -- )
 185     {
 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 ;
 190
 191 MAIN: run-main-quiz