to student :prob
say [The problem to be solved is] :prob
make "prob map.se [depunct ?] :prob
localmake "orgprob :prob
student1 :prob ~
         [[[the perimeter of ! rectangle]
           [twice the sum of the length and width of the rectangle]]
          [[two numbers] [one of the numbers and the other number]]
          [[two numbers] [one number and the other number]]]
end

to student1 :prob :idioms
local [simsen shelf aunits units wanted ans var lasteqn
       ref eqt1 beg end idiom reply]
make "prob idioms :prob
if match [^ two numbers #] :prob ~
   [make "idiom find [match (sentence "^beg first ? "#end) :orgprob] :idioms ~
    tryidiom stop]
while [match [^beg the the #end] :prob] [make "prob (sentence :beg "the :end)]
say [With mandatory substitutions the problem is] :prob
ifelse match [# @:in [[as old as] [age] [years old]] #] :prob ~
       [ageprob] [make "simsen bracket :prob]
lsay [The simple sentences are] :simsen
foreach [aunits wanted ans var lasteqn ref units] [make ? []]
make "shelf filter [not emptyp ?] map.se [senform ?] :simsen
lsay [The equations to be solved are] :shelf
make "units remdup :units
if trysolve :shelf :wanted :units :aunits [print [The problem is solved.] stop]
make "eqt1 remdup geteqns :var
if not emptyp :eqt1 [lsay [Using the following known relationships] :eqt1]
student2 :eqt1
end

to student2 :eqt1
make "var remdup sentence (map.se [varterms ?] :eqt1) :var
make "eqt1 sentence :eqt1 vartest :var
if not emptyp :eqt1 ~
   [if trysolve (sentence :shelf :eqt1) :wanted :units :aunits
       [print [The problem is solved.] stop]]
make "idiom find [match (sentence "^beg first ? "#end) :orgprob] :idioms
if not emptyp :idiom [tryidiom stop]
lsay [Do you know any more relationships among these variables?] :var
make "reply readlist
if equalp :reply [yes] [print [Tell me.] make "reply readlist]
if equalp :reply [no] [print [] print [I can't solve this problem.] stop]
make "reply map.se [depunct ?] :reply
if dlm last :reply [make "reply butlast :reply]
if not match [^beg is #end] :reply [print [I don't understand that.] stop]
make "shelf sentence :shelf :eqt1
student2 (list (list "equal opform :beg opform :end))
end

;; Mandatory substitutions

to depunct :word
if emptyp :word [output []]
if equalp first :word "$ [output sentence "$ depunct butfirst :word]
if equalp last :word "% [output sentence depunct butlast :word "percent]
if memberp last :word [. ? |;| ,] [output sentence depunct butlast :word last :word]
if emptyp butfirst :word [output :word]
if equalp last2 :word "'s [output sentence depunct butlast butlast :word "s]
output :word
end

to last2 :word
output word (last butlast :word) (last :word)
end

to idioms :sent
local "number
output changes :sent ~
    [[[the sum of] ["sum]] [[square of] ["square]] [[of] ["numof]]
     [[how old] ["what]] [[is equal to] ["is]]
     [[years younger than] [[less than]]] [[years older than] ["plus]]
     [[percent less than] ["perless]] [[less than] ["lessthan]]
     [[these] ["the]] [[more than] ["plus]]
     [[first two numbers] [[the first number and the second number]]]
     [[three numbers]
      [[the first number and the second number and the third number]]]
     [[one half] [0.5]] [[twice] [[2 times]]]
     [[$ !number] [sentence :number "dollars]] [[consecutive to] [[1 plus]]]
     [[larger than] ["plus]] [[per cent] ["percent]] [[how many] ["howm]]
     [[is multiplied by] ["ismulby]] [[is divided by] ["isdivby]]
     [[multiplied by] ["times]] [[divided by] ["divby]]]
end

to changes :sent :list
localmake "keywords map.se [findkey first ?] :list
output changes1 :sent :list :keywords
end

to findkey :pattern
if equalp first :pattern "!:in [output first butfirst :pattern]
if equalp first :pattern "?:in [output sentence (item 2 :pattern) (item 3 :pattern)]
output first :pattern
end

to changes1 :sent :list :keywords
if emptyp :sent [output []]
if memberp first :sent :keywords [output changes2 :sent :list :keywords]
output fput first :sent changes1 butfirst :sent :list :keywords
end

to changes2 :sent :list :keywords
changes3 :list :list
output fput first :sent changes1 butfirst :sent :list :keywords
end

to changes3 :biglist :nowlist
if emptyp :nowlist [stop]
if changeone first :nowlist [changes3 :biglist :biglist stop]
changes3 :biglist butfirst :nowlist
end

to changeone :change
local "end
if not match (sentence first :change [#end]) :sent [output "false]
make "sent run (sentence "sentence last :change ":end)
output "true
end

;; Division into simple sentences

to bracket :prob
output bkt1 finddelim :prob
end

to finddelim :sent
output finddelim1 :sent [] []
end

to finddelim1 :in :out :simples
if emptyp :in ~
   [ifelse emptyp :out [output :simples] [output lput (sentence :out ".) :simples]]
if dlm first :in ~
   [output finddelim1 (nocap butfirst :in) []
                      (lput (sentence :out first :in) :simples)]
output finddelim1 (butfirst :in) (sentence :out first :in) :simples
end

to nocap :words
if emptyp :words [output []]
if personp first :words [output :words]
output sentence (lowercase first :words) butfirst :words
end

to bkt1 :problist
local [first word rest]
if emptyp :problist [output []]
if not memberp ", first :problist ~
   [output fput first :problist bkt1 butfirst :problist]
if match [if ^first , !word:qword #rest] first :problist ~
   [output bkt1 fput (sentence :first ".)
                     fput (sentence :word :rest) butfirst :problist]
if match [^first , and #rest] first :problist ~
   [output fput (sentence :first ".) (bkt1 fput :rest butfirst :problist)]
output fput first :problist bkt1 butfirst :problist
end

;; Age problems

to ageprob
local [beg end sym who num subj ages]
while [match [^beg as old as #end] :prob] [make "prob sentence :beg :end]
while [match [^beg years old #end] :prob] [make "prob sentence :beg :end]
while [match [^beg will be when #end] :prob] ~
      [make "sym gensym
       make "prob (sentence :beg "in :sym [years . in] :sym "years :end)]
while [match [^beg was when #end] :prob] ~
      [make "sym gensym
       make "prob (sentence :beg :sym [years ago .] :sym [years ago] :end)]
while [match [^beg !who:personp will be in !num years #end] :prob] ~
      [make "prob (sentence :beg :who [s age in] :num "years #end)]
while [match [^beg was #end] :prob] [make "prob (sentence :beg "is :end)]
while [match [^beg will be #end] :prob] [make "prob (sentence :beg "is :end)]
while [match [^beg !who:personp is now #end] :prob] ~
      [make "prob (sentence :beg :who [s age now] :end)]
while [match [^beg !num years from now #end] :prob] ~
      [make "prob (sentence :beg "in :num "years :end)]
make "prob ageify :prob
ifelse match [^ !who:personp ^end s age #] :prob ~
       [make "subj sentence :who :end] [make "subj "someone]
make "prob agepron :prob
make "end :prob
make "ages []
while [match [^ !who:personp ^beg age #end] :end] ~
      [push "ages (sentence "and :who :beg "age)]
make "ages butfirst reduce "sentence remdup :ages
while [match [^beg their ages #end] :prob] [make "prob (sentence :beg :ages :end)]
make "simsen map [agesen ?] bracket :prob
end

to ageify :sent
if emptyp :sent [output []]
if not personp first :sent [output fput first :sent ageify butfirst :sent]
catch "error [if equalp first butfirst :sent "s
                 [output fput first :sent ageify butfirst :sent]]
output (sentence first :sent [s age] ageify butfirst :sent)
end

to agepron :sent
if emptyp :sent [output []]
if not pronoun first :sent [output fput first :sent agepron butfirst :sent]
if posspro first :sent [output (sentence :subj "s agepron butfirst :sent)]
output (sentence :subj [s age] agepron butfirst :sent)
end

to agesen :sent
local [when rest num]
make "when []
if match [in !num years #rest] :sent ~
   [make "when sentence "pluss :num make "sent :rest]
if match [!num years ago #rest] :sent ~
   [make "when sentence "minuss :num make "sent :rest]
output agewhen :sent
end

to agewhen :sent
if emptyp :sent [output []]
if not equalp first :sent "age [output fput first :sent agewhen butfirst :sent]
if match [in !num years #rest] butfirst :sent ~
   [output (sentence [age pluss] :num agewhen :rest)]
if match [!num years ago #rest] butfirst :sent ~
   [output (sentence [age minuss] :num agewhen :rest)]
if equalp "now first butfirst :sent ~
   [output sentence "age agewhen butfirst butfirst :sent]
output (sentence "age :when agewhen butfirst :sent)
end

;; Translation from sentences into equations

to senform :sent
make "lasteqn senform1 :sent
output :lasteqn
end

to senform1 :sent
local [one two verb1 verb2 stuff1 stuff2 factor]
if emptyp :sent [output []]
if match [^ what are ^one and ^two !:dlm] :sent ~
   [output fput (qset :one) (senform (sentence [what are] :two "?))]
if match [^ what !:in [is are] #one !:dlm] :sent ~
   [output (list qset :one)]
if match [^ howm !one is #two !:dlm] :sent ~
   [push "aunits (list :one) output (list qset :two)]
if match [^ howm ^one do ^two have !:dlm] :sent ~
   [output (list qset (sentence [the number of] :one :two "have))]
if match [^ howm ^one does ^two have !:dlm] :sent ~
   [output (list qset (sentence [the number of] :one :two "has))]
if match [^ find ^one and #two] :sent ~
   [output fput (qset :one) (senform sentence "find :two)]
if match [^ find #one !:dlm] :sent [output (list qset :one)]
make "sent filter [not article ?] :sent
if match [^one ismulby #two] :sent ~
   [push "ref (list "product opform :one opform :two) output []]
if match [^one isdivby #two] :sent ~
   [push "ref (list "quotient opform :one opform :two) output []]
if match [^one is increased by #two] :sent ~
   [push "ref (list "sum opform :one opform :two) output []]
if match [^one is #two] :sent ~
   [output (list (list "equal opform :one opform :two))]
if match [^one !verb1:verb ^factor as many ^stuff1 as
          ^two !verb2:verb ^stuff2 !:dlm] ~
         :sent ~
   [if emptyp :stuff2 [make "stuff2 :stuff1]
    output (list (list "equal ~
                   opform (sentence [the number of] :stuff1 :one :verb1) ~
                   opform (sentence :factor [the number of] :stuff2 :two :verb2)))]
if match [^one !verb1:verb !factor:numberp #stuff1 !:dlm] :sent ~
   [output (list (list "equal ~
                   opform (sentence [the number of] :stuff1 :one :verb1) ~
                   opform (list :factor)))]
say [This sentence form is not recognized:] :sent
throw "error
end

to qset :sent
localmake "opform opform filter [not article ?] :sent
if not operatorp first :opform ~
   [queue "wanted :opform queue "ans list :opform oprem :sent output []]
localmake "gensym gensym
queue "wanted :gensym
queue "ans list :gensym oprem :sent
output (list "equal :gensym opform (filter [not article ?] :sent))
end

to oprem :sent
output map [ifelse equalp ? "numof ["of] [?]] :sent
end

to opform :expr
local [left right op]
if match [^left !op:op2 #right] :expr [output optest :op :left :right]
if match [^left !op:op1 #right] :expr [output optest :op :left :right]
if match [^left !op:op0 #right] :expr [output optest :op :left :right]
if match [#left !:dlm] :expr [make "expr :left]
output nmtest filter [not article ?] :expr
end

to optest :op :left :right
output run (list (word "tst. :op) :left :right)
end

to tst.numof :left :right
if numberp last :left [output (list "product opform :left opform :right)]
output opform (sentence :left "of :right)
end

to tst.divby :left :right
output (list "quotient opform :left opform :right)
end

to tst.tothepower :left :right
output (list "expt opform :left opform :right)
end

to expt :num :pow
if :pow < 1 [output 1]
output :num * expt :num :pow - 1
end

to tst.per :left :right
output (list "quotient ~
          opform :left ~
          opform (ifelse numberp first :right [:right] [fput 1 :right]))
end

to tst.lessthan :left :right
output opdiff opform :right opform :left
end

to opdiff :left :right
output (list "sum :left (list "minus :right))
end

to tst.minus :left :right
if emptyp :left [output list "minus opform :right]
output opdiff opform :left opform :right
end

to tst.minuss :left :right
output tst.minus :left :right
end

to tst.sum :left :right
local [one two three]
if match [^one and ^two and #three] :right ~
   [output (list "sum opform :one opform (sentence "sum :two "and :three))]
if match [^one and #two] :right ~
   [output (list "sum opform :one opform :two)]
say [sum used wrong:] :right
throw "error
end

to tst.squared :left :right
output list "square opform :left
end

to tst.difference :left :right
local [one two]
if match [between ^one and #two] :right [output opdiff opform :one opform :two]
say [Incorrect use of difference:] :right
throw "error
end

to tst.plus :left :right
output (list "sum opform :left opform :right)
end

to tst.pluss :left :right
output tst.plus :left :right
end

to square :x
output :x * :x
end

to tst.square :left :right
output list "square opform :right
end

to tst.percent :left :right
if not numberp last :left ~
   [say [Incorrect use of percent:] :left throw "error]
output opform (sentence butlast :left ((last :left) / 100) :right)
end

to tst.perless :left :right
if not numberp last :left ~
   [say [Incorrect use of percent:] :left throw "error]
output (list "product ~
          (opform sentence butlast :left ((100 - (last :left)) / 100)) ~
          opform :right)
end

to tst.times :left :right
if emptyp :left [say [Incorrect use of times:] :right throw "error]
output (list "product opform :left opform :right)
end

to nmtest :expr
if match [& !:numberp #] :expr [say [argument error:] :expr throw "error]
if and (equalp first :expr 1) (1 < count :expr) ~
   [make "expr (sentence 1 plural (first butfirst :expr) (butfirst butfirst :expr))]
if and (numberp first :expr) (1 < count :expr) ~
   [push "units (list first butfirst :expr) ~
    output (list "product (first :expr) (opform butfirst :expr))]
if numberp first :expr [output first :expr]
if memberp "this :expr [output this :expr]
if not memberp :expr :var [push "var :expr]
output :expr
end

to this :expr
if not emptyp :ref [output pop "ref]
if not emptyp :lasteqn [output first butfirst last :lasteqn]
if equalp first :expr "this [make "expr butfirst :expr]
push "var :expr
output :expr
end

;; Solving the equations

to trysolve :shelf :wanted :units :aunits
local "solution
make "solution solve :wanted :shelf (ifelse emptyp :aunits [:units] [:aunits])
output pranswers :ans :solution
end

to solve :wanted :eqt :terms
output solve.reduce solver :wanted :terms [] [] "insufficient
end

to solve.reduce :soln
if emptyp :soln [output []]
if wordp :soln [output :soln]
if emptyp butfirst :soln [output :soln]
local "part
make "part solve.reduce butfirst :soln
output fput (list (first first :soln) (subord last first :soln :part)) :part
end

to solver :wanted :terms :alis :failed :err
local [one result restwant]
if emptyp :wanted [output :err]
make "one solve1 (first :wanted) ~
                 (sentence butfirst :wanted :failed :terms) ~
                 :alis :eqt [] "insufficient
if wordp :one ~
   [output solver (butfirst :wanted) :terms :alis (fput first :wanted :failed) :one]
make "restwant (sentence :failed butfirst :wanted)
if emptyp :restwant [output :one]
make "result solver :restwant :terms :one [] "insufficient
if listp :result [output :result]
output solver (butfirst :wanted) :terms :alis (fput first :wanted :failed) :one
end

to solve1 :x :terms :alis :eqns :failed :err
local [thiseq vars extras xterms others result]
if emptyp :eqns [output :err]
make "thiseq subord (first :eqns) :alis
make "vars varterms :thiseq
if not memberp :x :vars ~
   [output solve1 :x :terms :alis (butfirst :eqns) (fput first :eqns :failed) :err]
make "xterms fput :x :terms
make "extras setminus :vars :xterms
make "eqt remove (first :eqns) :eqt
if not emptyp :extras ~
   [make "others solver :extras :xterms :alis [] "insufficient
    ifelse wordp :others
           [make "eqt sentence :failed :eqns
            output solve1 :x :terms :alis (butfirst :eqns)
                      (fput first :eqns :failed) :others]
           [make "alis :others
            make "thiseq subord (first :eqns) :alis]]
make "result solveq :x :thiseq
if listp :result [output lput :result :alis]
make "eqt sentence :failed :eqns
output solve1 :x :terms :alis (butfirst :eqns) (fput first :eqns :failed) :result
end

to solveq :var :eqn
local [left right]
make "left first butfirst :eqn
ifelse occvar :var :left ~
   [make "right last :eqn] [make "right :left make "left last :eqn]
output solveq1 :left :right "true
end

to solveq1 :left :right :bothtest
if :bothtest [if occvar :var :right [output solveqboth :left :right]]
if equalp :left :var [output list :var :right]
if wordp :left [output "unsolvable]
local "oper
make "oper first :left
if memberp :oper [sum product minus quotient] [output run (list word "solveq. :oper)]
output "unsolvable
end

to solveqboth :left :right
if not equalp first :right "sum [output solveq1 (subterm :left :right) 0 "false]
output solveq.rplus :left butfirst :right []
end

to solveq.rplus :left :right :newright
if emptyp :right [output solveq1 :left (simone "sum :newright) "false]
if occvar :var first :right ~
   [output solveq.rplus (subterm :left first :right) butfirst :right :newright]
output solveq.rplus :left butfirst :right (fput first :right :newright)
end

to solveq.sum
if emptyp butfirst butfirst :left [output solveq1 first butfirst :left :right "true]
output solveq.sum1 butfirst :left :right []
end

to solveq.sum1 :left :right :newleft
if emptyp :left [output solveq.sum2]
if occvar :var first :left ~
   [output solveq.sum1 butfirst :left :right fput first :left :newleft]
output solveq.sum1 butfirst :left (subterm :right first :left) :newleft
end

to solveq.sum2
if emptyp butfirst :newleft [output solveq1 first :newleft :right "true]
localmake "factor factor :newleft :var
if equalp first :factor "unknown [output "unsolvable]
if equalp last :factor 0 [output "unsolvable]
output solveq1 first :factor (divterm :right last :factor) "true
end

to solveq.minus
output solveq1 (first butfirst :left) (minusin :right) "false
end

to solveq.product
output solveq.product1 :left :right
end

to solveq.product1 :left :right
if emptyp butfirst butfirst :left [output solveq1 (first butfirst :left) :right "true]
if not occvar :var first butfirst :left ~
   [output solveq.product1 (fput "product butfirst butfirst :left)
                           (divterm :right first butfirst :left)]
localmake "rest simone "product butfirst butfirst :left
if occvar :var :rest [output "unsolvable]
output solveq1 (first butfirst :left) (divterm :right :rest) "false
end

to solveq.quotient
if occvar :var first butfirst :left ~
   [output solveq1 (first butfirst :left) (simtimes list :right last :left) "true]
output solveq1 (simtimes list :right last :left) (first butfirst :left) "true
end

to denom :fract :addends
make "addends simplus :addends
localmake "den last :fract
if not equalp first :addends "quotient ~
   [output simdiv list (simone "sum
                               (remop "sum list (distribtimes (list :addends) :den)
                                                first butfirst :fract))
                       :den]
if equalp :den last :addends ~
   [output simdiv (simplus list (first butfirst :fract) (first butfirst :addends))
                  :den]
localmake "lowterms simdiv list :den last :addends
output simdiv list (simplus (simtimes list first butfirst :fract last :lowterms)
                            (simtimes list first butfirst :addends
                                           first butfirst :lowterms)) ~
                   (simtimes list first butfirst :lowterms last :addends)
end

to distribtimes :trms :multiplier
output simplus map [simtimes (list ? :multiplier)] :trms
end

to distribx :expr
local [oper args]
if emptyp :expr [output :expr]
make "oper first :expr
if not operatorp :oper [output :expr]
make "args map [distribx ?] butfirst :expr
if reduce "and map [numberp ?] :args [output run (sentence [(] :oper :args [)])]
if equalp :oper "sum [output simplus :args]
if equalp :oper "minus [output minusin first :args]
if equalp :oper "product [output simtimes :args]
if equalp :oper "quotient [output simdiv :args]
output fput :oper :args
end

to divterm :dividend :divisor
if equalp :dividend 0 [output 0]
output simdiv list :dividend :divisor
end

to factor :exprs :var
local "trms
make "trms map [factor1 :var ?] :exprs
if memberp "unknown :trms [output fput "unknown :exprs]
output list :var simplus :trms
end

to factor1 :var :expr
localmake "negvar minusin :var
if equalp :var :expr [output 1]
if equalp :negvar :expr [output -1]
if emptyp :expr [output "unknown]
if equalp first :expr "product [output factor2 butfirst :expr]
if not equalp first :expr "quotient [output "unknown]
localmake "dividend first butfirst :expr
if equalp :var :dividend [output (list "quotient 1 last :expr)]
if not equalp first :dividend "product [output "unknown]
localmake "result factor2 butfirst :dividend
if equalp :result "unknown [output "unknown]
output (list "quotient :result last :expr)
end

to factor2 :trms
if memberp :var :trms [output simone "product (remove :var :trms)]
if memberp :negvar :trms [output minusin simone "product (remove :negvar :trms)]
output "unknown
end

to maybeadd :num :rest
if equalp :num 0 [output :rest]
output fput :num :rest
end

to maybemul :num :rest
if equalp :num 1 [output :rest]
output fput :num :rest
end

to minusin :expr
if emptyp :expr [output -1]
if equalp first :expr "sum [output fput "sum map [minusin ?] butfirst :expr]
if equalp first :expr "minus [output last :expr]
if memberp first :expr [product quotient] ~
   [output fput first :expr
                (fput (minusin first butfirst :expr) butfirst butfirst :expr)]
if numberp :expr [output minus :expr]
output list "minus :expr
end

to occvar :var :expr
if emptyp :expr [output "false]
if wordp :expr [output equalp :var :expr]
if operatorp first :expr [output not emptyp find [occvar :var ?] butfirst :expr]
output equalp :var :expr
end

to remfactor :num :den
foreach butfirst :num [remfactor1 ?]
output (list "quotient (simone "product butfirst :num) (simone "product butfirst :den))
end

to remfactor1 :expr
local "neg
if memberp :expr :den ~
   [make "num remove :expr :num  make "den remove :expr :den  stop]
make "neg minusin :expr
if not memberp :neg :den [stop]
make "num remove :expr :num
make "den minusin remove :neg :den
end

to remop :oper :exprs
output map.se [ifelse equalp first ? :oper [butfirst ?] [(list ?)]] :exprs
end

to simdiv :list
local [num den numop denop]
make "num first :list
make "den last :list
if equalp :num :den [output 1]
if numberp :den [output simtimes (list (quotient 1 :den) :num)]
make "numop first :num
make "denop first :den
if equalp :numop "quotient ~
   [output simdiv list (first butfirst :num) (simtimes list last :num :den)]
if equalp :denop "quotient ~
   [output simdiv list (simtimes list :num last :den) (first butfirst :den)]
if and equalp :numop "product equalp :denop "product [output remfactor :num :den]
if and equalp :numop "product memberp :den :num [output remove :den :num]
output fput "quotient :list
end

to simone :oper :trms
if emptyp :trms [output ifelse equalp :oper "product [1] [0]]
if emptyp butfirst :trms [output first :trms]
output fput :oper :trms
end

to simplus :exprs
make "exprs remop "sum :exprs
localmake "factor [unknown]
catch "simplus ~
      [foreach :terms ~
               [make "factor (factor :exprs ?) ~
                if not equalp first :factor "unknown [throw "simplus]]]
if not equalp first :factor "unknown [output fput "product remop "product :factor]
localmake "nums 0
localmake "nonnums []
localmake "quick []
catch "simplus [simplus1 :exprs]
if not emptyp :quick [output :quick]
if not equalp :nums 0 [push "nonnums :nums]
output simone "sum :nonnums
end

to simplus1 :exprs
if emptyp :exprs [stop]
simplus2 first :exprs
simplus1 butfirst :exprs
end

to simplus2 :pos
local "neg
make "neg minusin :pos
if numberp :pos [make "nums sum :pos :nums stop]
if memberp :neg butfirst :exprs [make "exprs remove :neg :exprs stop]
if equalp first :pos "quotient ~
   [make "quick (denom :pos (maybeadd :nums sentence :nonnums butfirst :exprs)) ~
    throw "simplus]
push "nonnums :pos
end

to simtimes :exprs
local [nums nonnums quick]
make "nums 1
make "nonnums []
make "quick []
catch "simtimes [foreach remop "product :exprs [simtimes1 ?]]
if not emptyp :quick [output :quick]
if equalp :nums 0 [output 0]
if not equalp :nums 1 [push "nonnums :nums]
output simone "product :nonnums
end

to simtimes1 :expr
if equalp :expr 0 [make "nums 0 throw "simtimes]
if numberp :expr [make "nums product :expr :nums stop]
if equalp first :expr "sum ~
   [make "quick distribtimes (butfirst :expr)
                             (simone "product maybemul :nums sentence :nonnums ?rest)
    throw "simtimes]
if equalp first :expr "quotient ~
   [make "quick
          simdiv (list (simtimes (list (first butfirst :expr)
                                       (simone "product
                                               maybemul :nums
                                                        sentence :nonnums ?rest)))
                       (last :expr))
    throw "simtimes]
push "nonnums :expr
end

to subord :expr :alist
output distribx subord1 :expr :alist
end

to subord1 :expr :alist
if emptyp :alist [output :expr]
output subord (substop (last first :alist) (first first :alist) :expr) ~
              (butfirst :alist)
end

to substop :val :var :expr
if emptyp :expr [output []]
if equalp :expr :var [output :val]
if not operatorp first :expr [output :expr]
output fput first :expr map [substop :val :var ?] butfirst :expr
end

to subterm :minuend :subtrahend
if equalp :minuend 0 [output minusin :subtrahend]
if equalp :minuend :subtrahend [output 0]
output simplus (list :minuend minusin :subtrahend)
end

to varterms :expr
if emptyp :expr [output []]
if numberp :expr [output []]
if wordp :expr [output (list :expr)]
if operatorp first :expr [output map.se [varterms ?] butfirst :expr]
output (list :expr)
end

;; Printing the solutions

to pranswers :ans :solution
print []
if equalp :solution "unsolvable ~
   [print [Unable to solve this set of equations.] output "false]
if equalp :solution "insufficient ~
   [print [The equations were insufficient to find a solution.] output "false]
localmake "gotall "true
foreach :ans [if prans ? :solution [make "gotall "false]]
if not :gotall [print [] print [Unable to solve this set of equations.]]
output :gotall
end

to prans :ans :solution
localmake "result find [equalp first ? first :ans] :solution
if emptyp :result [output "true]
print (sentence cap last :ans "is unitstring last :result)
print []
output "false
end

to unitstring :expr
if numberp :expr [output roundoff :expr]
if equalp first :expr "product ~
   [output sentence (unitstring first butfirst :expr)
                    (reduce "sentence butfirst butfirst :expr)]
if (and (listp :expr)
         (not numberp first :expr)
         (not operatorp first :expr)) ~
   [output (sentence 1 (singular first :expr) (butfirst :expr))]
output :expr
end

to roundoff :num
if (abs (:num - round :num)) < 0.0001 [output round :num]
output :num
end

to abs :num
output ifelse (:num < 0) [-:num] [:num]
end

;; Using known relationships

to geteqns :vars
output map.se [gprop varkey ? "eqns] :vars
end

to varkey :var
local "word
if match [number of !word #] :var [output :word]
output first :var
end

;; Assuming equality of similar variables

to vartest :vars
if emptyp :vars [output []]
local [var beg end]
make "var first :vars
output (sentence (ifelse match [^beg !:pronoun #end] :var
                         [vartest1 :var (sentence :beg "& :end) butfirst :vars]
                         [[]])
                 (vartest1 :var (sentence "# :var "#) butfirst :vars)
                 (vartest butfirst :vars))
end

to vartest1 :target :pat :vars
output map [varequal :target ?] filter [match :pat ?] :vars
end

to varequal :target :var
print []
print [Assuming that]
print (sentence (list :target) [is equal to] (list :var))
output (list "equal :target :var)
end

;; Optional substitutions

to tryidiom
make "prob (sentence :beg last :idiom :end)
while [match (sentence "^beg first :idiom "#end) :prob] ~
      [make "prob (sentence :beg last :idiom :end)]
say [The problem with an idiomatic substitution is] :prob
student1 :prob (remove :idiom :idioms)
end

;; Utility procedures

to qword :word
output memberp :word [find what howm how]
end

to dlm :word
output memberp :word [. ? |;|]
end

to article :word
output memberp :word [a an the]
end

to verb :word
output memberp :word [have has get gets weigh weighs]
end

to personp :word
output memberp :word [Mary Ann Bill Tom Sally Frank father uncle]
end

to pronoun :word
output memberp :word [he she it him her they them his her its]
end

to posspro :word
output memberp :word [his her its]
end

to op0 :word
output memberp :word [pluss minuss squared tothepower per sum difference numof]
end

to op1 :word
output memberp :word [times divby square]
end

to op2 :word
output memberp :word [plus minus lessthan percent perless]
end

to operatorp :word
output memberp :word [sum minus product quotient expt square equal]
end

to plural :word
localmake "plural gprop :word "plural
if not emptyp :plural [output :plural]
if not emptyp gprop :word "sing [output :word]
if equalp last :word "s [output :word]
output word :word "s
end

to singular :word
localmake "sing gprop :word "sing
if not emptyp :sing [output :sing]
if not emptyp gprop :word "plural [output :word]
if equalp last :word "s [output butlast :word]
output :word
end

to setminus :big :little
output filter [not memberp ? :little] :big
end

to say :herald :text
print []
print :herald
print []
print :text
print []
end

to lsay :herald :text
print []
print :herald
print []
foreach :text [print cap ? print []]
end

to cap :sent
if emptyp :sent [output []]
output sentence (word uppercase first first :sent butfirst first :sent) ~
                butfirst :sent
end

;; The pattern matcher

to match :pat :sen
if prematch :pat :sen [output rmatch :pat :sen]
output "false
end

to prematch :pat :sen
if emptyp :pat [output "true]
if listp first :pat [output prematch butfirst :pat :sen]
if memberp first first :pat [! @ # ^ & ?] [output prematch butfirst :pat :sen]
if emptyp :sen [output "false]
localmake "rest member first :pat :sen
if not emptyp :rest [output prematch butfirst :pat :rest]
output "false
end

to rmatch :pat :sen
local [special.var special.pred special.buffer in.list]
if or wordp :pat wordp :sen [output "false]
if emptyp :pat [output emptyp :sen]
if listp first :pat [output special fput "!: :pat :sen]
if memberp first first :pat [? # ! & @ ^] [output special :pat :sen]
if emptyp :sen [output "false]
if equalp first :pat first :sen [output rmatch butfirst :pat butfirst :sen]
output "false
end

to special :pat :sen
set.special parse.special butfirst first :pat "
output run word "match first first :pat
end

to parse.special :word :var
if emptyp :word [output list :var "always]
if equalp first :word ": [output list :var butfirst :word]
output parse.special butfirst :word word :var first :word
end

to set.special :list
make "special.var first :list
make "special.pred last :list
if emptyp :special.var [make "special.var "special.buffer]
if memberp :special.pred [in anyof] [set.in]
if not emptyp :special.pred [stop]
make "special.pred first butfirst :pat
make "pat fput first :pat butfirst butfirst :pat
end

to set.in
make "in.list first butfirst :pat
make "pat fput first :pat butfirst butfirst :pat
end

to match!
if emptyp :sen [output "false]
if not try.pred [output "false]
make :special.var first :sen
output rmatch butfirst :pat butfirst :sen
end

to match?
make :special.var []
if emptyp :sen [output rmatch butfirst :pat :sen]
if not try.pred [output rmatch butfirst :pat :sen]
make :special.var first :sen
if rmatch butfirst :pat butfirst :sen [output "true]
make :special.var []
output rmatch butfirst :pat :sen
end

to match#
make :special.var []
output #test #gather :sen
end

to #gather :sen
if emptyp :sen [output :sen]
if not try.pred [output :sen]
make :special.var lput first :sen thing :special.var
output #gather butfirst :sen
end

to #test :sen
if rmatch butfirst :pat :sen [output "true]
if emptyp thing :special.var [output "false]
output #test2 fput last thing :special.var :sen
end

to #test2 :sen
make :special.var butlast thing :special.var
output #test :sen
end

to match&
output &test match#
end

to &test :tf
if emptyp thing :special.var [output "false]
output :tf
end

to match^
make :special.var []
output ^test :sen
end

to ^test :sen
if rmatch butfirst :pat :sen [output "true]
if emptyp :sen [output "false]
if not try.pred [output "false]
make :special.var lput first :sen thing :special.var
output ^test butfirst :sen
end

to match@
make :special.var :sen
output @test []
end

to @test :sen
if @try.pred [if rmatch butfirst :pat :sen [output "true]]
if emptyp thing :special.var [output "false]
output @test2 fput last thing :special.var :sen
end

to @test2 :sen
make :special.var butlast thing :special.var
output @test :sen
end

to try.pred
if listp :special.pred [output rmatch :special.pred first :sen]
output run list :special.pred quoted first :sen
end

to quoted :thing
if listp :thing [output :thing]
output word "" :thing
end

to @try.pred
if listp :special.pred [output rmatch :special.pred thing :special.var]
output run list :special.pred thing :special.var
end

to always :x
output "true
end

to in :word
output memberp :word :in.list
end

to anyof :sen
output anyof1 :sen :in.list
end

to anyof1 :sen :pats
if emptyp :pats [output "false]
if rmatch first :pats :sen [output "true]
output anyof1 :sen butfirst :pats
end

;; Sample word problems

make "ann [Mary is twice as old as Ann was when Mary was as old as Ann is now.
  If Mary is 24 years old, how old is Ann?]
make "guns [The number of soldiers the Russians have is
  one half of the number of guns they have. They have 7000 guns.
  How many soldiers do they have?]
make "jet [The distance from New York to Los Angeles is 3000 miles.
  If the average speed of a jet plane is 600 miles per hour,
  find the time it takes to travel from New York to Los Angeles by jet.]
make "nums [A number is multiplied by 6 . This product is increased by 44 .
  This result is 68 . Find the number.]
make "radio [The price of a radio is $69.70.
  If this price is 15 percent less than the marked price, find the marked price.]
make "sally [The sum of Sally's share of some money and Frank's share is $4.50.
  Sally's share is twice Frank's. Find Frank's and Sally's share.]
make "ship [The gross weight of a ship is 20000 tons.
  If its net weight is 15000 tons, what is the weight of the ships cargo?]
make "span [If 1 span is 9 inches, and 1 fathom is 6 feet,
  how many spans is 1 fathom?]
make "sumtwo [The sum of two numbers is 96,
  and one number is 16 larger than the other number. Find the two numbers.]
make "tom [If the number of customers Tom gets is
  twice the square of 20 per cent of the number of advertisements he runs,
  and the number of advertisements he runs is 45,
  what is the number of customers Tom gets?]
make "uncle [Bill's father's uncle is twice as old as Bill's father.
  2 years from now Bill's father will be 3 times as old as Bill.
  The sum of their ages is 92 . Find Bill's age.]

;; Initial data base

pprop "distance "eqns ~
  [[equal [distance] [product [speed] [time]]]
   [equal [distance] [product [gas consumtion] [number of gallons of gas used]]]]
pprop "feet "eqns ~
  [[equal [product 1 [feet]] [product 12 [inches]]]
   [equal [product 1 [yards]] [product 3 [feet]]]]
pprop "feet "sing "foot
pprop "foot "plural "feet
pprop "gallons "eqns ~
  [[equal [distance] [product [gas consumtion] [number of gallons of gas used]]]]
pprop "gas "eqns ~
  [[equal [distance] [product [gas consumtion] [number of gallons of gas used]]]]
pprop "inch "plural "inches
pprop "inches "eqns [[equal [product 1 [feet]] [product 12 [inches]]]]
pprop "people "sing "person
pprop "person "plural "people
pprop "speed "eqns [[equal [distance] [product [speed] [time]]]]
pprop "time "eqns [[equal [distance] [product [speed] [time]]]]
pprop "yards "eqns [[equal [product 1 [yards]] [product 3 [feet]]]]