|
投稿者：GAI
投稿日：2009年 9月 2日(水)19時47分39秒
|
|
|
|
次の覆面算
ＯＮＥ
ＴＷＯ
＋ＦＯＵＲ
___________
ＳＥＶＥＮ
をプログラムで解けますか？
|
|
|
|
投稿者：SECOND
投稿日：2009年 9月 2日(水)22時44分9秒
|
|
|
|
> No.517[元記事へ]
GAIさんへのお返事です。
!こんなものでは、だめですか。
!----------------------------------------------
LET NN$="ZERO ONE TWO THREE FOUR FIVE SIX SEVEN EIGHT NINE TEN"
DEF num(I$)= (POS( NN$, UCASE$(I$) )-1)/6
DEF num$(I)= mid$( NN$, I*6+1, 5 )
PRINT numb$("ONE+TWO+FOUR")
PRINT numb$("-One-Two-Three")
PRINT numb$("Two+Seven")
PRINT numb$(" - one + two - seven + ten ")
PRINT numb$("- one+ two- seven+ ten ")
PRINT numb$(" -one +two -seven +ten ")
FUNCTION numb$(w$)
LET n=0
LET i=1
DO WHILE i<=LEN(w$)
LET p$=""
DO WHILE w$(i:i)="+" OR w$(i:i)="-" OR w$(i:i)=" "
LET p$=p$& w$(i:i)
LET i=i+1
LOOP
LET n$=""
DO WHILE w$(i:i)<>"+" AND w$(i:i)<>"-" AND w$(i:i)<>" "
LET n$=n$& w$(i:i)
LET i=i+1
LOOP UNTIL LEN(w$)< i
LET j=num(n$)
IF POS(p$,"-")<>0 THEN LET j=-j
LET n=n+j
LOOP
IF n< 0 THEN LET p$="-" ELSE LET p$=""
LET numb$= p$& num$(ABS(n))
END FUNCTION
END
「追記」 覆面算の事を良く知らなくて、これは、違いますね。すみません。
削除は、できないので、このまま、残します。山中さん助けて！
!「追記」あらっぽいですが、これで合ってますか。
OPTION ARITHMETIC NATIVE
DIM n0(0 TO 9),nn(0 TO 9)
MAT READ n0
DATA 0,1,2,3,4,5,6,7,8,9
CALL perm(n0,0)
PRINT "終了"
SUB perm(n0(),j)
local i
IF j<=9 THEN
FOR i=0 TO 9-j
LET nn(j)=n0(i)
swap n0(i),n0(9-j)
CALL perm(n0,j+1)
swap n0(i),n0(9-j)
NEXT i
ELSE
CALL check
END IF
END SUB
SUB check
!MAT PRINT USING REPEAT$("# ",10):nn
LET E=nn(0)
LET O=nn(1)
LET R=nn(2)
LET N=nn(3)
LET W=nn(4)
LET U=nn(5)
LET T=nn(6)
LET V=nn(7)
LET F=nn(8)
LET S=nn(9)
LET yy0= E+O+R
IF N= MOD( yy0,10) THEN
LET cy0= IP( yy0/10) !carry
!---
LET yy1= N+W+U +cy0
IF E=MOD( yy1,10) THEN
LET cy1= IP( yy1/10) !carry
!---
LET yy2= 2*O+T +cy1
IF V=MOD( yy2,10) THEN
LET cy2= IP( yy2/10) !carry
!---
LET yy3= F +cy2
IF E=MOD( yy3,10) AND S=IP( yy3/10) THEN
!---
PRINT " O N E"
PRINT " T W O"
PRINT " + F O U R"
PRINT "───────"
PRINT " S E V E N"
PRINT
PRINT " ";O ;N ;E
PRINT " ";T ;W ;O
PRINT " + ";F ;O ;U ;R
PRINT "───────"
PRINT S ;E ;V ;E ;N
PRINT
END IF
END IF
END IF
END IF
END SUB
END
|
|
|
|
投稿者：山中和義
投稿日：2009年 9月 3日(木)06時39分9秒
|
|
|
|
> No.517[元記事へ]
GAIさんへのお返事です。
１０個（ONETWFURSV）の変数に１０個（０～９）の数字を割り当てるので、
「１０個の数字を使ってできる順列」を生成して、式を確認すればよいでしょう。
場合の数は、comb(10,10)*10!=10!通り。
!覆面算 ※１０個の変数の場合
LET t0=TIME
PUBLIC NUMERIC ANSWER_COUNT !解答数
LET ANSWER_COUNT=0
DIM a(10) !異なる文字 ※ONETWFURSVの順
FOR i=1 TO 10 !０～９
LET a(i)=i-1
NEXT i
CALL perm(a,1)
PRINT "計算時間=";TIME-t0
END
EXTERNAL SUB perm(a(), i) !ｎ個の数字を使ってできる順列（辞書式でない）
LET N=UBOUND(a) !文字数
IF i<N THEN
FOR j=i TO N
LET t=a(i) !swap a(i),a(j)
LET a(i)=a(j)
LET a(j)=t
CALL perm(a,i+1)
LET t=a(i) !swap a(i),a(j)
LET a(i)=a(j)
LET a(j)=t
NEXT j
ELSE !すべてが確定したら、式を検証する
!!!MAT PRINT a; !debug
IF a(1)>0 AND a(4)>0 AND a(6)>0 AND a(9)>0 THEN !最上位桁は０でない
LET ONE = a(1)*100+a(2)*10+a(3)
LET TWO = a(4)*100+a(5)*10+a(1)
LET FOUR = a(6)*1000+ a(1)*100+a(7)*10+a(8)
LET SEVEN=a(9)*10000+a(3)*1000+a(10)*100+a(3)*10+a(2)
IF ONE+TWO+FOUR=SEVEN THEN !式が成立するなら
LET ANSWER_COUNT=ANSWER_COUNT+1 !解答数
PRINT ANSWER_COUNT
PRINT USING " ONE ####":ONE !結果の表示
PRINT USING " TWO ####":TWO
PRINT USING "＋ FOUR ####":FOUR
PRINT "-------"
PRINT USING " SEVEN #####":SEVEN
PRINT
END IF
END IF
END IF
END SUB
実行結果
1
ONE 350
TWO 673
＋ FOUR 9382
-------
SEVEN 10405
2
ONE 350
TWO 683
＋ FOUR 9372
-------
SEVEN 10405
3
ONE 530
TWO 625
＋ FOUR 9548
-------
SEVEN 10703
4
ONE 530
TWO 645
＋ FOUR 9528
-------
SEVEN 10703
5
ONE 630
TWO 526
＋ FOUR 9647
-------
SEVEN 10803
6
ONE 630
TWO 546
＋ FOUR 9627
-------
SEVEN 10803
7
ONE 940
TWO 729
＋ FOUR 8935
-------
SEVEN 10604
8
ONE 940
TWO 739
＋ FOUR 8925
-------
SEVEN 10604
また、
SEND
+ MORE
-----
MONEY
の場合は、８個の変数（SENDMORY）に１０個の数字を割り当てることになります。
「１０個から８個を選ぶ組合せ」で数字を選択して、「その数字を使ってできる順列」での検証。comb(10,8)*8!通り。
上記プログラムは、そのテンプレートになると思いますので改修してみてください。
参考
フォルダ SAMPLE 内 PERMUTAT.BAS、COMBINAT.BAS
|
|
|
|
投稿者：荒田浩二
投稿日：2009年 9月 3日(木)10時08分25秒
|
|
|
|
> No.517[元記事へ]
GAIさんへのお返事です。
投稿しようとしたらすでに山中和義さんの投稿があり、似たようなものですがせっかく作ったので公開します。
解法は、文字に数をしらみつぶしに入れていき計算を満たすか検証する方法です。
GAIさんが論理的に数値を求める方法を望んでいるのであれば、この方法ではだめですね。
GAIさんの提示された問題は複数の解答があるので、実行ごとに調査の開始する点をランダムにしました。
(山中さんのプログラムとは違い、ひとつの解を発見した時点で終了します)
他の覆面算にも応用できるようにしました。
次の3箇所を変更するだけで実行できると思います。
１．変数 k の値（LET k=4 ! 単語の個数）
２．各単語のDATA（DATA "ONE","TWO","FOUR","SEVEN"）
３．IF文で判定する計算式
（IF h0=0 AND change("ONE")+change("TWO")+change("FOUR")=change("SEVEN") THEN）
SEND+MORE=MONEY で試してみてください。
OPTION ARITHMETIC NATIVE
DECLARE EXTERNAL SUB perm,charac,headset
DECLARE EXTERNAL FUNCTION random
PUBLIC NUMERIC k,num(10),head(30),check(0 TO 9)
PUBLIC STRING word$(30),c$(10)
LET k=4 ! 単語の個数
!LET k=3
FOR i=1 TO k
READ word$(i)
NEXT i
DATA "ONE","TWO","FOUR","SEVEN"
!DATA "SEND","MORE","MONEY"
CALL charac(word$)
CALL headset
RANDOMIZE
MAT check=ZER
FOR i=1 TO 10
LET num(i)=random
NEXT i
!
CALL perm(num,1)
END
!
!
REM 1～nの順列を辞書式順序で生成する。
!十進BASIC添付"\BASICw32\SAMPLE\PERMUTAT.BAS"参照
EXTERNAL SUB perm(a(),n)
OPTION ARITHMETIC NATIVE
DECLARE FUNCTION change
IF n=10 THEN
LET h0=0
FOR ii=1 TO k
IF num(head(ii))=0 THEN
LET h0=1 ! 先頭文字が 0
EXIT FOR
END IF
NEXT ii
IF h0=0 AND change("ONE")+change("TWO")+change("FOUR")=change("SEVEN") THEN
!IF h0=0 AND change("SEND")+change("MORE")=change("MONEY") THEN
FOR ii=1 TO k
PRINT word$(ii);" =";change(word$(ii))
NEXT ii
FOR ii=1 TO 10
PRINT c$(ii);"=";STR$(num(ii));" ";
NEXT ii
PRINT
STOP
END IF
ELSE
FOR i=n TO 10
LET t=a(i)
FOR j=i-1 TO n STEP -1
LET a(j+1)=a(j)
NEXT j
LET a(n)=t
CALL perm(a,n+1)
LET t=a(n)
FOR j=n TO i-1
LET a(j)=a(j+1)
NEXT j
LET a(i)=t
NEXT i
END IF
FUNCTION change(w$)
LET l=LEN(w$)
LET s=0
FOR i=1 TO l
FOR j=1 TO 10
IF c$(j)=w$(i:i) THEN
LET s=s+10^(l-i)*num(j)
EXIT FOR
END IF
NEXT j
NEXT i
LET change=s
END FUNCTION
END SUB
!
EXTERNAL SUB charac(a$())
OPTION ARITHMETIC NATIVE
LET s=SIZE(a$)
LET c=1
LET c$(1)=a$(1)(1:1)
FOR i=1 TO s
FOR j=1 TO LEN(a$(i))
LET cc=0
FOR kk=1 TO c
IF a$(i)(j:j)<>c$(kk) THEN LET cc=cc+1
NEXT kk
IF cc=c THEN
LET c=c+1
LET c$(c)=a$(i)(j:j)
IF c=10 THEN EXIT SUB
END IF
NEXT j
NEXT i
END SUB
!
EXTERNAL SUB headset
OPTION ARITHMETIC NATIVE
FOR i=1 TO k
FOR j=1 TO 10
IF word$(i)(1:1)=c$(j) THEN LET head(i)=j !先頭文字
NEXT j
NEXT i
END SUB
!
EXTERNAL FUNCTION random
OPTION ARITHMETIC NATIVE
LET r=INT(10*RND)
IF check(r)=0 THEN
LET random=r
LET check(r)=1
ELSE
LET random=random
END IF
END FUNCTION
|
|
|
|
投稿者：島村1243
投稿日：2009年 9月 3日(木)15時01分57秒
|
|
|
|
> No.522[元記事へ]
荒田浩二さんへのお返事です。
> GAIさんへのお返事です。
>
>
> 投稿しようとしたらすでに山中和義さんの投稿があり、似たようなものですがせっかく作ったので公開します。
荒田さんの作成されたプログラムを、「コピー貼り付け」でFedora10 Linux上のBASIC-6.5.9で
走らせたら、BASIC本体がクラッシュ（何度行ってもダメ）してしまいましたのでご報告致しま
す。
パソコンのRAMは512MBですが、メモリが足りないのでしょうか。
|
|
|
|
投稿者：島村1243
投稿日：2009年 9月 3日(木)17時38分1秒
|
|
|
|
> No.524[元記事へ]
荒田浩二さんへのお返事です。
> 荒田さんの作成されたプログラムを、「コピー貼り付け」でFedora10 Linux上のBASIC-6.5.9で
> 走らせたら、BASIC本体がクラッシュ（何度行ってもダメ）してしまいましたのでご報告致しま
> す。
> パソコンのRAMは512MBですが、メモリが足りないのでしょうか。
同一パソコンのWindowsXP上のBASIC-7.2.9で実行したらプログラムは異常なく走りました。
この結果から、Linux側の問題(OSの問題かBASIC-6.5.9の問題かは不明）で異常が出てしまうようです。
以上、ご報告です。
|
|
|
|
投稿者：白石 和夫
投稿日：2009年 9月 3日(木)20時58分3秒
|
|
|
|
投稿者：荒田浩二
投稿日：2009年 9月 3日(木)23時03分29秒
|
|
|
|
> No.524[元記事へ]
島村1243さんへのお返事です。
> 荒田さんの作成されたプログラムを、「コピー貼り付け」でFedora10 Linux上のBASIC-6.5.9で
> 走らせたら、BASIC本体がクラッシュ（何度行ってもダメ）してしまいましたのでご報告致しま
> す。
> パソコンのRAMは512MBですが、メモリが足りないのでしょうか。
それは申し訳ないことをしました。
私はLinuxはまったく知らないのですが、WindowsVista上で十進BASIC Ver.7.3.3では問題なく実行できました。
可能性としては、実は最初に投稿したときに脱字がありました。10分後には修正して再投稿したのですが、島村1243さんが最初の投稿記事で実行されたのかもしれません。
修正箇所は外部副プログラムの宣言文です。
誤) DECLARE EXTERNAL SUB perm,chara,headset
正) DECLARE EXTERNAL SUB perm,charac,headset
ただし、ヘルプによると外部副プログラムの宣言は必須のものではないらしく、最初の誤った記事でもWindowsでは問題なく実行できました。
また、512MBあれば「メモリー不足」ということも考えにくいですよね。
関数changeは確かに頻繁に呼び出されますが、最大でも 4*10! 回です。しかも先頭文字O,T,F,Sのいずれかが0のときは呼び出さないのでメモリーが不足するとは思えません。
あるいは、十進BASICの独自拡張である「主プログラム内で変数のPUBLIC宣言」を利用していますが、この機能がLinuxでは上手く働かないのでしょうか？
ごめんなさい、まったくわかりません。
|
|
|
|
投稿者：白石 和夫
投稿日：2009年 9月 4日(金)08時11分10秒
|
|
|
|
> No.527[元記事へ]
不具合箇所が特定できたので，修正版を作ります。
2進モードで次のプログラムを実行すると変な現象が起こります。
2進モードで文字列処理する人がいなかったのがバグ発覚が遅れた原因でしょうか。
OPTION ARITHMETIC NATIVE
DIM a$(4)
FOR i= 1 TO 4
PRINT a$(i)
NEXT i
END
Linux版，Mac版はGPLなので「バグ報告の義務」を使用条件に書くことができないのですが，
不具合を見つけたときは報告くださるようお願いします。
|
|
|
|
投稿者：島村1243
投稿日：2009年 9月 5日(土)09時26分8秒
|
|
|
|
> No.529[元記事へ]
白石 和夫さんへのお返事です。
> 不具合箇所が特定できたので，修正版を作ります。
> 2進モードで次のプログラムを実行すると変な現象が起こります。
> Linux版，Mac版はGPLなので「バグ報告の義務」を使用条件に書くことができないのですが，
> 不具合を見つけたときは報告くださるようお願いします。
Linux(i386)版 最新の「BASIC-6.5.A」をFedora10上にインストールし、荒田さん作成の
「覆面算」コードを、ウェブ画面からコピー貼り付けしてRUNしましたら、正常に計算が
完了しました。
白石先生、有難うございました。
荒田さん、コードの公開有難うございました。勉強になります。
以上、ご報告です。
|
|
|
戻る