10 'simulation of the game KRYPTO 20 'Roughly: given 5 numbers (thru 25), combine with arithmetic operations 30 'to make them equal a given 6th integer. For rules, discussion, etc.: 40 'http://www.math.niu.edu/~rusin, currently in papers/uses-math/games 50 'Program written in BASIC variant called UBASIC (allows numbers of 60 'arbitrary word length). Get from http://www.simtel.net/pub/simtelnet 70 'Written by Dave Rusin, rusin@math.niu.edu. Last modified 1995/9/21 80 ' 90 randomize 100 dim A%(52):' table of all card values 110 dim B%(5):' values of the 5 cards to play 120 dim C%(6):' temporary array used in dealing, permuting 130 dim D%(5):' shuffling of the cards in the hand 140 dim E%(4):' list of the arithmetic operations to be used 150 dim F%(9):' order of operations/inputs in an RPN stack 160 dim Q%(14,9):' stores all possible sequences for F% 170 dim U%(503,9):' pared-down list of 503 formulas 180 ' (558 if you use neither LABEL1 nor LABEL2) 190 dim R$(5):' character string of RPN stack 200 dim Ra%(5):' presence of difference as factor in RPN stack 210 dim Rb%(5):' size of 2d argument in RPN stack 220 dim G(5):' numerical values of RPN stack 230 ' 240 print "Building table of formulae" 250 gosub 620:' set up the card values 260 gosub 710:' create table of valid RPN lists 270 gosub 950:' create table of valid 5-variable formulae 280 ' 290 print "Several modes of play are available." 300 print "0. Have the computer entertain itself for awhile." 310 print "1. Race against the computer (random KRYPTO cookie server)." 320 print "2. Ask computer's help for a tough KRYPTO problem." 330 input "Your choice";Mode 340 Printing=0 350 if Printing=1 then open "myfile." for output as #1 360 'Note: it is possible to switch b% and d% to real and allow real input 370 'Be sure to turn off integrality checking in that case!(Also:print"xi" 380 ' 390 gosub 2550:' deal the cards to create a random game 400 if Mode>=1 then gosub 2740:' display the game and allow for changes 410 if Mode=0 then gosub 2100:'just display the game 420 ' 430 Solved=0 440 for Uu=1 to 120 450 if Solved=1 then cancel for:goto 530 460 gosub 2170 470 for C=1 to Countem 480 if Solved=1 then cancel for:goto 510 490 gosub 2890:' try one permutation on one formula 500 next C 510 next Uu 520 if Solved=0 then print:print "No solution!":gosub 2100 530 if Mode=2 then 580 540 if Mode=1 then input "Another (1=Yes)";Ye:if Ye=1 then 390 else 580 550 if and{Mode=0,Solved=1} then 390:' let's do another! 560 print "Played";Rounds;"rounds successfully" 570 if Printing=1 then close #1 580 end 590 ' 600 '---------------SUBROUTINES FOLLOW------------------- 610 ' 620 'subroutine to set up the card values 630 ' 640 for I=1 to 10:A%(I)=I:next I 650 for I=11 to 20:A%(I)=I-10:next I 660 for I=21 to 37:A%(I)=I-20:next I 670 for I=38 to 52:A%(I)=I-27:next I 680 Rounds=0 690 return 700 ' 710 'subroutine to create table of 14 valid RPN lists 720 ' 730 Ff=0 740 for X1=3 to 6 750 for X2=X1+1 to 7 760 for X3=X2+1 to 8 770 Ff=Ff+1 780 for I=1 to 9:Q%(Ff,I)=0:next I 790 Q%(Ff,9)=1 800 Q%(Ff,X1)=1 810 Q%(Ff,X2)=1 820 Q%(Ff,X3)=1 830 Bad=0 840 T=0 850 for I=1 to 8 860 if Q%(Ff,I)=0 then T=T+1 else T=T-1 870 if T=0 then Bad=1 880 next I 890 if Bad=1 then Ff=Ff-1 900 next X3 910 next X2 920 next X1 930 return 940 ' 950 'subroutine to create all 5-variable formulas 960 ' 970 'We consider all 14 RPN lists and all 256 choices of four operations 980 'We discard formulas which can be simplified according to these rules: 990 'A/(B/C)=(A*C)/B and (A/B)/C=A/(B*C) (so: no repeated division) 1000 'A*(B/C)=(A*B)/C (so: no multiplcation by fractions) 1010 'A*B=B*A so no products with longer expressions on right 1020 '(more generally, need to order substrings and say: no products A*B 1030 'with B '>' A (e.g. pick (a-b)*(c+d) over other way) 1040 'A*(B*C)=(A*B)*C so no products with products on right 1050 '(A*B)*C=(A*C)*B so no products with products on left if B '>' C 1060 '(e.g. pick (((a+b)*c)*d) over (a*b)*(c+d). Also -**, *++, /++.) 1070 '(These transformations preserve or improve integrality) 1080 'All comments hold likewise with *->+, /->-, integral->positive 1090 'LABEL2: We could also use e.g. A-(B-C)/D -> (C-B)/D+A, 1100 'but this one does _not_ preserve positivity! 1110 'LABEL1: We _do_ encode (A-B)/(C-D)->(B-A)/(D-C) if Alen(Le$)} then Minimal=0 1590 if and{Ee%=3,len(Ri$)=len(Le$)} then gosub 1870 1600 if and{Ee%=3,right(Le$,1)="*"} then gosub 1970 1610 if and{Ee%=2,right(Le$,1)="-"} then Minimal=0 1620 if and{Ee%=2,right(Ri$,1)="-"} then Minimal=0 1630 if and{Ee%=1,right(Le$,1)="-"} then Minimal=0 1640 if and{Ee%=1,right(Ri$,1)="-"} then Minimal=0 1650 if and{Ee%=1,right(Ri$,1)="+"} then Minimal=0 1660 if and{Ee%=1,len(Ri$)>len(Le$)} then Minimal=0 1670 if and{Ee%=1,len(Ri$)=len(Le$)} then gosub 1920 1680 if and{Ee%=1,right(Le$,1)="+"} then gosub 1970 1690 gosub 2020:'LABEL1 1700 if and{Ee%=2,Ra%(Stack)=1} then Minimal=0:'LABEL2 1710 'don't do A-B if B has a difference as factor 1720 R$(Stack)=Q$ 1730 if or{Ee%=1,Ee%=2} then Ra%(Stack)=Ee%-1 1740 if or{Ee%=3,Ee%=4} then Ra%(Stack)=max(Ra%(Stack),Ra%(Stack+1)) 1750 Rb%(Stack)=len(Ri$) 1760 goto 1770 1770 next I 1780 if Minimal=0 then 1850 1790 Opnum=0 1800 Countem=Countem+1 1810 for I=1 to 9 1820 if F%(I)=0 then U%(Countem,I)=0 1830 if F%(I)>0 then Opnum=Opnum+1:U%(Countem,I)=E%(Opnum) 1840 next I 1850 return 1860 ' 1870 'subcheck for minimality -- don't multiply A*B with |A|=|B| if... 1880 if right(Le$,1)="*" then Minimal=0:'(u*v)*(wø)=((u*(wø))*v 1890 if and{right(Le$,1)="-",right(Ri$,1)="+"} then Minimal=0 1900 return 1910 ' 1920 'subcheck for minimality -- don't add A+B with |A|=|B| if... 1930 if right(Le$,1)="+" then Minimal=0:'(u*v)*(wø)=((u*(wø))*v 1940 if and{right(Le$,1)="/",right(Ri$,1)="*"} then Minimal=0 1950 return 1960 ' 1970 'subcheck for minimality -- dont do (A*B)*C if |B|<|C|. "+" same. 1980 if Rb%(Stack+1) lens=1. 2000 return 2010 ' 2020 'subcheck for minimality: don't do (A-B)/(C-D) if len(B)>1 etc. 2030 if and{Ee%=3,right(Le$,1)="-",right(Ri$,1)="-",Rb%(Stack)>1} then Minimal=0 2040 if and{Ee%=3,right(Le$,1)="-",right(Ri$,1)="-",Rb%(Stack+1)>1} then Minimal=0 2050 if and{Ee%=4,right(Le$,1)="-",right(Ri$,1)="-",Rb%(Stack)>1} then Minimal=0 2060 if and{Ee%=4,right(Le$,1)="-",right(Ri$,1)="-",Rb%(Stack+1)>1} then Minimal=0 2070 'remark -- remember to turn off positivity checking! LABEL1 2080 return 2090 ' 2100 'print out a hand (unsolved form) 2110 ' 2120 print "Round number:";Rounds;"Objective:";Obj,"Hand="; 2130 for I=1 to 5:print B%(I);" ";:next I 2140 print 2150 return 2160 ' 2170 'subroutine to create uu-th permutation in S_5 2180 ' 2190 for I=1 to 5:C%(I)=0:next I 2200 X%=(Uu@5):if X%=0 then X%=5 2210 D%(1)=X%:C%(X%)=1 2220 X%=(Uu\5)@4:if X%=0 then X%=4 2230 J=0:for I=1 to 5:if C%(I)=0 then J=J+1:if J=X% then D%(2)=I:C%(I)=1 2240 next I 2250 X%=(Uu\20)@3:if X%=0 then X%=3 2260 J=0:for I=1 to 5:if C%(I)=0 then J=J+1:if J=X% then D%(3)=I:C%(I)=1 2270 next I 2280 X%=(Uu\60)@2:if X%=0 then X%=2 2290 J=0:for I=1 to 5:if C%(I)=0 then J=J+1:if J=X% then D%(4)=I:C%(I)=1 2300 next I 2310 for I=1 to 5:if C%(I)=0 then D%(5)=I:C%(I)=1 2320 next I 2330 for I=1 to 5:D%(I)=B%(D%(I)):next I 2340 'print:'you need this if the next subroutine is printing "."; 2350 print "[";Uu;"]"; 2360 return 2370 ' 2380 'subroutine to create ee-th sequence of four binary operations 2390 ' 2400 if Ee@4=0 then print "."; 2410 E%(1)=(Ee@4)+1 2420 E%(2)=((Ee\4)@4)+1 2430 E%(3)=((Ee\16)@4)+1 2440 E%(4)=((Ee\64)@4)+1 2450 '(1="+", 2="-", 3="*", 4="/") 2460 return 2470 ' 2480 'subroutine to find ff-th placement of 4 operations among 5 numbers 2490 ' 2500 for I=1 to 9 2510 F%(I)=Q%(Ff,I) 2520 next I 2530 return 2540 ' 2550 'subroutine to deal the cards to create a random game 2560 ' 2570 for I=1 to 5:C%(I)=0:next I 2580 I=1+int(52*rnd) 2590 C%(1)=I 2600 Obj=A%(I) 2610 for I=1 to 5 2620 N=1+int(52*rnd) 2630 Ok=1 2640 for K=1 to I 2650 if N=C%(K) then Ok=0 2660 next K 2670 if Ok=0 then 2620 2680 C%(I+1)=N 2690 B%(I)=A%(N) 2700 next I 2710 Rounds=Rounds+1 2720 return 2730 ' 2740 'subroutine to display the game and allow for changes 2750 ' 2760 print "Random draw gives the following game." 2770 gosub 2100 2780 print "If you wish to play this game enter 0, else enter"; 2790 print " new objective card value." 2800 print 2810 input "Objective=";N 2820 if N=0 then 2870 2830 Obj=N 2840 print "Enter the five card values." 2850 for I=1 to 5:print "B(";I;")=";:input B%(I):next I 2860 'note that there is no checking that inputs form a valid game! 2870 return 2880 ' 2890 'subroutine to evaluate expression U%(c,-) on hand D 2900 ' 2910 Stack=0 2920 Numnum=0 2930 for I=1 to 9 2940 if U%(C,I)>0 then 3000 2950 'next symbol is "number". Add it to stack. 2960 Stack=Stack+1 2970 Numnum=Numnum+1 2980 G(Stack)=D%(Numnum) 2990 goto 3120 3000 'next symbol is "operation". Use it on last two stack elements. 3010 if U%(C,I)=1 then T=G(Stack)+G(Stack-1) 3020 if U%(C,I)=2 then T=G(Stack)-G(Stack-1):'if T<0 then T=10000000000:'LABEL1,LABEL2 3030 'The rules require "whole numbers", but seem to imply natural nos. 3040 if U%(C,I)=3 then T=G(Stack)*G(Stack-1) 3050 if U%(C,I)<4 then 3090 3060 if G(Stack-1)<>0 then T=G(Stack)/G(Stack-1) else T=10000000000 3070 'The rules require we keep all intermediate results integral, so... 3080 if T<>round(T) then T=10000000000 3090 Stack=Stack-1 3100 if T=10000000000 then cancel for:goto 3130 3110 G(Stack)=T 3120 next I 3130 'T=round(G(1)*4096)/4096:' a kludge; this may slip some time! 3140 'don't need that one if we require integrality throughout (see above) 3150 if Stack<>1 then T=10000000000 3160 if and{T=Obj,Mode=1} then print:input "Give up (any number=yes)";Xx 3170 if T=Obj then Solved=1:gosub 3210 3180 if Printing=1 then print #1,T;chr(8);", "; print #1,chr(34);:for J=1 to 9:print #1,U%(C,J);:next J:print #1,chr(34) 3190 return 3200 ' 3210 'subroutine to print RPN list U%(C,-) on hand D (with value T) 3220 ' 3230 Stack=0 3240 Numnum=0 3250 for I=1 to 9 3260 if U%(C,I)=0 then 3270 else 3340 3270 'next symbol is "number". Add it to stack. 3280 Stack=Stack+1 3290 Numnum=Numnum+1 3300 G(Stack)=D%(Numnum) 3310 R$(Stack)=str(D%(Numnum))+" " 3320 'R$(Stack)="x"+str(6-(Numnum))+" " 3330 goto 3610 3340 'next symbol is "operation". Use it on last two stack elements. 3350 if U%(C,I)=1 then T=G(Stack)+G(Stack-1) 3360 if U%(C,I)=2 then T=G(Stack)-G(Stack-1) 3370 if U%(C,I)=3 then T=G(Stack)*G(Stack-1) 3380 if U%(C,I)=4 then T=G(Stack)/G(Stack-1) 3390 'Now we have to figure out some symbols which evaluate to |T| . 3400 'By induction assume R$(i) evaluates to |G(i)|. 3410 Stack=Stack-1 3420 Le$=R$(Stack+1):Ri$=R$(Stack):Op=U%(C,I) 3430 if or{Op=3,Op=4} then 3520 3440 if and{Op=1,G(Stack+1)*G(Stack)>=0} then 3520 3450 if and{Op=1,G(Stack+1)*G(Stack)<0,T*G(Stack+1)>=0} then Op=2:goto 3520 3460 if and{Op=1,G(Stack+1)*G(Stack)<0,T*G(Stack+1)<0} then Op=2:gosub 3680:goto 3520 3470 if and{Op=2,G(Stack)*T>=0} then 3520 3480 if and{Op=2,G(Stack+1)*G(Stack)<0} then Op=1:goto 3520 3490 if and{Op=2,G(Stack+1)>=0,G(Stack)>=0,T<0} then gosub 3680:goto 3520 3500 if and{Op=2,G(Stack+1)<0,G(Stack)<0,T>=0} then gosub 3680:goto 3520 3510 print "bogus condition!" 3520 Q$="("+Le$ 3530 if right(Q$,1)=")" then Q$=Q$+" " 3540 if Op=1 then Q$=Q$+"+ " 3550 if Op=2 then Q$=Q$+"- " 3560 if Op=3 then Q$=Q$+"* " 3570 if Op=4 then Q$=Q$+"/ " 3580 R$(Stack)=Q$+Ri$+")" 3590 G(Stack)=T 3600 goto 3610 3610 next I 3620 R$(1)=mid(R$(1),2,len(R$(1))-2) 3630 print 3640 print " "; 3650 print R$(1);" = ";T 3660 return 3670 ' 3680 'swap left and right strings 3690 X$=Le$:Le$=Ri$:Ri$=X$:return 3700 ' 3710 '--------UNUSED SUBROUTINES FOLLOW------------------ 3720 ' 3730 'This main loop avoids presorting formulae (better for 1-shot games) 3740 ' 3750 Solved=0 3760 for Uu=1 to 120:' try all permutations of the five cards 3770 if Solved=1 then 3870 else gosub 2170 3780 for Ee=1 to 256:' try all sequences of four operations 3790 if Solved=1 then 3860 else gosub 2380 3800 for Ff=1 to 14:' try all RPN lists 3810 if Solved=1 then 3850 else gosub 2480 3820 ' 3830 gosub 3940:' here's where we actually see if they combine 3840 ' 3850 next Ff:' go back for another of the 14... 3860 next Ee:' ...or another of the 256... 3870 next Uu:' ...or another of the 120... 3880 if Solved=0 then print "No solution!":gosub 2100:end 3890 if and{Mode<>1,Solved=1} then 390:' let's do another! 3900 print "Played";Rounds;"rounds successfully" 3910 'close #1 3920 end 3930 ' 3940 'subroutine to evaluate RPN list F on hand D with Oplist E 3950 ' 3960 Stack=0 3970 Numnum=0 3980 Opnum=0 3990 for I=1 to 9 4000 if and{I>1,G(Stack)=10000000000} then 4200:'error at some previous level 4010 if F%(I)=0 then 4020 else 4070 4020 'next symbol is "number". Add it to stack. 4030 Stack=Stack+1 4040 Numnum=Numnum+1 4050 G(Stack)=D%(Numnum) 4060 goto 4200 4070 'next symbol is "operation". Use it on last two stack elements. 4080 Opnum=Opnum+1 4090 if E%(Opnum)=1 then T=G(Stack)+G(Stack-1) 4100 if E%(Opnum)=2 then T=G(Stack)-G(Stack-1):'if T<0 then T=10000000000:'LABEL1,LABEL2 4110 'The rules require "whole numbers", but seem to imply natural nos. 4120 if E%(Opnum)=3 then T=G(Stack)*G(Stack-1) 4130 if E%(Opnum)<4 then 4170 4140 if G(Stack-1)<>0 then T=G(Stack)/G(Stack-1) else T=10000000000 4150 'The rules require we keep all intermediate results integral, so... 4160 if T<>int(T) then T=10000000000 4170 Stack=Stack-1 4180 G(Stack)=T 4190 goto 4200 4200 next I 4210 'T=round(G(1)*4096)/4096:' a kludge; this may slip some time! 4220 'don't need that one if we require integrality throughout (see above) 4230 if Stack<>1 then T=10000000000 4240 if and{T=Obj,Mode=1} then print:input "Give up (any number=yes)";Xx 4250 if T=Obj then Solved=1:gosub 4280 4260 return 4270 ' 4280 'subroutine to print RPN list F on hand D with Oplist E 4290 ' 4300 Stack=0 4310 Numnum=0 4320 Opnum=0 4330 for I=1 to 9 4340 if F%(I)=0 then 4350 else 4410 4350 'next symbol is "number". Add it to stack. 4360 Stack=Stack+1 4370 Numnum=Numnum+1 4380 R$(Stack)=str(D%(Numnum))+" " 4390 'R$(Stack)="x"+str(6-(Numnum))+" " 4400 goto 4530 4410 'next symbol is "operation". Use it on last two stack elements. 4420 Stack=Stack-1 4430 Opnum=Opnum+1 4440 Q$="("+R$(Stack+1) 4450 if right(Q$,1)=")" then Q$=Q$+" " 4460 if E%(Opnum)=1 then Q$=Q$+"+ " 4470 if E%(Opnum)=2 then Q$=Q$+"- " 4480 if E%(Opnum)=3 then Q$=Q$+"* " 4490 if E%(Opnum)=4 then Q$=Q$+"/ " 4500 Q$=Q$+R$(Stack) 4510 R$(Stack)=Q$+")" 4520 goto 4530 4530 next I 4540 R$(1)=mid(R$(1),2,len(R$(1))-2) 4550 print 4560 print " "; 4570 print R$(1);" = ";Obj 4580 return 4590 '