BASIC詰将棋局面生成プログラム試作品

!  Read me/このプログラムを使用する前に
!  This program was made by Ephemeral_shade.
!  This is for automatic generation  of checkerboard for Shogi problem.
!  Some comments by me that have been left in this program in some places are may goodness for you.
!  And that is the line that starts with an exclamation mark like this.
!  Perhaps,this program has some bug and so on.
!  If it's true,please allow me.
!  Thanks.
!  このプログラムはEphemeral_shadeによって作成されました。
!  これは詰将棋用局面を自動で生成するものです。(但、完成品が出力されるのではなく、このプログラムでは詰むかどうかすらわからない局面の生成のみ行うことに注意してください。)
!  出来るだけプログラムの中にコメントを残しました。
!  これらの行のように、エクスクラメーションマークで始まる行がコメントの文です。
!  恐らく、このプログラム未知のバグを持っているでしょう。
!  もしそうでも許してください。
!  プログラムの改良などは歓迎です。よろしければ作者にも更新内容を共有して頂けると飛んで喜びます。
!  はじめに
!  棋譜出力用タイプは.csaを用いている。
!  解答用プログラム迄はこの形式のままで進み、詰将棋的価値の評価の際には.KI2を用いる。
!  色々な問題で完全自動ではなくなってしまうかもしれない。

!  ～～  プログラム本文  ～～
!宣言、変数の設定
OPTION BASE 0
CLEAR
LET seed=INT(TIME)
RANDOMIZE seed
DIM ZAHYOU$(12,12)
DIM NIFU(19)

SUB main

! CALL ASKrnd
   CALL askrnd
   CALL hensuutyousei
   FOR K=1 TO kyokumensuu
      CALL syokika
      CALL komasuu
      CALL seisei
      CALL motigoma
      CALL syuturyoku
      LET motigoma$=""
      FOR g=1 TO 18
         LET NIFU(g)=0
      NEXT g
      !PRINT k;"/";kyokumensuu
   NEXT K
   PRINT "完了しました。"

END SUB


!駒の種類を選ぶときには乱数を用いるが、飛び道具の使用の有無の設定から、選ばれる可能性のある駒の種類をここで決めている。
!1～5が小駒で、6～8が飛び道具に相当する。
DIM koma(9)

SUB seisei
!乱数を用いて座標と置く駒を決める。

!玉方の配置には二歩と行き場のない駒に気をつけること
!攻方の配置にはそれに加えて初期配置で王手がかかるような配置をしてもダメ。

!まずは玉方の玉を配置する。
!xjougenとyjougenで使えるマス目に上限があることに注意。
!玉の配置。なお、王手検査のため、このx,y座標は保持しておく。
!LET gyx=INT(RND*xjougen+1)
!LET gyy=INT(RND*yjougen+1)
   LET gyx=INT(RND*2)+1
   LET gyy=INT(RND*2)+1
   LET ZAHYOU$(gyx,gyy)="-OU"

   FOR i=1 TO sentekoma
      CALL komasyurui
      CALL zahyournd

      LET SENGO$="+"
      CALL komasyurui

      CALL zahyournd
      CALL haichi

   NEXT i

   FOR i=1 TO gotekoma
      LET SENGO$="-"
      CALL komasyurui
      CALL zahyournd
      CALL haichi
      LET koma$=" * "
   NEXT i

END SUB


SUB komasyurui

   LET kmrnd=INT(RND*kind)+1
   !LET kmrnd=1

   IF kmrnd=1 AND koma(1)>=1 THEN LET koma$=SENGO$&"FU"
   IF kmrnd=2 AND koma(2)>=1 THEN LET koma$=SENGO$&"KE"
   IF kmrnd=3 AND koma(3)>=1 THEN LET koma$=SENGO$&"GI"
   IF kmrnd=4 AND koma(4)>=1 THEN LET koma$=SENGO$&"KI"
   IF kmrnd=5 AND koma(1)>=1 THEN LET koma$=SENGO$&"TO"
   IF kmrnd=6 AND koma(6)>=1 THEN LET koma$=SENGO$&"KY"
   IF kmrnd=7 AND koma(7)>=1 THEN
      LET narigoma=INT(RND*2)
      IF narigoma=0 THEN LET koma$=SENGO$&"KA" ELSE LET koma$=sengo$&"UM"
   END IF
   IF kmrnd=8 AND koma(8)>=1 THEN
      LET narigoma=INT(RND*2)
      IF narigoma=0 THEN LET koma$=SENGO$&"HI" ELSE LET koma$=SENGO$&"RY"
   END IF

END SUB


SUB zahyournd
   LET komax=INT(RND*xjougen)+1
   LET komay=INT(RND*yjougen)+1
END SUB


SUB haichi

   IF SENGO$="-" THEN
      LET outeok=1
      CALL ikibanonai
      CALL nifu
      IF outeok=1 THEN
         IF ZAHYOU$(komax,komay)=" * " THEN
            LET ZAHYOU$(komax,komay)=koma$
            IF koma$="-FU" THEN LET NIFU(komax+9)=1
            LET koma(komarnd)=koma(komarnd)-1
         ELSE
            IF ZAHYOU$(komax,komay+1)=" * " THEN
               LET ZAHYOU$(komax,komay+1)=koma$
               IF koma$="-FU" THEN LET NIFU(komax+9)=1
               LET koma(komarnd)=koma(komarnd)-1
            END IF
         END IF
      END IF
   END IF

   IF SENGO$="+" then
      IF ZAHYOU$(komax,komay)=" * " THEN
         CALL outekensa
         IF outeok=1 THEN
            LET ZAHYOU$(komax,komay)=koma$
            IF koma$="+FU" THEN LET NIFU(komax)=1
            LET koma(komarnd)=koma(komarnd)-1
         END IF
      END IF
   END if


   ! PRINT koma$;komax,komay
END SUB





SUB outekensa
   LET outeok=1


   CALL ikibanonai
   CALL nifu

   ! PRINT koma$;

   IF outeok=1 THEN
      IF koma$="+FU" AND (komax=gyx AND komay+1=gyy) THEN LET outeok=0
      IF koma$="+KE" THEN
         IF  ((ZAHYOU$(komax+1,komay-2)="-OU") OR (ZAHYOU$(komax-1,komay-2)="-OU")) THEN LET outeok=0
      END IF
      IF koma$="+GI" THEN
         IF ((ZAHYOU$(komax+1,komay-1)="-OU") OR (ZAHYOU$(komax-1,komay-1)="-OU") OR (ZAHYOU$(komax,komay-1)="-OU") OR (ZAHYOU$(komax-1,komay+1)="-OU") OR (ZAHYOU$(komax+1,komay+1)="-OU"))  THEN LET outeok=0
      END IF
      IF koma$="+KI" OR koma$="+TO" THEN
         IF ((ZAHYOU$(komax+1,komay-1)="-OU") OR (ZAHYOU$(komax-1,komay-1)="-OU") OR (ZAHYOU$(komax,komay-1)="-OU") OR (ZAHYOU$(komax+1,komay)="-OU") OR (ZAHYOU$(komax-1,komay)="-OU") OR (ZAHYOU$(komax,komay+1)="-OU")) THEN LET outeok=0
      END if

      IF koma$="+KY" AND komax=gyy AND komay<gyy THEN
         IF komay+1=gyy THEN LET outeok=0
      else
         FOR cky=komay+1 TO gyy STEP -1
            IF ZAHYOU$(komax,cky)="-OU" THEN LET outeok=0
            IF NOT(ZAHYOU$(komax,cky)=" * ") THEN LET cky=gyy
         NEXT cky
         ! IF outeok=0 THEN PRINT "not ok";k;komax;komay;koma$

      END if
   END if




END SUB

SUB ikibanonai

   IF (koma$="+FU" OR koma$="+KE" OR koma$="+KY") AND komay=1 THEN LET outeok=0
   IF (koma$="-FU" OR koma$="-KE" OR koma$="-KY") AND komay=9 THEN LET outeok=0
   IF koma$="+KE" AND komay=2 THEN LET outeok=0
   IF koma$="-KE" AND komay=8 THEN LET outeok=0

END SUB

SUB nifu
   IF koma$="-FU" AND NIFU(komax+9)=1 THEN LET outeok=0
   IF koma$="+FU" AND NIFU(komax)=1 THEN LET outeok=0
END SUB

SUB hensuutyousei
   LET xjougen=INT(xjougen)
   LET yjougen=INT(yjougen)
   LET sentekoma=INT(sentekoma)
   LET gotekoma=INT(gotekoma)
   LET motigoma=INT(motigoma)
   LET kyokumensuu=INT(kyokumensuu)
   LET renban=INT(renban)
   IF tobidougu=0 THEN LET kind=5 ELSE  LET kind=8
END SUB

SUB komasuu
   LET koma(1)=18
   FOR p=2 TO 6
      LET koma(p)=4
   NEXT p
   LET koma(5)=0
   LET koma(7)=2
   LET koma(8)=2
END SUB

SUB syousaisettei
!詳細設定用入力部
END SUB

SUB motigoma
   RANDOMIZE
   FOR r=0 TO motigoma

   !割合をほんの少し銀に偏らせています。
      LET m=INT(RND*kind)+1

      IF m=1 AND koma(1)>=1 THEN LET motigoma$=motigoma$&"00FU"
      IF m=2 AND koma(2)>=1 THEN LET motigoma$=motigoma$&"00KE"
      IF m=3 OR m=5 AND koma(3)>=1 THEN LET motigoma$=motigoma$&"00GI"
      IF m=4 AND koma(4)>=1 THEN LET motigoma$=motigoma$&"00KI"
      IF m=6 AND koma(6)>=1 THEN LET motigoma$=motigoma$&"00KY"
      IF m=6 AND koma(6)>=1 THEN LET motigoma$=motigoma$&"00KY"
      IF m=6 AND koma(6)>=1 THEN LET motigoma$=motigoma$&"00KY"
      IF m=7 AND koma(7)>=1 THEN LET motigoma$=motigoma$&"00KA"
      IF m=8 AND koma(8)>=1 THEN LET motigoma$=motigoma$&"00HI"
      LET koma(m)=koma(m)-1
   NEXT r
END SUB

SUB syuturyoku

   LET f$=STR$(f)
   LET a$="C:\Program Files (x86)\Kakinoki\KShogi9\"&filename$&f$&".csa"
   OPEN #2:NAME a$
   ERASE #2
   PRINT #2 : "V2.2"
   PRINT #2
   FOR y=1 TO 9
      FOR x=9 TO 1 STEP -1
         IF x=9 THEN PRINT #2 : "P"&STR$(y);
         IF x=1 THEN PRINT #2 : ZAHYOU$(x,y) ELSE PRINT #2 : ZAHYOU$(x,y);
      NEXT x
   NEXT y
   PRINT #2 : "P+";motigoma$
   PRINT #2 : "P-";
   FOR i=1 TO koma(1)
      PRINT #2 : "00FU";
   NEXT i
   FOR i=1 TO koma(2)
      PRINT #2 : "00KE";
   NEXT i
   FOR i=1 TO koma(3)
      PRINT #2 : "00GI";
   NEXT i
   FOR i=1 TO koma(4)
      PRINT #2 : "00KI";
   NEXT i
   FOR i=1 TO koma(6)
      PRINT #2 : "00KY";
   NEXT i
   FOR i=1 TO koma(7)
      PRINT #2 : "00KA";
   NEXT i
   FOR i=1 TO koma(8)
      PRINT #2 : "00HI";
   NEXT i
   CLOSE #2
   LET f=f+1

END SUB

SUB askrnd
   LET xjougen=6 !INT(RND*9)+1
   LET yjougen=3 !INT(RND*9)+1
   LET sentekoma=12 !INT(RND*10)+1
   LET gotekoma=6 !INT(RND*10)+1
   LET motigoma=5 !INT(RND*10)+1
   LET tobidougu=0 !INT(RND*2)
   LET kyokumensuu=100
   LET renban=INT(renban)
END SUB
SUB banmenkakunin
   FOR y=1 TO 9
      FOR x=9 TO 1 STEP -1
         IF x=1 THEN PRINT ZAHYOU$(x,y) ELSE PRINT  ZAHYOU$(x,y)
      NEXT x
   NEXT y
END SUB


!出力用座標値の初期化用ルーチン
SUB syokika  !このルーチン内のfor文では、x=1の時y=1～9に空白を意味する" * "を代入している。同様にx=2の時、3の時...として81マス分代入している。
   FOR x=1 TO 9
      FOR y=1 TO 9
         LET ZAHYOU$(x,y)=" * "
      NEXT y
   NEXT x
END sub

!局面生成用初期設定をユーザーに尋ねるルーチン
SUB ASK
   PRINT "小数点以下の入力は切り捨てられます。"
   PRINT "また、条件を満たしていない不正な入力は無視され、再入力が出来ます。"
   PRINT
   PRINT
   INPUT PROMPT "盤面は縦に何マス使う?(3～9)  ":xjougen
   DO UNTIL xjougen>=3 AND xjougen<=9
      PRINT "不正な入力です。入力する数値を確認してもう一度入力してください。"
      PRINT
      INPUT PROMPT "盤面は縦に何マス使う?(3～9)  ":xjougen
   LOOP
   PRINT "入力完了"
   PRINT
   INPUT PROMPT "盤面は横に何マス使う?(3～9)  ":yjougen
   DO UNTIL yjougen>=3 AND yjougen<=9
      PRINT "不正な入力です。入力する数値を確認してもう一度入力してください。"
      PRINT
      INPUT PROMPT "盤面は縦に何マス使う?(3～9)  ":yjougen
   LOOP
   PRINT "入力完了"
   PRINT
   !LET komajougen=INT(xjougen)*INT(yjougen)/2
   !使うマス目に合わせて使える駒数の上限を決めようかとも思ったんだけど、実装がフクザツなので後回し。後々実装します。
   INPUT  PROMPT "盤上の攻方の枚数?(1～10)  ":sentekoma
   DO UNTIL sentekoma<=10 AND sentekoma>0
      PRINT "不正な入力です。入力する数値を確認してもう一度入力してください。"
      PRINT
      INPUT  PROMPT "盤上の攻方の枚数?(1～10)  ":sentekoma
   LOOP
   PRINT "入力完了"
   PRINT
   INPUT  PROMPT "盤上の王を含めない玉方の枚数?(1～10)  ":gotekoma
   DO  UNTIL gotekoma<=10 AND gotekoma>0
      PRINT "不正な入力です。入力する数値を確認してもう一度入力してください。"
      PRINT
      INPUT  PROMPT "盤上の玉方の枚数?(1～10)  ":gotekoma
   LOOP
   PRINT "入力完了"
   PRINT
   INPUT  PROMPT "攻方の持駒の枚数?(0～10)  (1～10の範囲でランダム=99)":motigoma
   DO UNTIL motigoma<=10 AND motigoma>=0 OR motigoma=99
      PRINT "不正な入力です。入力する数値を確認してもう一度入力してください。"
      PRINT
      INPUT  PROMPT "攻方の持駒の枚数?(0～10) (1～10の範囲でランダム=99) ":motigoma
   LOOP
   PRINT "入力完了"
   PRINT
   INPUT PROMPT "飛道具(飛角香)を使う?(Y=1/N=0)  ":tobidougu
   DO UNTIL tobidougu=1 OR tobidougu=0
      PRINT "不正な入力です。入力する数値を確認してもう一度入力してください。"
      PRINT
      INPUT PROMPT "飛道具(飛角香)を使う?(Y=1/N=0)  ":tobidougu
   LOOP
   PRINT "入力完了"
   PRINT
   INPUT PROMPT "局面はいくつ生成する?(1～10000000)":kyokumensuu
   DO UNTIL kyokumensuu>=1 AND kyokumensuu<10000000
      PRINT "不正な入力です。入力する数値を確認してもう一度入力してください。"
      PRINT
      INPUT PROMPT "局面はいくつ生成する?(1～10000000)":kyokumensuu
   LOOP
   PRINT "入力完了"
   PRINT
   ! PRINT "注意(半角英数字、アンダーバーのみ使用してください。空白やピリオドなどは不具合の原因となり、局面が生成できない恐れがあります。)"
   !  INPUT PROMPT"作成するファイル名は?":filename$
   PRINT "入力完了"
   PRINT
   !  INPUT PROMPT"ファイル連番の初期値は?(0～)":renban
   PRINT "入力完了"
   PRINT
   PRINT "設定"
   print "使用する広さ";INT(xjougen);"*";INT(yjougen)
   PRINT "盤上攻方駒";INT(sentekoma)
   PRINT "玉方駒数";INT(gotekoma)
   PRINT "攻方持駒枚数";INT(motigoma)
   PRINT "飛道具有無";tobidougu
   PRINT "生成局面数";kyokumensuu
   PRINT "連番ファイル名";filename$
   PRINT "連番初期値";renban
   PRINT
   INPUT PROMPT "この設定で生成を始めても良いですか?(Y=1/N=0/詳細設定=524287)":kakunin
   DO UNTIL kakunin=0 OR kakunin=1 OR kakunin=524287
      PRINT "不正な入力です。入力する数値を確認してもう一度入力してください。"
      PRINT
      INPUT PROMPT "この設定で生成を始めても良いですか?(Y=1/N=0/詳細設定=524287)":kakunin
   LOOP
   IF kakunin=1 THEN
      PRINT "局面生成を開始します。"
   ELSE
      CALL ASK
   END IF

END SUB


CALL main
!CALL yodumekensa
SUB yodumekensa
   FOR f=renban TO kyokumensuu
      LET f$=STR$(f)
      LET a$="F:\BASIC局面生成用プログラム\output\"&filename$&f$&".csa"
      PRINT a$
      ! execute "F:\BASIC局面生成用プログラム\output\KShogi9\KShogi9.exe" WITH (a$&" /M2 /Z")
   NEXT f

END sub


END