Im Folgenden sind
zwei rekursive J Lsung fr das SEND+MORE=MONEY Probelm aus PC NEWS 49,
Sept. 1996, Seite 55, Karl Stipek: "Rekursion in Pascal, C und BASIC"
zu sehen.

von Joachim Hoffmann, JoHo@magnet.at


Ein wesentlicher Unterschied zum Original in PC News 49 ist,
dass zum Testen einer Lsung die Buchstaben im Text 'MONEY=SEND+MORE'
durch Text-Ziffern ersetz werden, und dann der Text mit den Ziffern
ausgefhrt wird (Execute '56328=1234+5672').
Das Programm kann auch andere Gleichungen zu lsen.

JoHo

NB. === J Session Log =====================================================

   
   (1 TO 4) SolveRecP 'CC=BA+AB'
+--------+-+-+
|CC=BA+AB|4|1|
|33=21+12| | |
|44=31+13| | |
|33=12+21| | |
|44=13+31| | |
+--------+-+-+
   
   
   GeneratePermusets 'M=1 / B=3 TO 4 / A=9 8 7 6'   
+-------+---+-+
|9 8 7 6|3 4|1|
+-------+---+-+
   

   result=: SolveSMM ''    NB. solve SEND+MORE=MONEY problem
+---------------+-+-+
|MONEY=SEND+MORE|1|1|
|10652=9567+1085| | |
+---------------+-+-+





NB. ==== Start of J Script: RecMoney.JS =================================== 
NB. Version 3
NB. Date: 12.10.96

NB. ...... Here are general auxiliary verbs ..................................
Show =: (1!:2)&2                       NB. show on screen  
Fmt  =: (0 1 1)&":                     NB. format without linedrawing chars
TO   =: Left + Integers@Increment@-~   NB. 2 TO 6 => 2 3 4 5 6
BX   =: Copy Integers@Count            NB. indices of 1's in boolean list
Quote  =: (''''&,)@(,&'''')            NB. append left and right a singel quotes
Boxopen=: Box^:(Level = 0:)            NB. box only open arguments
Empty  =: (0 0$0)"_                    NB. returns empty matrix => no effect

NB. ..... auxiliary verbs concerned with this probelm ........................
FindChars=: E."0 1                     NB. find left characters in right text
Check    =: *./@:Execute@:Behead       NB. drop first line and execute each line      
Textify     =: Less&' '@":             NB. list of digits=>text and delete the blanks
FormatResult=:(Right; Decrement@First@Shape; Check)

NB. find all indices of x. in y.
NB. result is a boxed list, each box contains all occurences 
NB. of each atom in x. in y., a box may also be empty
InxIn=: BX each@(Box rowwise)@Transpose@FindChars     

NB. how a boxed list is partitoned: (2 3 2; 444 ;9 8 33 1) => 0 0 0 1 2 2 2 2
Partitions=: Raze@:(Count each)@:Right Copy  Integers@Count@Left

NB. permusets (boxed list) of _sorted_ variables, e.g.: 
NB. Fmt GeneratePermusets 'M=1 /B=3 TO 4/A=3 4 6'   
NB.    A    B  M   
NB. +-----+---+-+
NB. |3 4 6|3 4|1|
NB. +-----+---+-+
GeneratePermusets=:3 : 0
res=. '=' cutopen each '/' cutopen y.
res=. Ravel (Open@Behead each res) /: (Less&' '@Open@First each res)
res=. Ravel@:Execute each  res
)

NB. ...............................................................................
NB. define global variables for PermuteRecJ and PermuteRecPascal   
NB. the right argument y. is 'MONEY=SEND+MORE'
NB. the optional left argument is a boxed list with allowed values

DefineGlobals=: 3 : 0
(<0 TO 9) DefineGlobals y.     NB. if monadic=> call recursively dyadic case
:
txt=: y.                                NB. right argument, e.g.:'MONEY=SEND+MORE'
variables   =: Sort (Nub txt) Less '=+' NB. extract variables and sort them
permutations=: (Count variables)Copy 0  NB. init global permutation variable
used       =: 10 Copy 0             NB. boolean list indicates, if a digit is used
result     =: Itemize txt           NB. initialize result as matrix with one row
max        =: Count variables       NB. max is tally of variables 
permusets  =: max Shape x.          NB. allowed values in boxed list<->sorted vars
GetPermuSet=: Open@(From&permusets) NB. get values for variable i

NB. boxed list with multiple occurrences of each variable in txt,
NB. e.g.: E has 3 occurrences in txt
indices=: variables InxIn txt    
blowup =: Partitions indices              NB. how the boxed list is partitioned
indices=: Raze indices                    NB. indices is now a simple list
Replace=: indices AMEND&txt@(blowup&From) NB. replace vars in txt by text-digits
Empty''      NB. return empty result !!! No verb definition in last line !!!
)




NB. ......................................................................
NB. Pascal-style loop-recursion of send+more=money problem 
NB. e.g. PermuteRecPascal 0  start is 0 because of 0-origin

PermuteRecPascal=: 3 : 0                 NB. x. is i.th variable
i=. y.
vals=. GetPermuSet i                     NB. get all allowed digits for i
 whilst. 0~: Count vals=.Drop vals do.   NB. loop over all digits for i
    val=.First vals                      NB. current value for variable
    if. Not val{used do.                 NB. exit if digit is already used
    permutations=: val i}permutations    NB. set i-th position to val
    used        =: 1 val}used            NB. mark this digit as used
      if. i < max-1 do.                  NB. if not last variable, 0-origin!
      PermuteRecPascal i+1               NB. recursive call 
      else.                              NB. else
                                         NB. replace variables in txt by digits 
      sol=. Replace Textify permutations NB.       => '10652=9567+1085'      
          if. Execute sol do.            NB. test if permutation is solution
          NB. Show sol                   NB. display solution on screen
          result=:result,sol             NB. global result   
          end.                         
      end.                               NB. end if 
    used=: 0 val}used                    NB. now we have all permuted=>free digit
    end.                                 NB. end "if not used"
 end.                                    NB. end whilst
)

NB. ....................................................................
NB. solve equatation using pascal style recursion
NB. e.g.: (0 TO 9) SolveRecP  'CC=BA+AB'
SolveRecP =: 4 : 0  
(Boxopen x.) DefineGlobals y.
PermuteRecPascal 0              
FormatResult result
)

NB. ................................................................
NB. special Verb to Solve SEND+MORE=MONEY problem
SolveSMM=: 3 : 0     
psets=. 'S=1 TO 9/ M=1/',}:,'ENDORY',"0 1 '=0 TO 9/'
psets=. GeneratePermusets psets
psets SolveRecP 'MONEY=SEND+MORE'
)




NB. ....................................................................
NB. function calls

NB. Fmt (1 TO 4) SolveRecP 'CC=BA+AB'

NB. Fmt GeneratePermusets 'M=1 / B=3 TO 4 / A=9 8 7 6'   

NB. result=: SolveSMM ''     NB. solve SEND+MORE=MONEY problem




NB. ....................................................................
NB. APPENDIX: 
NB. verbouse names for primitives are defined for redability 
Right=: ]              NB. identity verb, returns right argument
Left =: [              NB. identity verb, returns left argument  
AMEND=: }              NB. Adverb for indexed replacing
From =: {              NB. get left index From right   
First =: Take=: {.     NB. take n- (or only first) item
Behead=: Drop=: }.     NB. drop n- (or only first) item
Box  =: <              NB. box an array, encapsulation
Open =: >              NB. open a box
each     =: &. >       NB. each adverb: apply a verb to each box
Level    =: L.         NB. returns the depth of boxing 
Nub  =: ~.             NB. unique
Not  =: Less=: -.      NB. logical NOT / Without 
Count=: Copy=: #       NB. count items, copy items 
Shape    =: $          NB. returns shape of an array
Ravel    =: ,          NB. e.g.: vec <= ,mat 
Itemize  =: ,:         NB. make one line mat of vec
Raze     =: ;          NB. flatten boxed array      
Execute  =: ".         NB. execute a text,e.g.:'56328=1234+5672'
Integers =: i.         NB. generate integerlist
Increment=: >:         NB. Right + 1 
Decrement=: <:         NB. Right - 1
Transpose=: |:         NB. interchange rows with columns
Sort     =: /:~        NB. sorts everything
rowwise  =: "1         NB. adverb: do something row by row

NB. ============= End of script file RecMoney.js ===================




1
RecMoney.doc, Montag, 14. Oktober 1996


