September 24, 1976 1:39 PMfile: [IVY]<KRL>document>ex-crypt-mid
||[Blank ↑[a Unit]
||[BothAddendsKnown ↑{[a Unit][WhenIdentified (LISP (TryStrategy))]}
||[Column ↑{[a Unit]
||[ColumnDescription
||[EvenNumber ↑[a Unit][ToMatch ...??
||[Hypothesis ↑[a Unit]
||[Letter ↑[a Unit]
||[MagnitudeOrder ↑{[a Unit]
||[NeitherAddendKnown ↑{[a Unit][WhenIdentified (LISP (TryStrategy))]}
||[OddNumber ↑[a Unit][ToMatch ...??
||[OneAddendKnown ↑{[a Unit][WhenIdentified (LISP (TryStrategy))]}
||[NoBlanks ↑{[a Unit]
||[OneBlank ↑{[a Unit]
||[TwoBlanks ↑{[a Unit]
||[Problem ↑{[a Unit]
|[SumEqualsAddend↑{[a Unit][FurtherSpecified Column]
|[Summation↑[a Unit]
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
(CallIfNeeded
(CheckAppearances
(CheckIfDone
(ClassifyColumn
(DOP1
(GetLetters
(GetParity
(GiveAnswer
(MakeCharacterUnit
(ProcessColumn
(ProcessOneBlank
(ProcessSumEq
(ProcessSummation
(ProcessForBounds
(ProcessLinear
(ProcessSummationForParity
(ProcessTwin
(ReportImpossibleProblem
(SetUpProblem
(TestCases
(TestMagnitudeMapping
(TryCasesForLetter
(TryStrategy
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
||[Blank ↑[a Unit]
|[self [a Letter with value = 0]]]
||[Column ↑{[a Unit]
[WhenAllKnown <"topLetter" "bottomLetter" "sumLetter">
(LISP (ClassifyColumn))]
[WhenAnyDescribed <"carryIn" "carryOut" "sum">
[LISP (CheckPossibilities)]
[WhenAnyKnown <"carryIn" "carryOut" "sum">
[LispApply (LISP ProcessColumn) (my self)]}
|[self {(a Summation with sum = (my sum))
↑ [* "further described in doing ClassifyColumn"]}]
|[leftNeighbor
{(a Column with carryIn =
(using (my carryOut) 10 ~ 1 0 ~ 0)) ↑[Label carry1]}]
|[rightNeighbor
{(a Column with carryOut =
(using (my carryIn) 1 ~ 10 0 ~ 0)) ↑[Label carry2]}]
|[carryIn ↑[WhenKnown (DescribeEval (my leftNeighbor) [my carry1] ]]
{(an Integer) (Among <0 1>)}]
|[carryOut
↑{[WhenKnown (DescribeEval (my rightNeighbor) [my carry2]]]
[WhenKnown (DescribeEval (my sum) [my sumBound]]]}
{(an EvenNumber) (Among <0 10>)}]
|[sum ↑[WhenKnown (DescribeEval (my sumLetter) [my sum1]]]
{{(using (my carryOut)
1 ~ (AtLeast 10)
0 ~ (AtMost 9)) ↑[Label sumBound]}
(an Integer)(Among [IntegerInterval 0 19]}]
|[topLetter (a Letter)]
|[bottomLetter (a Letter)]
|[sumLetter
{{(a Letter with value = (OnesDigit (my sum))) ↑ [Label sum1]}]
]]
||[ColumnDescription
↑{[a Unit]
[* "the following trigger causes each ColumnDescription unit (e.g. OneBlank) to have a trigger which will be called when it is used as a template for a column. TryStrategy in turn applies the matchDesc to get the bindings."]
[WhenIdentified
[LISPApply (LISP AddTrigger)
<\[WhenIdentified (LISP (TryStrategy))]>]]}
|[InitialStrategy (a LispAction)]
|[RepeatableStrategies (SetOf \(a LispAction))]]
||[EvenNumber ↑{[a Unit]
[ToTestExistence (LISP (PROG((x (Item (this instance)))
(RETURN
(AND (NUMBERP X)
(EQ (IREMAINDER x 2) 0)))))]}
|[self (an Integer)]]
||[Hypothesis ↑[a Unit]
|[base (a Thing)]
|[assumption (a Description)]
|[status (Among <"Impossible" "Possible">)]]
||[Letter ↑[a Unit]
|[value ↑{[WhenKnown (LISP (CheckAppearnces))]
[WhenDescribed (LISP (CheckPossibilities))]}
(an Integer) (Among [IntegerInterval 0 9])]]
||[MagnitudeOrder ↑{[a Unit]
[Functional "AtLeast" higher lower]
[Functional "AtMost" lower higher]
[ToTestExistence (LISP TestMagnitudeMapping)]}
|[higher (an Integer)]
|[lower (an Integer)]]
||[NeitherAddendKnown ↑{[a Unit][WhenIdentified (LISP (TryStrategy))]}
|[self [a ColumnDescription with
strategy = (LISP ProcessNeitherKnown)]]]
||[OddNumber ↑{[a Unit]
[ToTestExistence (LISP (PROG((x (Item (this instance)))
(RETURN
(AND (NUMBERP X)
(EQ (IREMAINDER x 2) 1)))))]}
|[self (an Integer)]]
||[OneAddendKnown ↑{[a Unit][WhenIdentified (LISP (TryStrategy))]}
|[self {[a ColumnDescription with
strategy = (LISP ProcessOneKnown)]
|[knownDigit (an Integer)]
|[mysteryLetter (a Letter)]]
||[NoBlanks ↑{[a Unit]
[FurtherSpecified Column]
[WhenIdentified (LISP (TryStrategy))]}
|[self {[a ColumnDescription]
(a Column with
topLetter = (Not \Blank)
bottomLetter = (Not \Blank))
(a Summation with summands =
<(my carryIn)
(the value from (a Letter whichIs(my topLetter)))
(the value from (a Letter whichIs(my bottomLetter)))>)}]]
||[OneBlank ↑{[a Unit]
[FurtherSpecified Column]
[WhenIdentified (LISP (TryStrategy))]}
|[self {[a ColumnDescription with
strategy = (LISP ProcessOneBlank)
matchDesc = [my mDesc]]
{(Or \{(a Column with
topLetter = Blank
(a Sum with
summands = <(my carryIn)
(the value from (a Letter whichIs
(my bottomLetter)))>)}
\{(a Column with
bottomLetter = Blank
(a Sum with
summands = <(my carryIn)
(the value from (a Letter whichIs
(my topLetter)))>)} ↑[Label mDesc]}}]]
||[TwoBlanks ↑{[a Unit]
[FurtherSpecified Column]
[WhenIdentified (LISP (TryStrategy))]}
|[self {[a ColumnDescription with strategy = (LISP ProcessTwoBlanks)]
{(a Column with
topLetter = Blank
bottomLetter = Blank) ↑ [* "the matching description]}
(a Column with
sum = 1
carryIn = 1)
(a Summation with summands =
<(my carryIn)>)}]]
||[Problem ↑{[a Unit]
[WhenIdentified (LISP (SETQ currentProblem (this instance)))]
[WhenAllKnown <"topWord" "bottomWord" "sumWord">
(LISP (SetUpProblem))]}
|[topWord (a String)]
|[bottomWord (a String)]
|[sumWord (a String)]
|[columns (SetOf \(a Column))]
|[freeDigits {(SetOf \(an Integer))
(a DecreasingSet with
initialValue = [IntegerInterval 0 9])}]
|[lettersAppearing (SetOf \(a Letter))]
|[freeLetters {(SetOf \(a Letter))
(an EliminationSet with
initialValue = (my lettersAppearing)
filter = \(Not \(CanGetIt \(the value from
(a Letter whichIs (this element))))))}]]
|[SumEqualsAddend↑{[a Unit][FurtherSpecified Column]
[WhenDescribed (Apply (LISP ProcessSumEq) (my self)]
[WhenIdentified (LISP (TryStrategy))]}
|[self {[a ColumnDescription with
strategy = (LISP ProcessSumEq))]]
|[carryOut ↑ {[WhenKnown (Apply [my loneDesc] (my loneLetter)]]
***fix***[WhenKnown (Apply [my loneDesc] (my loneLetter)]]
|[loneLetter {(a Letter)
{(using (my carryOut)
0 ~ (a Letter with value = 0)
10 ~ (a Letter with value = 9)) ↑[Label loneDesc]}}]
|[doubledLetter (a Letter)]]
|[Summation↑[a Unit]
|[summands (SetOf \(an Integer))]
|[sum (an Integer)]]
|[Variable ↑[a Unit]
|[possibleValues]
|[newConstraint]]
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
(DEFINEQ
(CallIfNeeded
[LAMBDA (priorityLevel processName processArgs) (* Issues a call if one
is not already on the
agenda.)
(if (for call in (AgendaLevel priorityLevel)
never (AND (EQUAL call:lispFunction processName)
(EQUAL call:lispArguments processArgs)))
then (Call priorityLevel processName processArgs])
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
(CheckAppearances
[LAMBDA NIL
(* called when a value is filled in for a letter.
goes through all columns, looking at each letter to see if
it equals the one just assigned a value, and if so triggers processing.)
(Deplete \(the freeDigits from (a Problem whichIs @currentProblem))
(Item (this newDescriptor))
\(a ComplainIfNotThere))
(bind ((letter (Item (this instance))))
for column
in (ItemSequence (the columns from (a Problem whichIs @currentProblem)))
do (if (exists letterName
in ’(topLetter bottomLetter sumLetter)
when letter = (Item (the @letterName from (a Column whichIs @column))))
then (ProcessColumn column])
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
(CheckIfDone
[LAMBDA (oldUnknowns) (* scheduled at low
priority to try to finish
up. It will assign
dangling letters in
simplest cases.)
(PROG (unknowns unusedDigits)
(Update \(the freeLetters from (a Problem whichIs @currentProblem)))
(unknowns←(ItemSequence (the freeLetters from
(a Problem whichIs @currentProblem)))
(SELECTQ (LENGTH unknowns)
(0 (GiveAnswer) (RETURN))
(1 (unusedDigits ←
(ItemSequence (the freeDigits from
(a Problem whichIs @currentProblem))))
(if 1=(LENGTH unusedDigits)
then (Call 2 ’GiveAnswer)
(Describe \(the value from (a Letter whichIs @unknowns:1))
unusedDigits:1))
else (HELP "number of digits and letters doesnt match")))
(if (EQUAL oldUnknowns unknowns)
then (HELP "Not Making any progress")
else (Call 6 ’CheckIfDone <unknowns>])
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
(CheckPossibleValues
[LAMBDA () (* triggered in a WhenDescribed)
(PROG (variableDesc possibilities newDescriptor newPossibilities)
(if (variableDesc ← (Seek \(this oldDescription) \(a VariableDescription)))
then (possibilities ← (ItemSequence (the possibleValues from
(a Variable whichIs @variableDesc)))))
(if (NOT possibilities)
then (Signal ’CantFindPossibleValues)
elseif (NOT possibilities::1)
then (RETURN NIL))
(newDescriptor ← (Item(this newDescriptor)))
(newPossibilities ← (collect x in possibilities
when (Match newDescriptor x)))
(if (NULL newPossibilities)
then (Signal ’EliminatedAllPossibilities)
elseif (NOT (EQUAL newPossibilities possibilities))
then (ReDescribe \(the possibleValues from
(a Variable whichIs @variableDesc))
(MakeKrlSequence newPossibilities))
(if (NOT newPossibilities::1)
then (Describe \(the @(Item (this slotName)) from
(a @(Item (this template))
whichIs @(Item (this instance))))
newPossibilities:1)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
(ClassifyColumn
[LAMBDA NIL (* differential diagnoser
for pattern of addend and sum
letters)
***there are two issues here -- one involves how to put this in declarative structures as a "selection" mechanism. The other has to do with how to handle the meta-descriptors (a ValueDesc) which belong to the resulting descriptors added to the instance, not to the descriptor in the template. Note that this is avoided here because they are in an argument to MakeKRL.
(PROG ((column (Item (this instance))
(top (Item (that topLetter)
(bottom (Item (that bottomLetter))
(sum (Item (that sumLetter))
(blank (Item Blank)))
(Describe column \(a Summation with sum =
(# (the sum from (a Column whichIs @column))
↑ (a ValueDesc))
(Describe \(the sum from (a Column whichIs @column))
\(a Summation with
sum = (# (the sum from (a Column whichIs @column))
↑ (a ValueDesc))
addends =
(Seq (# (the value from (a Letter whichIs @sum))
↑ (a ValueDesc))
(# (the carryOut from (a Column whichIs @column))
↑ (a ValueDesc))))))
(if (AND top=blank bottom=blank)
then (Describe column
\(#(a TwoBlanks)
(a Column with sum = 1 carryIn = 1 carryOut = 0)))
elseif top=blank
then (Describe column
\(#(a OneBlank)
(a Summation with addends =
(Seq (# (the value from (a Letter whichIs @bottom))
↑ (a ValueDesc))
(# (the carryIn from (a Column whichIs @column))
↑ (a ValueDesc))))))
elseif bottom=blank
then (Describe column
\(# (a OneBlank)
(a Summation with addends =
(Seq (# (the value from (a Letter whichIs @top))
↑ (a ValueDesc))
(# (the carryIn from (a Column whichIs @column))
↑ (a ValueDesc))))))
with bottomDigit = BlankDigit))
else (Describe column
\(# (a NoBlanks)
(a Summation with addends =
(Seq (# (the value from (a Letter whichIs @top))
↑ (a ValueDesc))
(# (the value from (a Letter whichIs @bottom))
↑ (a ValueDesc))
(# (the carryIn from (a Column whichIs @column))
↑ (a ValueDesc)))))))
(if top=bottom
then (Describe column \(a TwinAddend))
(if top=sum
then (Describe column \(a SumEqualsAddend with loneLetter = (my topLetter)))
(if bottom=sum
then (Describe column \(a SumEqualsAddend with loneLetter = (my bottomLetter])
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
(DOP1
[LAMBDA (D)
(* the lambda binding is to fake out Clisp)
(Describe (NewUnit ’Problem1)
\
(a Problem with topWord "DONALD"
bottomWord "GERALD"
sumWord "ROBERT"))
(Describe \D \ (a Letter with value = 5])
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
(GetLetters
[LAMBDA (string pad)
(* used in setting up the problem, to get a sequence of
letter units corresponding to the words in the problem
statement. Returns list in right to left order.
The extra blanks are in case the sum is longer than one or
both of the addends)
(PROG (charList)
[charList←(for character in string
collect (OR (GU character)
(MakeCharacterUnit character]
(RETURN (REVERSE (if pad then charList
else <(GU ’Blank) ! charList>])
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
(GetParity
[LAMBDA (descr)
(PROG (number)
(RETURN
(if number ← (GetItem descr)
then (IREMAINDER number 2))
elseif (Match \(an OddDigit) descr)
then 1
elseif (Match \(an EvenDigit) descr)
then 0
else NIL])
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
(GiveAnswer
[LAMBDA () (* prints and stops with
agenda intact)
(for letter in (ItemSequence (the lettersAppearing from
(a Problem whichIs @currentProblem)))
do (printout NIL T letter:unitName " = "
(Item (the value from (a Letter whichIs @letter)))
(printout NIL T "Problem done" T "Listening"])
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
(MakeCharacterUnit
[LAMBDA (character) (* takes a character atom
and creates a Unit with
name equalling the
character)
(PROG (unit)
(unit←(NewUnit character))
(Describe unit \(a Letter with problem = @currentProblem)))
(RETURN unit])
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
(ProcessColumn
[LAMBDA (column)
(CallIfNeeded 2 ’ProcessSummation <\(the sum from (a Column whichIs @column))>)
(CallIfNeeded 2 ’ProcessSummation column)
(TryRepeatableStrategies column])
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
(ProcessOneBlank
[LAMBDA (column)
(PROG (loneLetter sumLetter loneValue sumValue) (* Figures out the
carryIn and fills in the
values of the two letters
if one is known.)
(loneLetter←(Item (the loneLetter from (a OneBlank whichIs @column))))
(Describe \(the value from (a Letter whichIs @loneLetter))
\(Not 0))
(sumLetter←(Item (the sumLetter from (a Column whichIs @column))))
(if loneLetter=sumLetter then (DescribeColumn column ’carryIn 0)
else (Describe @column \(a Column with carryIn = 1])
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
(ProcessSumEq
[LAMBDA (column)
(PROG (loneLetter loneValue carryIn carryOut)
(loneLetter ← (Item (the loneLetter from
(a SumEqualsAddend whichIs @column))))
(loneValue ← (Item (the value from (a Letter whichIs @loneLetter))))
(carryIn ← (Item (the carryIn from (a Column whichIs @column))))
(carryOut ← (Item (the carryOut from (a Column whichIs @column))))
(if (AND carryIn carryOut loneValue) then NIL
elseif (OR (EQ carryIn 1) (EQ carryOut 10) (EQ loneValue 9))
then (Describe column \(a Column with carryIn = 1 carryOut = 10))
(Describe loneLetter \(a Letter with value = 9))
elseif (OR (EQ carryIn 0) (EQ carryOut 0) (EQ loneValue 0))
then (Describe column \(a Column with carryIn = 0 carryOut = 0))
(Describe loneLetter \(a Letter with value = 0])
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
(ProcessSummation
[LAMBDA (summationDesc checkLimits)
(PROG ((knownSum 0) sumItem unknowns number)
(sumItem ← (Item (the sum from (a Summation whichIs @summationDesc))))
(for descr in (GetDescriptionSequence \(the summands from (a Summation
whichIs @summationDesc)))
do (if number ← (GetItem descr)
then (knownSum ← knownSum+number)
else (push unknowns (Seek descr \(a ValueDescr))))
(if (NOT unknowns)
then (if (NOT sumItem)
then (Describe (Seek \(the sum from (a Summation
whichIs @summationDesc)))
\(a ValueDescr))
knownSum)
elseif (NOT (sumItem = knownSum))
then (Complain))
elseif (AND sumItem (NOT unknowns:2)))
then (Describe unknowns:1 (sumItem - knownSum))
elseif checkLimits
then (ProcessForBounds summationDesc sum unknowns knownSum)
(if (AND sumItem (NOT unknowns:3))
then (ProcessLinear unknowns:1
unknowns:2
<’LAMBDA ’(x) <’DIFFERENCE
(sumItem - knownSum) ’x>>))
(ProcessLinear unknowns:2
unknowns:1
<’LAMBDA ’(x) <’DIFFERENCE
(sumItem - knownSum) ’x>>))
elseif (AND (NOT sumItem)(NOT unknowns:2))
then sumDescr ← (Seek \(the sum from
(a Summation whichIs @summationDesc)))
\(a ValueDescr))
(ProcessLinear unknowns:1
sumDescr
<’LAMBDA ’(x) <’PLUS knownSum ’x>>))
(ProcessLinear sumDescr
unknowns:1
<’LAMBDA ’(x) <’DIFFERENCE knownSum ’x>>))
else (CallIfNeeded 4 ’ProcessSummation <summationDesc T>])
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
(ProcessForBounds
[LAMBDA (summationDesc sumItem unknowns knownSum)
(PROG (minSum maxSum newMin newMax sumDesc limits)
(limits ← (for descr in unknowns
collect <descr
(GetMinimumValue descr)
(GetMaximumValue descr)>))
(if sumItem then minSum ← maxSum ← sumItem
else sumDesc ← (Seek \(the sum from
(a Summation whichIs @summationDesc)))
\(a ValueDescr))
(maxSum ← (GetMaximumValue sumDesc T))
(newMax ← (knownSum + (for x in limits sum x:3))
(if newMax LT maxSum
then maxSum ← newMax
(Describe sumDesc \(AtMost @newMax)))
(minSum ← (GetMinimumValue sumDesc T))
(newMin ← (knownSum + (for x in limits sum x:2))
(if newMin GT minSum
then minSum ← newMin
(Describe sumDesc \(AtLeast @newMin))))
(for triple in limits
do (newMin ← (minSum - (knownSum + (for x in limits
when (NOT (x:1=triple:1))
sum x:3))))
(if newMin LT triple:2
then triple:2 ← newMin
(Describe triple:1 \(AtLeast @newMin)))
(newMax ← (maxSum - (knownSum + (for x in limits
when (NOT (x:1=triple:1))
sum x:2))))
(if newMax GT triple:3
then triple:3 ← newMax
(Describe triple:1 \(AtMost @newMax)))])
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
(ProcessLinear
[LAMBDA (first second formula)
(PROG (firstPossibilities secondPossibilities)
(firstPossibilities ← (GetPossibilities first))
(secondPossibilities ← (GetPossibilities second))
newPossibilities ← (collect x in firstPossibilities
when (FMEMB (Apply formula x) secondPossibilities))
(if (NOT (EQUAL firstPossibilities newPossibilities))
then (Describe first \(In @(MakeKrlSequence newPossibilities))))])
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
(ProcessSummationForParity
[LAMBDA (sumDescr)
(PROG (sumParity (knownSum 0) unknowns parity)
(sumParity ← (GetParity (the sum from (a Summation whichIs @sumDescr))))
(for descr in (GetDescriptionSequence \(the summands from
(a Summation whichIs @sumDescr)))
do (if parity ← (GetParity descr)
then (knownSum ← knownSum+parity)
else (push unknowns (Seek descr \(a ValueDescr))))
(if (NOT unknowns)
then (if (NOT sumParity)
then (Describe (Seek \(the sum from
(a Summation whichIs @sumDescr)))
\(a ValueDescr))
(SELECTQ (IREMAINDER knownSum 2)
(0 \(an EvenNumber))
(1 \(an OddNumber))
(HELP)))
elseif (NOT (sumParity = (IREMAINDER knownSum 2)))
then (Complain))
elseif (AND sumParity (NOT unknowns:2))
then (Describe unknowns:1 (SELECTQ sumParity
(0 \(an EvenNumber))
(1 \(an OddNumber))
(HELP))])
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
(ProcessTwin
[LAMBDA (column) (* column has same digit
on top and bottom.)
(PROG (letter variable item)
(letter ← (Item (the topLetter from (a Column whichIs @column))))
(if (Item (the value from (a Letter whichIs @letter))) then (RETURN NIL))
(variable ← (NewUnit (GENSYM ’V)))
(Describe variable \(a Variable)))
(CurrentDescribe variable
\(a Variable with
possibileValues = @(for x in (GetPossibilities \(the value from
(a Letter whichIs @letter)))
collect (TIMES x 2)))
(Describe \(the value of (a Variable whichIs @variable)) \(an EvenNumber))
(thisSummation ← \(a Summation with
sum = (the sum from (a Column whichIs @column))
summands =
(Seq (# (the value from (a Variable whichIs @variable))
↑ (a ValueDesc))
(# (the carryIn from (a Column whichIs @column))
↑ (a ValueDesc)))) )
(ProcessSummation thisSummation T)
(ProcessForParity thisSummation)
(RescheduleMe 3)
(if item ← (Item (the value from (a Variable whichIs @variable)))
then (Describe \(the value from (a Letter whichIs @letter)) item)
else (ProcessLinear \(the value from (a Letter whichIs @letter))
\(the value from (a Variable whichIs @variable)
’(LAMBDA (x) (TIMES 2 x])
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
(ReportImpossibleProblem
[LAMBDA NIL (* Called whenever
conflicting assignments
are made in the real
world as opposed to in
hypothetical worlds.)
(printout NIL (PPU currentProblem)
T "This problem is not well-formed." T)
(HELP])
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
(SetUpProblem
[LAMBDA NIL
(* sets up all the necessary data structures.
Called by describing something as a problem.
GetLetters is a special function (see below) for producing
lists of units)
(PROG (columns letters)
[for total in (GetLetters (Item (the sumWord from
(a Problem whichIs @currentProblem))))
as top in (GetLetters (Item (the topWord from
(a Problem whichIs @currentProblem))) T)
as bottom in (GetLetters (Item (the bottomWord from
(a Problem whichIs @currentProblem))) T)
do (push columns (NewUnit (GENSYM "C")))
(Describe columns:1 \(a Column with topLetter = @top
bottomLetter = @bottom
sumLetter =@total))
(if columns::1
then (Describe columns:1 \(a Column with
rightNeighbor = @columns:2)
(Describe columns:2 \(a Column with
leftNeighbor = @columns:1)
else (Describe columns:1 \(a Column with carryIn = 0))
(if ~(MEMB top letters)
then (push letters top))
(if ~(MEMB bottom letters)
then (push letters bottom))
(if ~(MEMB total letters)
then (push letters total))
finally (Describe columns:1 \(a Column with carryOut = 0)
(Describe currentProblem
\(a Problem with
lettersAppearing = @(MakeKrlSequence letters)
columns =@(MakeKrlSequence columns]
(Call 6 ’CheckIfDone])
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
(TestCases
[LAMBDA (unit descriptionList)
(* for each description in descriptionList, a hypothetical
world is created, and the description is added to unit as a
contingency. This is done with a limit on the priority level
of calls which propagate from it, so it goes on for a short
time finding implications. It is also done with a signal
catcher which converts all contradictions into a top level
rejection of the hypothesis. If all but the last one are
rejected, it is returned as the value.
If more than one is asserted without contradiction,
TestCases returns NIL.)
(bind (world possibilities)
for desc in descriptionList
do (if (AND (NOT possibilities)(EQ desc descriptionList:-1))
then (RETURN desc))
(world←(NewUnit (GENSYM "H")))
(Describe world \(a Hypothesis with base = @unit assumption = @desc)))
(SetWorld world (Call 2 ’Describe <unit desc \(Contingent @world)>))
(RescheduleMe 3)
(* this causes the Current call to be suspended and its
continuation put at Level 3 on the agenda, so it will not be
called until all of the level 1 and 2 propagation is
completed)
(if (NOT (EQUAL "Impossible"
(Item (the status from (a Hypothesis whichIs @world)))))
then possibilities← <desc ! possibilities>)
(if possibilities:2 then (RETURN NIL)))
finally (RETURN possibilities:1])
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
(TestMagnitudeMapping
[LAMBDA () (* Used by matcher to
determine whether a view
of something as a
magnitude relation is
correct.)
(PROG (greaterOne lesserOne)
(RETURN (AND (greaterOne←(Item (this higher))
(lesserOne←(Item (this lower))
(if greaterOne LT lesserOne
then ’EXISTS
else ’DOESNOTEXIST])
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
(TryCasesForLetters
[LAMBDA (number)
(* used when there are only two or three alternatives for a letter.
sets up alternative worlds in which the letters have the
given values and looks for contradictions.)
(PROG (letter cases goodGuy)
(if letter ← (exists letter
in (ItemSequence (the freeLetters from
(a Problem whichIs @currentProblem)))
when (AND (cases ← (GetPossibilities \(the value from
(a Letter whichIs @letter))))
(NOT (LESSP number (LENGTH cases)))
(goodGuy ←(TestCases letter
(for case in cases
collect \(a Letter with value = @case)))
then (Describe letter goodGuy])
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
(TryStrategy
[LAMBDA NIL
(PROG ((column (Item (this instance))
(columnType (Item (this template))
(matchDescription (Item (the matchDesc from
(a ColumnDescription whichIs (this template)))))
(strategy (Item (the strategy from
(a ColumnDescription whichIs (this template))))))
(if matchDescription
then (Match matchDescription column \(an AddBindings)))
(if strategy
then (Call 4 strategy <column>)])
NewUnit takes only one arg which is the name
Need MakeKrlSequence -- takes LISP list of individuals, produces sequence description
ItSequence is like It, but returns list of individuals
AddBindings is a description of a match
Elimination set -- innitial,filter
EnumerateAndTest \\ a seek which expects an IN in its description -- returns a sequence
use variable to process possible values for sum?/?
(ProcessBothKnown
[LAMBDA (column)
(* if both addends are known but the neither the sum nor the
carryin is known. First checks whether the need for this
still exists since it is scheduled very low priority.
Then makes a few vagues assertions about the sumletter and
hopes that TryElimination has some luck.)
(PROG (column carryIn topDigit bottomDigit carryOut sumDigit minimumSum sum)
(topDigit←(Item (the topDigit from (a Column whichIs @column)))))
(bottomDigit←(Item (the bottomDigit from (a Column whichIs @column)))))
(minimumSum←(KPlus topDigit bottomDigit)
(if carryIn
then (DescribeColumn column ’sum (KPlus minimumSum carryIn))
(* This should fire off
ProcessColumn to spread
the goodies)
elseif (AND carryOut (KEqual minimumSum 9))
then (if carryOut=0
then (DescribeColumn column ’sum 9)
else (DescribeColumn column ’sum 10))
else
(Describe
(Item (the sumLetter from (a Column whichIs @column)))
\(a Letter with value =
(Or \@(GetDigit (KTensDigit minimumSum))
\@(GetDigit (KTensDigit (KPlus minimumSum 1)])
when described, if letter not known, then do this processing
...this is stuff from before which I haven’t worked in yet...
(DEFINEV
Hypotheticals (NewSignalPath
<’ACTIONTABLE
’SIGNALS <’AddingConflictingIndividual
<’MarkImpossible world>>
’(AddingIndividual OK)
’(AddingDescriptor NOTOK)
’(AddingNewPerspective NOTOK)
’(AddingNewNormalPerspective NOTOK)
’(AddingNewPerspectiveForFeatures NOTOK)
’[AddingCallToAgenda (COND
((GREATERP (fetch priority
of call)
2)
(QUOTE NOTOK))
(T (QUOTE OK]>)))
(CryptSignalTable (ACTIONTABLE SIGNALS (GoFillNotFound NOTOK)
(TrapAlreadyExists OK)
(TriggerAlreadyExists OK)
(CantRemoveTrap OK)
(CantRemoveTrigger OK)
(AddingConflictingIndividual
(ReportImpossibleProblem))
(Contradiction (ReportImpossibleProblem))
(TryingElimination OK)
(FollowingSpecificationIntoPrototype OK)
(FollowingSpecificationDeeper OK)))
(QUICKFIND (ACTIONTABLE SIGNALS (SearchingForIndividual NOTOK)
(CannotFindIndividual OK)))
(ReplaceOldUnitsSignalTable (ACTIONTABLE SIGNALS (UnitNameConflict OK)))
(InhibitCryptEliminationTable (ACTIONTABLE SIGNALS (TryingElimination NOTOK)))
)
(SETPROPLIST (QUOTE sum))
(SETPROPLIST (QUOTE SUM))
(PushSignalPath CryptSignalTable T)
(DECLARE: DONTEVAL@LOAD DOEVAL@COMPILE DONTCOPY COMPILERVARS
(ADDTOVAR NLAMA )
(ADDTOVAR NLAML MarkImpossible DoWhenKnown Compute)
)