FOUR 　　FOURS

 投稿者：永野護  投稿日：2011年 6月 6日(月)14時06分7秒
  いつも大変お世話になっています。
数学パズルでfour  fours(4つの4)というのがあります。（4つの4 WIKIPEDIAをご覧になってください）。このパズルで使う演算記号を+,-,*,/だけに限定した（かっこ等は使わない、44,444等も使わない、すなわち4+4*4-4の形の式しか認めない)
場合は、EXCEL　VBAでEVALUATEを使って簡単に
プログラムできました。これを十進BASICで行えばどのようになるでしょうか。

↓をEXCELのワークシートと思ってください。
A B C
1 + + +
2 - - -
3 * * *
4 / / /
以下がVBAで作ったプログラムです。
Sub hhh()
h = 1
For a = 1 To 4  '
For b = 1 To 4
For c = 1 To 4

ss = 4 & Cells(a, 1) & 4 & Cells(b, 2) & 4 & Cells(c, 3) & 4
sss = Evaluate(ss)
Cells(h, 5) = Cells(a, 1)
Cells(h, 6) = Cells(b, 2)
Cells(h, 7) = Cells(c, 3)
Cells(h, 8) = sss
h = h + 1
Next
Next
Next

End Sub
 		 

Re: FOUR 　　FOURS

 投稿者：山中和義  投稿日：2011年 6月 6日(月)15時44分10秒
  > No.1576[元記事へ]

永野護さんへのお返事です。

> EXCEL　VBAでEVALUATEを使って簡単に
> プログラムできました。これを十進BASICで行えばどのようになるでしょうか。

同機能を有する関数（インタプリタ形式の数式処理）を定義すればよいです。
フォルダ SAMPLE 内　INTERPRE.BAS がサンプルとなります。



1000 REM Full BASICのモジュールの使い方を示すサンプル
1010 REM
1020 REM 数値式の評価を行う
1030 REM 組込み関数は，SIN，COS，TAN, LOG, EXP, SQR, INT，ABSとPIのみ
1040 REM 大文字と小文字の区別はしない
1050 REM 数値式の文法はほぼFull BASICに準ずるが，関数名に続く括弧は空白を入れずに書く。
1060 REM 数値は，数字で始まり，コンマを1個以下含む数字の列としてのみ書ける。
1070 REM 零除算エラーなどは考慮していない。
1080 DECLARE EXTERNAL FUNCTION interpreter.expression  ! 数値式を評価する関数
1090 DECLARE EXTERNAL STRING interpreter.s$            ! 入力行
1100 DECLARE EXTERNAL NUMERIC interpreter.i            ! 入力行の文字位置
1110 DECLARE EXTERNAL SUB interpreter.skip             ! 空白文字を読み飛ばす副プログラム
     LET OP$="+-*/"
     FOR a=1 TO 4
        FOR b=1 TO 4
           FOR c=1 TO 4
              LET s$="4"&OP$(a:a)&"4"&OP$(b:b)&"4"&OP$(c:c)&"4"
              PRINT s$;"=";
1130          LET s$=UCASE$(s$)
1140          LET i=1
1150          CALL skip
1160          PRINT expression
1170          IF i<LEN(s$) THEN PRINT "Syntax error"
           NEXT c
        NEXT b
     NEXT a
1180 END
1190 !
1200 MODULE interpreter
1210 PUBLIC STRING s$
1220 PUBLIC NUMERIC i
1230 PUBLIC FUNCTION expression
1240 PUBLIC SUB skip
1250 SHARE FUNCTION term,factor,primary,numeric
1260 !
1270 EXTERNAL SUB skip
1280    DO WHILE s$(i:i)=" "
1290       LET i=i+1
1300    LOOP
1310 END SUB
1320 !
1330 EXTERNAL FUNCTION expression
1340    DECLARE NUMERIC n
1350    DECLARE STRING op$
1360    SELECT CASE s$(i:i)
1370    CASE "-"
1380       LET i=i+1
1390       CALL skip
1400       LET n=-term
1410    CASE "+"
1420       LET i=i+1
1430       CALL skip
1440       LET n=term
1450    CASE ELSE
1460       LET n=term
1470    END SELECT
1480    DO WHILE s$(i:i)="+" OR s$(i:i)="-"
1490       LET op$=s$(i:i)
1500       LET i=i+1
1510       CALL skip
1520       IF op$="+" THEN LET n=n+term ELSE LET n=n-term
1530    LOOP
1540    LET expression =n
1550    CALL skip
1560 END FUNCTION
1570 !
1580 EXTERNAL FUNCTION term
1590    DECLARE NUMERIC n
1600    DECLARE STRING op$
1610    LET n=factor
1620    DO WHILE s$(i:i)="*" OR s$(i:i)="/"
1630       LET op$=s$(i:i)
1640       LET i=i+1
1650       CALL skip
1660       IF op$="*" THEN LET n=n*factor ELSE LET n=n/factor
1670    LOOP
1680    LET term=n
1690 END FUNCTION
1700 !
1710 EXTERNAL FUNCTION factor
1720    DECLARE NUMERIC n
1730    LET n=primary
1740    DO WHILE s$(i:i)="^"
1750       LET i=i+1
1760       CALL skip
1770       LET n=n^primary
1780    LOOP
1790    LET factor=n
1800 END FUNCTION
1810 !
1820 EXTERNAL FUNCTION primary
1830    IF s$(i:i)>="0" AND s$(i:i)<="9" THEN
1840       LET  primary=NUMERIC
1850    ELSEIF s$(i:i+1)="PI" THEN
1860       LET i=i+2
1870       CALL SKIP
1880       LET primary=PI
1890    ELSE
1900       IF s$(i:i)="(" THEN
1910          LET i=i+1
1920          CALL SKIP
1930          LET  primary=expression
1940       ELSEIF s$(i:i+3)="SIN(" THEN
1950          LET i=i+4
1960          CALL SKIP
1970          LET Primary=SIN(expression)
1980       ELSEIF s$(i:i+3)="COS(" THEN
1990          LET i=i+4
2000          CALL SKIP
2010          LET Primary=COS(expression)
2020       ELSEIF s$(i:i+3)="TAN(" THEN
2030          LET i=i+4
2040          CALL SKIP
2050          LET Primary=TAN(expression)
2060       ELSEIF s$(i:i+3)="LOG(" THEN
2070          LET i=i+4
2080          CALL SKIP
2090          LET Primary=LOG(expression)
2100       ELSEIF s$(i:i+3)="EXP(" THEN
2110          LET i=i+4
2120          CALL SKIP
2130          LET Primary=EXP(expression)
2140       ELSEIF s$(i:i+3)="SQR(" THEN
2150          LET i=i+4
2160          CALL SKIP
2170          LET Primary=SQR(expression)
2180       ELSEIF s$(i:i+3)="INT(" THEN
2190          LET i=i+4
2200          CALL SKIP
2210          LET Primary=INT(expression)
2220       ELSEIF s$(i:i+3)="ABS(" THEN
2230          LET i=i+4
2240          CALL SKIP
2250          LET Primary=ABS(expression)
2260       ELSE
2270          PRINT "Syntax error"
2280          STOP
2290       END IF
2300       IF s$(i:i)=")" THEN
2310          LET i=i+1
2320          CALL skip
2330       ELSE
2340          PRINT "Syntax error"
2350          STOP
2360       END IF
2370    END IF
2380 END FUNCTION
2390 !
2400 EXTERNAL FUNCTION numeric
2410    DECLARE NUMERIC i0
2420    CALL skip
2430    LET i0=i
2440    DO WHILE s$(i:i)>="0" AND s$(i:i)<="9"
2450       LET i=i+1
2460    LOOP
2470    IF s$(i:i)="." THEN LET i=i+1
2480    DO WHILE s$(i:i)>="0" AND s$(i:i)<="9"
2490       LET i=i+1
2500    LOOP
2510    LET numeric=VAL(s$(i0:i-1))
2520    CALL skip
2530 END FUNCTION
2540 !
2550 END MODULE
 		 

Re: FOUR 　　FOURS

 投稿者：山中和義  投稿日：2011年 6月 6日(月)16時12分59秒
  > No.1576[元記事へ]

永野護さんへのお返事です。

別解

括弧がなければ、次のように処理できます。小町算でも可能です。


!Four Foursで数式処理を学ぶ

!演算子が＋、－、＊、／のみとする。
!４つの４の数字を並べて、その間に演算子を埋めればよい。
!　op1 ４ op2 ４ op3 ４ op4 ４
!例
!　    ４     ４  +  ４  -　４
!これは、44+4-4を意味する。

DIM OP(4) !演算子　※0は空白、1は加算、2は減算、3は乗算、4は除算　※←←←←

LET C=0 !解答数

LET p=5
FOR i=0 TO 3*p^3-1 !５進カウンタ　※１の前は空白、＋、－　※←←←←
   MAT OP=ZER
   LET a=i
   LET k=4 !　※←←←←
   DO WHILE a>0
      LET OP(k)=MOD(a,p)
      LET a=INT(a/p)
      LET k=k-1
   LOOP
   !　4444
   !　444+4
   !　444-4
   !　444*4
   !　444/4
   !　44+44
   !　44+4+4
   !　44+4-4
   !　44+4*4
   !　44+4/4
   !　44-44
   !　　：
   !を計算する

   LET s=0 !式の値
   LET f=0 !乗算、除算の有無　※0:なし、3,4:あり（１つ前の演算子）
   LET v=0 !数値
   LET cSGN=1 !符号
   FOR k=1 TO 4 !演算子の優先順位を考慮して、左から順に式を評価する　※←←←←

      SELECT CASE OP(k)
      CASE 1,2 !＋、－
         IF f>0 THEN !途中に乗算、除算がある
            SELECT CASE f !因子の計算（終端）
            CASE 3
               LET w=w*v
            CASE 4
               LET w=w/v
            CASE ELSE
            END SELECT
            LET v=w !計算結果
            LET f=0 !リセット
         END IF
         LET s=s+cSGN*v !加算
         LET v=4 !続く数値の先頭　※←←←←
         IF OP(k)=1 THEN LET cSGN=1 ELSE LET cSGN=-1 !項の符号

      CASE 3,4 !＊、／
         SELECT CASE f !因子の計算
         CASE 3
            LET w=w*v
         CASE 4
            LET w=w/v
         CASE ELSE
            LET w=v !先頭
         END SELECT
         LET f=OP(k) !演算子を記録する
         LET v=4 !続く数値の先頭　※←←←←

      CASE ELSE
         LET v=v*10+4 !10進表記数　※←←←←
      END SELECT

   NEXT k

   IF f>0 THEN !途中に乗算、除算がある
      SELECT CASE f
      CASE 3
         LET w=w*v
      CASE 4
         LET w=w/v
      CASE ELSE
      END SELECT
      LET v=w
      LET f=0
   END IF
   LET s=s+cSGN*v


   !IF s=100 THEN !成立する　※←←←←
   LET C=C+1
   PRINT "No.";C

   !!!MAT PRINT OP; !debug

   FOR k=1 TO 4 !復号化する　※←←←←
      IF OP(k)>0 THEN PRINT mid$("+-*/",OP(k),1);
      PRINT STR$(4); !　※←←←←
   NEXT k
   PRINT "=";s
   !END IF !　※←←←←

NEXT i

END
 		 

Re: FOUR 　　FOURS

 投稿者：山中和義  投稿日：2011年 6月 6日(月)17時13分27秒
  > No.1576[元記事へ]

永野護さんへのお返事です。

別解２　プログラムを生成する

次のような式の全パターンをPRINT文の羅列で表示します。
表示されたものをあらためてプログラムとして実行します。

  PRINT "4444="; 4444
  PRINT "444+4="; 444+4
  PRINT "444-4="; 444-4
  PRINT "444*4="; 444*4
  PRINT "444/4="; 444/4
  PRINT "44+44="; 44+44
  PRINT "44+4+4="; 44+4+4
  PRINT "44+4-4="; 44+4-4
  PRINT "44+4*4="; 44+4*4
  PRINT "44+4/4="; 44+4/4
  PRINT "44-44="; 44-44
  PRINT "44-4+4="; 44-4+4
          ：
          ：
  END

サンプル

LET OP$="+-*/" !演算子
FOR a=0 TO 2
   FOR b=0 TO 4
      FOR c=0 TO 4
         FOR d=0 TO 4
            LET s$=OP$(a:a)&"4"&OP$(b:b)&"4"&OP$(c:c)&"4"&OP$(d:d)&"4"
            PRINT "PRINT """; s$; "=""; "; s$
         NEXT d
      NEXT c
   NEXT b
NEXT a
PRINT "END"
END
 		 
 

戻る