情報処理概論
第１４回

情報基盤研究開発センター

演習２

谷本 輝夫

1

今回の内容

四目並べ：Drop ルーチン（例）

四目並べ：勝敗判定

2

先週の演習の解答例


四目並べの手の入力


入力のチェック

列が一杯かどうか？

盤の更新

1 2 3 4 5 6 7[ ][ ][ ][ ][ ][ ][ ][ ][ ][ ][ ][ ][ ][ ][ ][ ][ ][ ][ ][ ][ ][ ][ ][*][ ][ ][ ][ ][ ][ ][o][*][ ][ ][ ][*][*][o][o][o][*][ ]o : Drop where? (0 = Exit) 2
1 2 3 4 5 6 7[ ][ ][ ][ ][ ][ ][ ][ ][ ][ ][ ][ ][ ][ ][ ][ ][ ][ ][ ][ ][ ][ ][ ][*][ ][ ][ ][ ][ ][o][o][*][ ][ ][ ][*][*][o][o][o][*][]
3* : Drop where? (0 = Exit)

入力のチェック


入力された値が


０の場合



１～７以外



１～７の場合




終了

→→再入力

玉が落とせるか？


落とせなかった → 再入力



落とせた → 盤面の更新

再入力ってことは？
ループが必要

ループを抜ける条件は？
０の場合？



玉が落とせる場合

4

入力のチェック

do while (再入力なら)read x
if (x == 0) then

入力された値が０の場合



１～７以外



１～７の場合




終了

終了

→→再入力

玉が落とせるか？


落とせなかった → 再入力



落とせた → 盤面の更新

再入力ってことは？


ループが必要

ループを抜ける条件は？
０の場合？



玉が落とせる場合

end ifif (x < 1 .or. x > 7) then
範囲外の表示再入力
else if (玉が落とせない？) then
落とせない旨の表示
再入力

else
盤面の更新
ループを抜ける

end ifend do5入力のチェック
1.

フラグ（センチネル、番兵）を用いる


事前に done = 0



玉を落とせたら done=1



done==1なら、ループを抜ける

done = 0
do while (done == 0)
read x
if (x == 0) thenstop
end ifif (x < 1 .or. x > 7) then
範囲外の表示再入力
else if (玉が落とせない？) then
落とせない旨の表示
再入力

else
盤面の更新

done = 1
end ifend do6

入力のチェック
1.

2.

フラグ（センチネル、番兵）を用いる


事前に done = 0



玉を落とせたら done=1



done==1なら、ループを抜ける

exit, cycleなどを用いる

exitはループを抜けるcycleはループの頭に戻る

doread x
if (x == 0) thenstop
end ifif (x < 1 .or. x > 7) then
範囲外の表示cycle
else if (玉が落とせない？) then
落とせない旨の表示
cycle

else
盤面の更新

end ifend do7

入力のチェック
1.

2.

3.

フラグ（センチネル、番兵）を用いる


事前に done = 0



玉を落とせたら done=1



done==1なら、ループを抜ける

exit, cycleなどを用いる

exitはループを抜けるcycleはループの頭に戻る

goto文を用いる（非推奨）

任意の場所にジャンププログラムが構造化しにくい

done = 0
do while (done == 0)
read x
if (x == 0) thenstop
end ifif (x < 1 .or. x > 7) then
範囲外の表示goto 100
else if (玉が落とせない？) then
落とせない旨の表示
goto 100

else
盤面の更新

done = 1
end ifend do100 write…

8

入力のチェック : 球が落とせない？


指定された列の一番上が空かどうか？

if (board(x, n) /= ' ') thenwrite(*, *) ' This column is full!!'
x列目n6
5
4
3
2
1

[ ][ ][o][*][ ][ ][ ][ ][*][o][*][ ][ ][ ][ ][o][*][o][ ][ ][ ][ ][*][o][*][ ][ ][ ][ ][*][o][o][ ][ ][ ][*][o][*][o][*][ ][ ]1 2 3 4 5 6 7m9

盤面の更新

指定された列の空白な要素のうち一番下の要素に新しい玉を追加
例）x列目を上から下へ調べてゆき、「一つ下の要素が空白以外」である要素が見つかったら、そこに新しい玉を配置[ ][ ][o][*][ ][ ][ ]board(x, 5)[ ][*][o][*][ ][ ][ ]board(x, 4)[ ][o][*][o][ ][ ][ ][ ][*][o][*][*][ ][ ]board(x, 3)[ ][*][o][o][o][ ][ ]board(x, 3) が空白でないので[*][o][*][o][*][ ][ ]board(x, 4) に新しい玉を配置

m10

盤面の更新

指定された列の空白な要素のうち一番下の要素に新しい玉を追加
y = 例）x列目を上から下へ調べてゆき、「一つ下の要素が空白
ndo while((y > 1) .and. (board(x, y-1) == ' '))以外」である要素が見つかったら、そこに新しい玉を配置
y = y - 1
end doboard(x, y) = mark[ ][ ][o][*][ ][ ][ ]board(x, 5)[ ][*][o][*][ ][ ][ ]board(x, 4)[ ][o][*][o][ ][ ][ ][ ][*][o][*][*][ ][ ]board(x, 3)[ ][*][o][o][o][ ][ ]board(x, 3) が空白でないので[*][o][*][o][*][ ][ ]board(x, 4) に新しい玉を配置

m11

サブルーチン drop
subroutine drop(m, n, board, side)
implicit none
integer, intent(IN) :: m, n, sidecharacter(len=1), dimension(m, n), intent(INOUT) :: board
integer :: x, y, done
character(len=1) :: markselect case (side)case (1)mark = '*'case (2)mark = 'o'end selectdone = 0
do while (done == 0)
write(*, '(a, a)', advance='NO') &mark, ' : Drop where? (0 = Exit) 'read(*, *) x

12

サブルーチン dropif (x == 0) thenstop
else if (x > m .or. x < 1) thenwrite(*, *) ' Out of range!!'else if (board(x, n) /= ' ') thenwrite(*, *) ' This column is full!!'
else
y = n
do while ((y > 1) .and. (board(x, y-1) == ' '))y = y - 1
end doboard(x, y) = markdone = 1
end ifend doend subroutine drop13

サブルーチン drop (別の方法)
if (x == 0) thenstopelse if (x > m .or. x < 1) thenwrite(*, *) ' Out of range!!'
else
y = 1
do while ((y <= n) .and. (board(x, y) /= ' '))y = y + 1
end doif (y <= n) thenboard(x, y) = markdone = 1
elsewrite(*, *) ' This column is full!!'end if
指定された列を下から上に調べてゆき、
end if14
空白の要素が見つかったらそこに新しいend do
玉を配置するend subroutine今回の内容四目並べ：Drop ルーチン（例）四目並べ：勝敗判定

15勝敗判定

縦、横、斜めに、同じ玉が4つ並ぶとその玉のプレーヤの勝ち

盤面の全ての縦、横、斜めをチェック！？


それでもO.K.

（基本）

新しく追加された玉を含む列だけでもO.K.

（発展）



例えば、(3, 2) に玉が追加された

横：(i, 2) iを１からmまで変化させて、並びを数える

縦：(3, j) jを１からnまで変化させて、並びを数える



斜めは？

16

メインプログラム
program four
implicit none
integer, parameter :: m=7, n=6
character(len=1), dimension(m, n) :: board
integer :: step, sideboard = ' 'call show(m, n, board)
do step = 1, m*n/2
do side =1, 2
call drop(m, n, board, side)call show(m, n, board)call check(m, n, board, side)
end doend dostop
end program17

勝敗判定サブルーチン（枠組み）
subroutine check(m, n, board, side)
implicit none
character(1), dimension(m, n), intent(INOUT) :: board
integer, intent(IN) :: m, n, side
integer :: i, j, countcharacter(1), dimension(2) :: ball = (/'*', 'o'/)!横!縦!右上がり!右下がり

endsubroutine check18

ボールが４つ並んでいるか？


連続している数を数えれば良い

横に並んでいる場合を考える



まずは２行目だけcount = 0
do i =1, mi 列目
if (board(2, i) == ball(side)) thencount = count + 1if (count == 4) then
6 [ ][ ][o][*][ ][ ][ ]write (*,*) "won!"
5 [ ][*][o][*][ ][ ][ ]stop
4 [ ][o][*][o][ ][ ][ ]end if
2行目
else
3 [ ][*][o][*][ ][ ][ ]count = 0
2 [ ][o][o][o][o][ ][ ]end if
1 [*][o][*][o][*][][ ]19
end do

1

2

3

4

5

67

ボールが４つ並んでいるか？


次に１行目から６行目まで全部チェックするには？

count = 0
do i =1, mif (board(2, i) == ball(side)) thencount = count + 1i 列目if (count == 4) thenwrite (*,*) "won!"stop
6 [ ][ ][o][*][ ][ ][ ]end if
5 [ ][*][o][*][ ][ ][ ]else
4 [ ][o][*][o][ ][ ][ ]2行目
count = 0
3 [ ][*][o][*][ ][ ][ ]end if
2 [ ][o][o][o][o][ ][ ]end do1[*][o][*][o][*][ ][ ]1 2 3 4 5 6 720

縦はどう考える？


まずは３列目を考える…

横とほぼ同じプログラム



次にそれを、1列目から７列目まで順番にチェックj ←

654
3
2
1

[ ][ ][o][*][ ][ ][ ][ ][*][o][*][ ][ ][ ][ ][o][*][o][ ][ ][ ][ ][*][o][*][ ][ ][ ][ ][o][o][o][o][ ][ ][*][o][*][o][*][ ][ ]1 2 3 4 5 6 7
21→ i

斜め（右上がり）はどう考える？
かなりメンドクサイ…


斜めに４マス以上ある部分だけチェックする

iを１増やす時に、jも１増やす



配列範囲外を見ようとするとエラー

→j

6543
2
1

[ ][ ][o][*][ ][ ][ ][ ][ ][*][o][*][ ][ ][ ][ ][ ][ ][o][*][o][ ][ ][ ][ ][ ][ ][ ][*][o][*][ ][ ][ ][ ][ ][ ][ ][ ][o][o][o][o][ ][ ][ ][ ][ ][ ][ ][*][o][*][o][*][ ][ ]22-4 -3 -2 -1 0 1 2 3 4 5 6 7→ i

斜め（右下がり）はどう考える？
こちらも、かなりメンドクサイ…


同じく斜めに４マス以上ある部分だけチェックする

iを１増やす時に、jは１減らす



配列範囲外を見ようとするとエラー

→j

6
5
4
3
2
1

[ ][ ][ ][ ][ ][ ][ ][o][*][ ][ ][ ][ ][ ][ ][ ][ ][*][o][*][ ][ ][ ][ ][ ][ ][ ][o][*][o][ ][ ][ ][ ][ ][ ][*][o][*][ ][ ][ ][ ][ ][o][o][o][o][ ][ ][*][o][*][o][*][ ][ ]23-4 -3 -2 -1 0 1 2 3 4 5 6 7→ i

勝敗判定サブルーチン（別タイプ）


並びをチェックするのは、dropしたボールの周辺だけで良い！
→ dropしたボールの情報を受け取る！

→ dropサブルーチンから？

メインルーチンから？

subroutine check(x, y, m, n, board, side)
implicit none
character(1), dimension(m, n), intent(INOUT) :: board
integer, intent(IN) :: x, y, m, n, side
integer :: i, j, countcharacter(1), dimension(2) :: ball = (/'*', 'o'/)!横（縦の位置は y に固定して良い）!縦（横の位置は x に固定して良い）
!右上がり
!右下がり
endsubroutine check24