[Indigo]<KRL>test>testcrypt.bravo!1

# Column↑1
1: TriggerOnAny
({topLetter, bottomLetter, sumLetter}, WhenFilled, ’(ColumnLetterFilled))
TriggerOnAny
({sum, carryIn, carryOut}, WhenFilled, ’(ProcessColumn INSTANCE))
self:
leftNeighbor: A Column with rightNeighbor = My self
rightNeighbor: A Column with leftNeighbor = My self

topLetter: A Letter with appearances = {My self, ...}
bottomLetter: A Letter with appearances = {My self, ...}
sumLetter: A Letter with appearances = {My self, ...}

sum:↑2 An Integer2: Trigger (WhenFilled, ’(ColumnSumFilled))
carryIn:↑3 An Integer3: Trigger (WhenFilled, ’(ColumnCarryFilled NIL))
MemberOf({0,1})
carryOut:↑4 An Integer4: Trigger (WhenFilled, ’(ColumnCarryFilled T))
MemberOf({0,10})

# Letter
self:↑11: Trigger(WhenIdentified,
’(DoAlign INSTANCE
\A Letter with possibleValues = {0,1,2,3,4,5,6,7,89}/
(MatchTable SimpleDescribe)))
value:↑2 An Integer
2: Trigger(WhenDescribed,
’(OR (IsPostDesccriptor NEWDESCRIPTOR)
(DoAlign INSTANCE
\A Letter with
possibleValues =
@Do (’(SubstituteElement
NIL
\Not(!Dr NEWDESCRIPTOR)/
ALL))/)))
Trigger(WhenFilled, ’(LetterValueFilled))
possibleValues:↑3 SetOf(An Integer)
3: Trigger(WhenEnumerationChanged, ’(PossibleValuesChanged))
appearances: SetOf(A Column)

# OneBlank↑1
1: Trigger (ToMatch,
(Align INSTANCE
\Or (A Column with
topLetter = @Do(’(Bind x Primary))
@Do(’(Describe \A Letter with
value = Not(0)/))
bottomLetter = Blank,
A Column with
topLetter = Blank
bottomLetter =@Do(’(Bind x Primary))
@Do(’(Describe \A Letter with
value = Not(0)/)))
@Do(’(Describe
\A OneBlank with
letter = !Coref (ValueOf x)
A Column with
carryOut = 0
carryIn = !Post (if (EQH (SeekMy Primary sumLetter)
(ValueOf x))
then 0 else 1)/))/)
self: A Column
letter: A Letter

# Problem↑1
1: TriggerOnAny ({topWord, bottomWord, sumWord},
’(SetUpProblem
(Align INSTANCE
\A Column with
topWord = @Do (’(Bind top Pointer))
bottomWord = @Do (’(Bind bottom Pointer))
sumWord = @Do (’(Bind sum Pointer))/
(MatchTable SeekOneBindingSet StructuralMatch))))
topWord: A String
bottomWord: A String
sumWord: A String
columns: SetOf(A Column)
lettersUsed: SetOf(A Letter)

# SumEqualsAddend↑1
1: Trigger (ToMatch,
(Align INSTANCE
\Or (A Column with
topLetter = @Do(’(Bind x Primary))
bottomLetter = @Do(’(Bind other Primary))
sumLetter = @Do(’(Bind x Primary)),
A Column with
topLetter = @Do(’(Bind other Primary))
bottomLetter = @Do(’(Bind x Primary))
sumLetter =@Do(’(Bind x Primary)))
@Do(’(Describe
\A SumEqualsAddend with
loneLetter = !Coref (ValueOf ’other)/))
@Do(’(MetaDescribe
\Trap(WhenDescribed, ’(TrySEAStrategy)/)/))
self: Or(A Column with
topLetter = My loneLetter
bottomLetter = The sumLetter from My self,
A Column with
topLetter = The sumLetter from My self
bottomLetter = My loneLetter)
loneLetter: A Letter↑2
2: Trigger (WhenFilled,
’(Align FILLER \A Letter with value = MemberOf{0,9}/))

# TwinAddend↑1
1: Trigger (ToMatch,
(Align INSTANCE
\A Column with
topLetter = @Do(’(Bind x Primary))
bottomLetter = @Do(’(Bind x Primary))
@Do(’(Describe
\A TwinAddend with
letter = !Coref (ValueOf x)/))
@Do(’(MetaDescribe
\Trap(WhenDescribed, ’(TryTwinStrategy)/)/))
self: A Column with
topLetter = My letter
bottomLetter = My letter
letter: A Letter
doubleValue: An Integer

[ColumnCarryFilled ((carryOut BOOL (* tells whether this is carry out as opposed to in))
(RETURNS Irrelevant))
(DPROG((neighbor (if carryOut
then (SeekMy Primary leftNeighbor)
else (SeekMy Primary rightNeighbor))
(ONEOF SlotAnchor NIL)))
(if (NOT neighbor)
then NIL
elseif carryOut
then (Align neighbor
\A Column with carryIn = !Pointer (IQUOTIENT FILLER 10)/
(MatchTable DescribeMT))
else (Align neighbor
\A Column with carryOut = !Pointer (ITIMES 10 FILLER)/
(MatchTable DescribeMT))]

[ColumnLetterFilled ((RETURNS Irrelevant))
(Align CURRENTPROBLEM
\A Problem with lettersUsed = @Do (’(AddElement \!Coref FILLER/))/)
(Align FILLER
\A Letter with appearances = @Do(’(AddElement \!Coref INSTANCE/))/))
(OR (NOT (Align INSTANCE
\A Column with
topLetter = @Do (’(Bind NIL Primary))
bottomLetter = @Do (’(Bind NIL Primary))
sumLetter = @Do (’(Bind NIL Primary))/)
(Align INSTANCE \A TwoBlanks/ (MatchTable DoTriggers))
(Align INSTANCE \A OneBlank/ (MatchTable DoTriggers))
(Align INSTANCE \A TwinAddend/ (MatchTable DoTriggers))
(Align INSTANCE \A SumEqualsAddend/ (MatchTable DoTriggers)))]

[MatchMagnitude ((higherPat BOOL)(RETURNS Irrelevant))
(DPROG((datumValue (Align DATUM
\@Do(’(Bind x Pointer))/
(MatchTable SimpleSeek))
(ONEOF FIXP NIL)))
(if datumValue
then (RETURN
(DPROG
((lower (if higherPat
then (Align PATTERNDESCRIPTOR
\A MagnitudeOrder with
lower = @Do(’(Bind x Pointer))/
(MatchTable SimpleSeek))
else datumValue)
(ONEOF FIXP NIL))
(higher (if higherPath then datumValue
else (Align PATTERNDESCRIPTOR
\A MagnitudeOrder with
higher = @Do(’(Bind x Pointer))/
(MatchTable SimpleSeek)))
(ONEOF FIXP NIL)))
(RETURN (if (NOT (AND higher lower))
then ’SKIP
elseif (GREATERP lower higher)
then ’FAIL
else ’ALLOK]

[PossibleValuesChanged ((RETURNS Irrelevant))
(SELECTQ (Cardinality ENUMERATION)
(0 (NoPossibleValue))
(1 (DPROG((value
(Align ENUMERATION
\{@Do(’(Bind x Pointer))}/
(MatchTable SimpleSeek))
FIXP))
(DoAlign INSTANCE
\A Letter with value = !Pointer value/
(MatchTable SimpleDescribe))))
NIL))]

[Test1 ((RETURNS Irrelevant))
(DPROGN ((CURRENTPROBLEM SlotHandle (BOUNDIN global environment)))

(* evaluating the nexus for the self slot should create the unit)
(CURRENTPROBLEM ← (Align \!Name (GENSYM ’Problem)/
\@Do (’(Bind x Primary))/))
(Align CURRENTPROBLEM
\A Problem with
topWord = "DONALD"
bottomWord = "GERALD"
sumWord = "ROBERT"/
(MatchTable SimpleDescribe))
(Align \$D:self \A Letter with value = 5/ (MatchTable SimpleDescribe]

[GetLetters ((string STRINGP) (pad BOOL)(RETURNS (LISTP OF SlotAnchor)))

(* 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)

(DPROG ((charList (for character in (UNPACK string)
collect (GetSlot character ’self))
(LISTP OF SlotAnchor)))
(RETURN (REVERSE (if pad then charList
else <(GetSlot ’Blank ’self) ! charList>]

[LetterValueFilled ((RETURNS Irrelevant))
(DPROG()
(if (Align CURRENTPROBLEM
\A Problem with
lettersAppearing =
SetOf(A Letter with value = @Do(’(Bind NIL Pointer)))/)
then (ProblemDone)(RETURN))
(DoAlign INSTANCE
\A Letter with
appearances = {..., @Do(’(LispApply ’ProcessColumn ME))}/
(MatchTable DoMultiples SimpleStructuralMatch))
(DoAlign CURRENTPROBLEM
\A Problem with
lettersAppearing =
{...,
Or(!Primary INSTANCE,
A Letter with
possibleValues =
@Do(’(SubstituteElement NIL \!Pointer FILLER/)))}/
(MatchTable DoMultiples SimpleStructuralMatch))
(DoAlign INSTANCE
\A Letter with
possibleValues = @Do(’(Substitute \{}/))/
(MatchTable SimpleStructuralMatch)))

(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 (componentDescs sumDesc)
(PROG ((sumItem ($ \SeekPointer(!D sumDesc))
(knownSum 0) unknowns number)

(for descr in componentDescs
do (if number ← ($ \SeekPointer(!D descr))
then (knownSum ← knownSum+number)
else (push unknowns descr))

(if (NOT unknowns)
then (if (NOT sumItem)
then ($ InvertDesc(!H sumDesc, !R knownSum))
elseif (NOT (sumItem = knownSum))
then ($ \Event(An Impossible
A ColumnSumContradiction))
elseif (AND sumItem (NOT unknowns:2)))
then ($ InvertDesc(!H (unknowns:1), !R (sumItem - knownSum))
elseif ($ \CheckResources(...???...))
then (ProcessForBounds sumDesc sumItem unknowns knownSum)
(ProcessForLinear sumDesc sumItem unknowns knownSum)]

(ProcessForLinear
[LAMBDA (sumDesc sumItem 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 (ProcessLinear unknowns:1 sumDescr
<’LAMBDA ’(x) <’PLUS knownSum ’x>>))
(ProcessLinear sumDescr unknowns:1
<’LAMBDA ’(x) <’DIFFERENCE knownSum ’x>>))])

(ProcessForBounds
[LAMBDA (sumDesc sumItem unknowns knownSum)
(PROG (minSum maxSum newMin newMax mins maxes minsTotal maxesTotal)

(minsTotal ← (APPLY (FUNCTION PLUS)
(mins ← (for descr in unknowns
collect (GetMinimumValue descr)))))
(maxesTotal ← (APPLY (FUNCTION PLUS)
(maxes ← (for descr in unknowns
collect (GetMaximumValue descr)))))

(if sumItem then minSum ← maxSum ← sumItem
else (maxSum ← (GetMaximumValue sumDesc T))
(newMax ← (knownSum + maxesTotal)
(if newMax LT maxSum
then maxSum ← newMax
($ \InvertDesc(!H sumDesc, AtMost !R newMax)))

(minSum ← (GetMinimumValue sumDesc T))
(newMin ← (knownSum + minsTotal)
(if newMin GT minSum
then minSum ← newMin
($ \InvertDesc(!H sumDesc, AtLeast !R newMin))))

(for descr in unknowns
as myMax in maxes
as myMin in mins
do (newMin ← (minSum - (knownSum + (maxTotal - myMax))))
(if newMin LT myMin
then minTotal ← minTotal + newMin - myMin
($ \InvertDesc(!H descr, AtLeast !R newMin))))

(newMax ← (maxSum - (knownSum + (minTotal - myMin))))
(if newMax GT myMax
then maxTotal ← maxTotal + newMax - myMax
($ \InvertDesc(!H descr, AtMost !R 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 (componentDescs sumDesc)
(PROG ((sumParity (GetParity sumDesc))
(knownParity 0) unknowns parity)

(for descr in componentDescs
do (if parity ← (GetParity descr)
then knownParity ← (IREMAINDER(parity+knownParity 2))
else (push unknowns descr))

(if (NOT unknowns)
then (if (NOT sumParity)
then ($ \InvertDesc(!H sumDesc, !D (ParityDescriptor knownParity)))
elseif (NOT (sumParity = knownParity))
then ($ \Event(An Impossible; A ParityContradiction))
elseif (AND sumParity (NOT unknowns:2)))
then ($ InvertDesc(!H (unknowns:1),
!D (ParityDescriptor (sumParity - knownParity)]

[SetUpProblem ((bindings (LST OF Binding)))
(* if bindings are NIL, not all three words have been filled in)
(DPROG((columns NIL (LISTP OF SlotAnchor)))
(if (OR (NOT bindings)
(Align CURRENTPROBLEM
\A Problem with columns = {...}/
(MatchTable StructuralMatch))
then (* problem is not ready or already set up) (RETURN))
(for total in (GetLetters (ValueOf ’sum bindings))
as top in (GetLetters (ValueOf ’top bindings) T)
as bottom in (GetLetters (ValueOf ’bottom bindings) T)
do (PUSH columns (SlotFor (GENSYM "C") ’self))
(Align CURRENTPROBLEM
\A Problem with
columns = @Do (’(AddElement \!Coref columns:1/))/)
(Align columns:1
\(a Column with
topLetter = !Coref top
bottomLetter = !Coref bottom
sumLetter =!Coref total/
(MatchTable DescribeMT))
(if columns::1
then (Align columns:1
\A Column with rightNeighbor = !Coref columns:2/
(MatchTable DescribeMT))
(Align columns:2
\A Column with leftNeighbor = !Coref columns:1/
(MatchTable DescribeMT))
else (Align columns:1 \A Column with carryIn = 0/
(MatchTable DescribeMT)))
finally (Align columns:1 \A Column with carryOut = 0/
(MatchTable DescribeMT))]

(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])

(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>)])

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

(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)
)