10 dim Typ(6),Stval(3,4),Endval(3,4),V(3)
20 Typ(1)="spc":Typ(2)="scp"
30 Typ(3)="psc":Typ(4)="pcs"
40 Typ(5)="cps":Typ(6)="csp"
45 open "num-meld.txt" for output as #2
50
60 ' squares 4-9 are 2-digit
70 ' squares 10-31 are 3-digit
80 ' square 32 is first 4-dig square; 99th is last
90 ' primes 5-25 are 2-digit
100 ' primes 26-168 are 3-digit
110 ' prime 169 is first 4-dig prime; 1229th is last
120 ' cubes 3-4 are 2-digit
130 ' cubes 5-9 are 3-digit
140 ' cube 10 is first 4-dig cube; 21st is last
150 Stval(1,2)=4:Endval(1,2)=9
160 Stval(1,3)=10:Endval(1,3)=31
170 Stval(1,4)=32:Endval(1,4)=99
180 Stval(2,2)=5:Endval(2,2)=25
190 Stval(2,3)=26:Endval(2,3)=168
200 Stval(2,4)=169:Endval(2,4)=1229
210 Stval(3,2)=3:Endval(3,2)=4
220 Stval(3,3)=5:Endval(3,3)=9
230 Stval(3,4)=10:Endval(3,4)=21
240
250
260 for Digs=2 to 4
270 print #2,:print #2,"digits: ";Digs:print #2,
280 for Tp=1 to 6
290 Proto=Typ(Tp)
300 print #2,Proto
310 if left(Proto,1)="s" then St=Stval(1,Digs):Fin=Endval(1,Digs)
320 if left(Proto,1)="p" then St=Stval(2,Digs):Fin=Endval(2,Digs)
330 if left(Proto,1)="c" then St=Stval(3,Digs):Fin=Endval(3,Digs)
340 for Bse=St to Fin
350 if left(Proto,1)="s" then V(1)=cutspc(str(Bse*Bse))
360 if left(Proto,1)="p" then V(1)=cutspc(str(prm(Bse)))
370 if left(Proto,1)="c" then V(1)=cutspc(str(Bse*Bse*Bse))
380 for Varpos=1 to Digs
390 for Substdig=0 to 9
400 Good=1
410 if Substdig=0 and Varpos=1 then Good=0
420 if Substdig=0 or val(mid(V(1),Varpos,1))=Substdig then Good=0
430 Newv=left(V(1),Varpos-1)+cutspc(str(Substdig))+mid(V(1),Varpos+1,*)
440 Newval=val(Newv)
450 if mid(Proto,2,1)="s" then if fnIsSq(Newval)=0 then Good=0
460 if mid(Proto,2,1)="p" then if fnIsPrime(Newval)=0 then Good=0
470 if mid(Proto,2,1)="c" then if fnIsCube(Newval)=0 then Good=0
480
490 if Good then
500 :V(2)=Newv
510 :for Varpos2=1 to Digs
520 :for Subdig2=0 to 9
530 :Good=1
540 :if Subdig2=0 and Varpos2=1 then Good=0:endif
550 :if Subdig2=0 or val(mid(V(2),Varpos2,1))=Subdig2 then Good=0:endif
560 :Newv=left(V(2),Varpos2-1)+cutspc(str(Subdig2))+mid(V(2),Varpos2+1,*)
570 :Newval=val(Newv)
580 :if mid(Proto,3,1)="s" then if fnIsSq(Newval)=0 then Good=0:endif:endif
590 :if mid(Proto,3,1)="p" then if fnIsPrime(Newval)=0 then Good=0:endif:endif
600 :if mid(Proto,3,1)="c" then if fnIsCube(Newval)=0 then Good=0:endif:endif
610 :
620 :if Good then
630 :V(3)=Newv
640 :for I=1 to 3
641 :print #2,V(I);" ";:Dup=0
642 :for J=1 to len(V(I))-1:if instr(mid(V(I),J+1,*),mid(V(I),J,1))>0 then Dup=1:endif:next
643 :if Dup then print #2,"* ";:endif
644 :next
650 :print #2,
660 :endif
670 :next Subdig2
680 :next Varpos2
690
700 next Substdig
710 next Varpos
720 next
730 next Tp
740 next Digs
750 close
998 end
999
1000 fnIsPrime(X)
1010 local A
1020 if X=prmdiv(X) and X<>1 then A=1 else A=0
1030 return(A)
1040
2000 fnIsSq(X)
2010 local A,Sr
2020 Sr=int(sqrt(X)+0.5)
2030 if Sr*Sr=X then A=1 else A=0
2040 return(A)
2050
3000 fnIsCube(X)
3010 local A,Cr
3020 Cr=int(X^(1/3)+0.5)
3030 if Cr*Cr*Cr=X then A=1 else A=0
3040 return(A)
find solutions including those with duplicate digits within numbers, and it marks those with asterisks.
The cleaned up output file (line with asterisks removed) is as follows. The heading abbreviations are spc for square prime cube, etc.:
digits: 2
spc
16 17 27
25 23 27
25 29 27
36 37 27
49 29 27
49 47 27
64 61 64
64 67 27
64 67 64
81 61 64
scp
25 27 17
25 27 37
25 27 47
25 27 67
25 27 97
25 27 23
25 27 29
psc
23 25 27
29 25 27
pcs
17 27 25
23 27 25
29 27 25
37 27 25
47 27 25
67 27 25
97 27 25
cps
27 17 16
27 37 36
27 47 49
27 67 64
27 23 25
27 29 49
27 29 25
64 61 81
64 61 64
64 67 64
csp
27 25 23
27 25 29
digits: 3
spc
169 769 729
529 829 729
729 829 729
729 719 729
729 739 729
729 769 729
scp
529 729 829
529 729 719
529 729 739
529 729 769
625 125 127
psc
251 256 216
257 256 216
509 529 729
521 529 729
523 529 729
569 529 729
829 529 729
pcs
127 125 625
709 729 529
719 729 529
739 729 529
769 729 529
829 729 529
cps
729 829 529
729 829 729
729 719 729
729 739 729
729 769 169
729 769 729
csp
216 256 251
216 256 257
729 529 829
729 529 569
729 529 521
729 529 523
digits: 4
spc
4096 4091 4096
4096 4093 4096
4761 4261 9261
6241 9241 9261
scp
psc
pcs
cps
4096 4091 4096
4096 4093 4096
9261 4261 4761
9261 9241 6241
csp
Only the 4-digit case has categories lacking solutions, so I'm appending the portion of the full output for just those categories within the 4-digit set. I've deleted the asterisks.:
scp
2704 2744 2741
2704 2744 2749
6889 6859 9859
6889 6859 6359
6889 6859 6659
6889 6859 6959
6889 6859 6829
6889 6859 6869
6889 6859 6899
6889 6859 6857
7744 2744 2741
7744 2744 2749
psc
1889 6889 6859
2707 2704 2744
3889 6889 6859
4889 6889 6859
6089 6889 6859
6389 6889 6859
6689 6889 6859
6829 6889 6859
6869 6889 6859
6883 6889 6859
6899 6889 6859
7741 7744 2744
pcs
2741 2744 7744
2749 2744 7744
6359 6859 6889
6659 6859 6889
6829 6859 6889
6857 6859 6889
6869 6859 6889
6899 6859 6889
6959 6859 6889
9859 6859 6889
csp
1000 1600 1601
1000 1600 1607
1000 1600 1609
2744 7744 7741
6859 6889 1889
6859 6889 3889
6859 6889 4889
6859 6889 6389
6859 6889 6689
6859 6889 6829
6859 6889 6869
6859 6889 6899
6859 6889 6883
8000 8100 8101
The above do not all validate that the entries be in ascending order. I reran with a check for that, and the results are shown below, with a mixture of solutions that do and do not have duplicate digits within words. Numbers with duplicate digits are marked with an asterisk for ease in spotting them:
digits: 2
spc
16 17 27
scp
25 27 37
25 27 47
25 27 67
25 27 97
25 27 29
psc
23 25 27
pcs
cps
27 47 49
27 29 49
csp
digits: 3
spc
225 * 229 * 729
scp
121 * 125 127
529 729 829
529 729 929 *
529 729 739
529 729 769
psc
101 * 121 * 125
229 * 529 729
509 529 729
521 529 729
523 529 729
pcs
211 * 216 256
cps
csp
125 225 * 227 *
125 225 * 229 *
216 256 257
digits: 4
spc
1521 * 1721 * 1728
4900 * 4903 4913
6241 9241 9261
scp
2704 2744 * 2749
psc
pcs
2741 2744 * 7744 *
6359 6859 6889 *
6659 * 6859 6889 *
6829 6859 6889 *
6857 6859 6889 *
cps
1000 * 1009 * 1089
1331 * 1931 * 1936
1331 * 1361 * 1369
1331 * 1381 * 1681 *
6859 6869 * 6889 *
csp
1000 * 1600 * 1601 *
1000 * 1600 * 1607
1000 * 1600 * 1609
6859 6889 * 6899 *
8000 * 8100 * 8101 *
Note that only one 4-digit sequence follows all the rules: the square-prime-cube sequence 6241 9241 9261.
|
Posted by Charlie
on 2012-01-06 15:00:55 |