プログラミング言語には、十進basicを使いました。
OPTION BASE 0
OPTION ANGLE DEGREES
DIM bl(7,4,3)
!各ブロックの基本位置での座標設定
DATA 0,0,0,1,0,0,0,1,0,0,0,0 !若草 1
DATA 0,0,0,1,0,0,2,0,0,0,1,0 !黄 2
DATA 0,0,0,1,0,0,1,1,0,2,1,0 !赤 3
DATA 0,0,0,1,0,0,0,1,0,0,0,1 !緑 4
DATA 0,0,0,1,0,0,0,1,0,0,1,1 !紫 5
DATA 0,0,0,1,0,0,2,0,0,1,1,0 !水色 6
DATA 0,0,0,1,0,0,0,1,0,1,1,0 !茶 7
!座標の読み込み to bl(m,k,n) m番目のブロック、k番目のピース、
! bl(m,k,n)=0,1,2
FOR m=1 TO 7
FOR k=1 TO 4
FOR n=1 TO 3
READ bl(m,k,n)
NEXT n
NEXT k
NEXT m
!
PRINT "座標の読み込み"
!データ基本位置の出力（略）
!bl(7,4,3)の画像チェック（略）
!基本位置での変位24ケースの設定 from bl(m,k,n) to spc24(m,k,n,nn)
! spc24(m,k,n,nn)=-2,-1,0,1,2 m番目のブロック、k番目のピース
! n=1:x軸、2:y軸、3:z軸、 nn:収納ケース番号(1～24)
DIM spc24(7,4,3,24)
! 基本位置を、 Z軸周りで90度毎に回転させながら、
! X軸周りで90度毎に回転さる。
! これで、16通り形成。
FOR m=1 TO 7
FOR k=1 TO 4
LET nn=0
FOR az=0 TO 270 STEP 90
LET xz= bl(m,k,1)*COS(az)-bl(m,k,2)*SIN(az)
LET yz= bl(m,k,1)*SIN(az)+bl(m,k,2)*COS(az)
LET zz= bl(m,k,3)
FOR ax= 0 TO 270 STEP 90
LET nn=nn+1
LET spc24(m,k,2,nn)=yz*COS(ax)-zz*SIN(ax)
LET spc24(m,k,3,nn)=yz*SIN(ax)+zz*COS(ax)
LET spc24(m,k,1,nn)=xz
NEXT ax
NEXT az
! 上記に加え、基本位置を Y軸周りで90度と270度に回転させながら、
! X軸周りで90度毎に回転させる。
! これで8ケース形成され、計24ケースとなる。
FOR ay= 90 TO 270 STEP 180
LET zy= bl(m,k,3)*COS(ay)-bl(m,k,1)*SIN(ay)
LET xy= bl(m,k,3)*SIN(ay)+bl(m,k,1)*COS(ay)
LET yy= bl(m,k,2)
FOR ax= 0 TO 270 STEP 90
LET nn=nn+1
LET spc24(m,k,2,nn)=yy*COS(ax)-zy*SIN(ax)
LET spc24(m,k,3,nn)=yy*SIN(ax)+zy*COS(ax)
LET spc24(m,k,1,nn)=xy
NEXT ax
NEXT ay
NEXT k
NEXT m
! 648ケースへの拡張
! spc(m,k,n,nn)=-2,-1,0,1,2 m番目のブロック、k番目のピース
! n=1:x軸、2:y軸、3:z軸、 nn:収納ケース番号(1～648)
DIM spc(7,4,3,648)
! 上で得られた24通りの収納ケースを更に発展させる
! x軸、y軸、z軸に夫々2回移動させて、3X3X3＝27倍、24X27＝648ケースに拡げる
FOR m=1 TO 7
LET nn=0
FOR z=0 TO 2
FOR y=0 TO 2
FOR x=0 TO 2
FOR n=1 TO 24
LET nn=nn+1
FOR k=1 TO 4
LET spc(m,k,1,nn)=spc24(m,k,1,n)+x
LET spc(m,k,2,nn)=spc24(m,k,2,n)+y
LET spc(m,k,3,nn)=spc24(m,k,3,n)+z
NEXT k
NEXT n
NEXT x
NEXT y
NEXT z
LET nnmaxm=nn
! Always, nnmaxm=648
PRINT m;nn
NEXT m
print"収納可能648ケースの設定完"
!実効配置ケースの選択
! 枠外対象のケースに枠外flagを立てる。
! wgflg(m.nn)=0 or 1,
! m:ブロック番号(1～７), nn:収納ケース番号(1～648)
DIM wgflg(7,648)
FOR m=1 TO 7
FOR nn=1 TO nnmaxm
FOR k=1 TO 4
FOR n=1 TO 3
IF spc(m,k,n,nn)>2 OR spc(m,k,n,nn)<0 THEN LET wgflg(m,nn)=1
NEXT n
NEXT k
! PRINT"m,nn,wgflg(m,nn)=";m;nn;wgflg(m,nn)
NEXT nn
NEXT m
DIM nnmax(7)
!枠外Flagが立っているのを削除する（それ以降を前にシフトしてnnmaxを減じる）
FOR m=1 TO 7
LET nnmaxm=648
30 FOR nn=1 TO nnmaxm
IF wgflg(m,nn)=1 THEN
FOR nnn=nn TO nnmaxm-1
LET wgflg(m,nnn)=wgflg(m,nnn+1)
FOR k=1 TO 4
FOR n=1 TO 3
LET spc(m,k,n,nnn)=spc(m,k,n,nnn+1)
NEXT n
NEXT k
NEXT nnn
LET nnmaxm=nnmaxm-1
GOTO 30
END IF
NEXT nn
LET nnmax(m)=nnmaxm
PRINT "m;nnmax(m)";m;nnmax(m)
NEXT m
!実効配置ケースの選択
!重複配置ケースの削除
! spc(m,k,n,nn)=0,1,2 枠外は削除されているのでマイナスはない
! m番目のブロック、k番目のピース
! n=1:x軸、2:y軸、3:z軸、 nn:収納ケース番号(1～648)
DIM pack(27)
DIM nspc(7,4,10000)
! nspc(m,k,nn)=0～26
!専有座標個々の３進法化（個々の専有座標を０～２６の整数値に変換）
FOR m=1 TO 7
FOR nn=1 TO nnmax(m)
FOR k=1 TO 4
LET nspc(m,k,nn)= spc(m,k,3,nn)*9+spc(m,k,2,nn)*3+spc(m,k,1,nn)
NEXT k
NEXT nn
NEXT m
!nspc(7,4,200)の同一m,nnでk=1から4を降順に並び替える
DIM aa(4)
FOR m=1 TO 7
FOR nn=1 TO nnmax(m)
LET imx=1
60 LET a12=MAX(nspc(m,1,nn),nspc(m,2,nn))
LET a34=MAX(nspc(m,3,nn),nspc(m,4,nn))
LET amax=MAX(a12,a34)
FOR k=1 TO 4
IF nspc(m,k,nn)=amax THEN
LET aa(imx)=amax
LET nspc(m,k,nn)=0
GOTO 61
END IF
NEXT k
61 IF imx=4 THEN
FOR k=1 TO 4
LET nspc(m,k,nn)=aa(k)
NEXT k
GOTO 62
END IF
LET imx=imx+1
GOTO 60
62 NEXT nn
NEXT m
!各ブロックの27進法化（各ブロックの専有座標を個別の整数値に変換）
DIM nspc27(7,10000)
! nspc27(m,nn)=大きな数字
FOR m=1 TO 7
FOR nn=1 TO nnmax(m)
! PRINT m;nn
LET nspc27(m,nn)=27^3*nspc(m,1,nn)+27^2*nspc(m,2,nn)+27*nspc(m,3,nn)+nspc(m,4,nn)
NEXT nn
NEXT m
! 重複配置に重複flagを付けて削除する
DIM nflg27(7,10000)
!重複配置の為の不要FLAG作成 nspc27(m,200)
FOR m=1 TO 7
LET nnmaxm=nnmax(m)
300 FOR nn=1 TO nnmaxm-1
IF nspc27(m,nn)=nspc27(m,nnmaxm) THEN LET nflg27(m,nn)=1
NEXT nn
IF nnmaxm=2 THEN GOTO 330
LET nnmaxm=nnmaxm-1
GOTO 300
330 NEXT m
!重複配置の削除 "nflg27(7,100);nspc(m,k,nn)→nfspc(m,k,nn),nnmax(m)→nfmax(m)"
DIM nfspc(7,4,10000),nfmax(7)
! nfspc(m,k,nn)=0～26 重複排除後（実効配置）
FOR m=1 TO 7
LET nf=0
FOR nn=1 TO nnmax(m)
IF nflg27(m,nn)=0 THEN LET nf=nf+1 ELSE GOTO 340
FOR k=1 TO 4
LET nfspc(m,k,nf)=nspc(m,k,nn)
NEXT k
340 NEXT nn
LET nfmax(m)=nf
PRINT "m;nfmax(m)";m;nfmax(m)
NEXT m
!重複排除後の配置チェック（略）
!結果チェック for 重複排除(略）
!データ重複排除後の出力（略）
!************* 探索開始 ************************
print"serch start"
LET time1=TIME
! Search routine :m;nn;nfspc(7,4,///),nfmax(7)
DIM nc(7),nfil(27),nnset(7,4,30000)
! nnset(m,k,nn)=0～26 解答nn番目・ブロックm番目・ピースk番目の専有座標
501 FOR n1=1 TO nfmax(1)
FOR i=1 TO 27
LET nfil(i)=0
NEXT i
LET n1ss=n1
FOR k=1 TO 4
LET i=nfspc(1,k,n1ss)+1
LET nfil(i)=1
NEXT k
502 FOR n2=1 TO nfmax(2)
FOR k=1 TO 4
LET i=nfspc(2,k,n2)+1
IF nfil(i)=1 THEN GOTO 580
NEXT k
LET n2ss=n2
FOR k=1 TO 4
LET i=nfspc(2,k,n2ss)+1
LET nfil(i)=1
NEXT k
503 FOR n3=1 TO nfmax(3)
FOR k=1 TO 4
LET i=nfspc(3,k,n3)+1
IF nfil(i)=1 THEN GOTO 570
NEXT k
LET n3ss=n3
FOR k=1 TO 4
LET i=nfspc(3,k,n3ss)+1
LET nfil(i)=1
NEXT k
504 FOR n4=1 TO nfmax(4)
FOR k=1 TO 4
LET i=nfspc(4,k,n4)+1
IF nfil(i)=1 THEN GOTO 560
NEXT k
LET n4ss=n4
FOR k=1 TO 4
LET i=nfspc(4,k,n4ss)+1
LET nfil(i)=1
NEXT k
505 FOR n5=1 TO nfmax(5)
FOR k=1 TO 4
LET i=nfspc(5,k,n5)+1
IF nfil(i)=1 THEN GOTO 550
NEXT k
LET n5ss=n5
FOR k=1 TO 4
LET i=nfspc(5,k,n5ss)+1
LET nfil(i)=1
NEXT k
506 FOR n6=1 TO nfmax(6)
FOR k=1 TO 4
LET i=nfspc(6,k,n6)+1
IF nfil(i)=1 THEN GOTO 540
NEXT k
LET n6ss=n6
FOR k=1 TO 4
LET i=nfspc(6,k,n6ss)+1
LET nfil(i)=1
NEXT k
507 FOR n7=1 TO nfmax(7)
FOR k=1 TO 4
LET i=nfspc(7,k,n7)+1
IF nfil(i)=1 THEN GOTO 530
NEXT k
LET n7ss=n7
FOR k=1 TO 4
LET i=nfspc(7,k,n7ss)+1
LET nfil(i)=1
NEXT k
LET nans=nans+1
FOR k=1 TO 4
LET nnset(1,k,nans)=nfspc(1,k,n1ss)
LET nnset(2,k,nans)=nfspc(2,k,n2ss)
LET nnset(3,k,nans)=nfspc(3,k,n3ss)
LET nnset(4,k,nans)=nfspc(4,k,n4ss)
LET nnset(5,k,nans)=nfspc(5,k,n5ss)
LET nnset(6,k,nans)=nfspc(6,k,n6ss)
LET nnset(7,k,nans)=nfspc(7,k,n7ss)
NEXT k
PRINT "nans=";nans;n1;n2;n3;n4;n5;n6;n7
! nans: nans番目の解答
!n1,n2,・・,nn,・・,n7: 夫々のブロックの配置ケース
FOR k=1 TO 4
LET i=nfspc(7,k,n7ss)+1
LET nfil(i)=0
NEXT k
530 NEXT n7
FOR k=1 TO 4
LET i=nfspc(6,k,n6ss)+1
LET nfil(i)=0
NEXT k
540 NEXT n6
FOR k=1 TO 4
LET i=nfspc(5,k,n5ss)+1
LET nfil(i)=0
NEXT k
550 NEXT n5
FOR k=1 TO 4
LET i=nfspc(4,k,n4ss)+1
LET nfil(i)=0
NEXT k
560 NEXT n4
FOR k=1 TO 4
LET i=nfspc(3,k,n3ss)+1
LET nfil(i)=0
NEXT k
570 NEXT n3
FOR k=1 TO 4
LET i=nfspc(2,k,n2ss)+1
LET nfil(i)=0
NEXT k
580 NEXT n2
FOR k=1 TO 4
LET i=nfspc(1,k,n1ss)+1
LET nfil(i)=0
NEXT k
NEXT n1
5000 PRINT"search end"
PRINT"Time=";TIME-time1;"秒かかりました。"
PRINT "There are ";nans ;" kinds of answer."
!立体パズル\データ解答の出力（略）
END
! 作図サブルーティン（略）