Help us understand the problem. What is going on with this article?

# elmでぷよぷよ

More than 3 years have passed since last update.

elmでぷよぷよの消去アルゴリズムを書こうとしたらめんどくさかったのでメモ。

wikipedia

ぷよが4個以上くっつくと消滅し得点となる。
ぷよの消滅により上にあったぷよが落下する。このとき再びぷよが4個以上くっつくと消滅し、連鎖が起きる。

とのこと。まずは下準備。

```module PuyoPuyo exposing (..)

import Array exposing (Array)
import Maybe

type alias Field =
Array (Array (Maybe Color))

type alias Puyo =
Field

type alias PuyoPuyo =
{ field : Field
, puyo : Puyo
}

type Color
= Red
| Blue
| Green
| Yellow

init : PuyoPuyo
init =
{ field = Array.repeat 20 <| Array.repeat 10 Nothing
, puyo = Array.repeat 2 <| Array.repeat 2 Nothing
}

example : PuyoPuyo
example =
{ puyo = Array.repeat 2 <| Array.repeat 2 (Just Blue)
, field =
Array.fromList
[ Array.fromList [ Nothing, Nothing, Nothing, Nothing, Nothing, Just Red, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Just Blue, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Just Red, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Just Blue, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Just Yellow, Just Green, Just Red, Just Yellow, Just Green, Nothing, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Just Green, Just Red, Just Yellow, Just Green, Just Red, Nothing, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Just Yellow, Just Green, Just Red, Just Yellow, Just Green, Just Red, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Just Yellow, Just Green, Just Red, Just Yellow, Just Green, Just Red, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Just Yellow, Just Blue, Just Blue, Just Green, Just Blue, Just Green, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Just Blue, Just Green, Just Yellow, Just Red, Just Green, Just Green, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Just Red, Just Blue, Just Green, Just Yellow, Just Red, Just Blue, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Just Red, Just Blue, Just Green, Just Yellow, Just Red, Just Blue, Nothing, Nothing, Nothing, Nothing ]
, Array.fromList [ Just Red, Just Blue, Just Green, Just Yellow, Just Red, Just Blue, Nothing, Nothing, Nothing, Nothing ]
]
}

setField : Int -> Int -> Maybe Color -> Field -> Maybe Field
setField y x m f =
Array.get y f
|> Maybe.andThen (\xs -> Just <| Array.set y (Array.set x m xs) f)

getField : Int -> Int -> Field -> Maybe (Maybe Color)
getField y x f =
Array.get y f
|> Maybe.andThen (\xs -> Array.get x xs)
```

さてメインロジック。
chainでくっついているぷよたちの座標を拾う。
chainの中で無限ループしないように辿った座標をリストで管理。

delete_で配列全てをchainにかけて、座標数が4つ以上だったらその座標を元にNothingに置き換える。
fall_で下から配列をなめて、Nothingとぷよを入れ替え。

```delete : PuyoPuyo -> PuyoPuyo
delete pp =
let
chain : List ( Int, Int ) -> ( Int, Int ) -> List ( Int, Int )
chain ls ( y, x ) =
case getField y x pp.field of
Nothing ->
ls

Just m ->
case m of
Nothing ->
ls

Just c ->
List.foldl (chain_ c)
ls
[ ( y - 1, x ), ( y, x - 1 ), ( y, x + 1 ), ( y + 1, x ) ]

chain_ : Color -> ( Int, Int ) -> List ( Int, Int ) -> List ( Int, Int )
chain_ c ( y, x ) ls =
if List.any ((==) ( y, x )) ls then
ls
else
case getField y x pp.field of
Nothing ->
ls

Just m ->
case m of
Nothing ->
ls

Just c_ ->
if c == c_ then
chain (List.append [ ( y, x ) ] ls) ( y, x )
else
ls

delete_ : Int -> Int -> Field -> Field
delete_ y x f =
if x < 10 then
if y < 20 then
delete_ y (x + 1) (delete__ y x f)
else
f
else
delete_ (y + 1) 0 (delete__ y x f)

delete__ : Int -> Int -> Field -> Field
delete__ y x f =
let
ls =
chain [] ( y, x )
in
if List.length ls >= 4 then
List.foldl delete___ f ls
else
f

delete___ : ( Int, Int ) -> Field -> Field
delete___ ( y, x ) f =
case setField y x Nothing f of
Nothing ->
f

Just f_ ->
f_

field_ =
delete_ 0 0 pp.field
in
{ pp | field = field_ }

fall : PuyoPuyo -> PuyoPuyo
fall pp =
let
fall_ y x fd =
if y > 0 then
if x < 10 then
fall_ y (x + 1) (fall__ y x fd)
else
fall_ (y - 1) 0 (fall__ y x fd)
else
fd

fall__ y x fd =
case getField y x fd of
Nothing ->
fd

Just m ->
case m of
Just _ ->
fd

Nothing ->
case getField (y - 1) x fd of
Nothing ->
fd

Just mm ->
case setField y x mm fd of
Nothing ->
fd

Just fd_ ->
case setField (y - 1) x Nothing fd_ of
Nothing ->
fd_

Just fd__ ->
fd__

field_ =
fall_ 19 0 pp.field
in
{ pp | field = field_ }
```

あとは適当にビジュアライズ。
タイマーにfallをセット。

```module Main exposing (..)

import PuyoPuyo as PP
import Array
import Html as H
import Svg as S
import Svg.Attributes as SA
import Time

type alias Model =
PP.PuyoPuyo

type Msg
= Fall

main =
H.program
{ init = ( PP.example, Cmd.none )
, update = update
, view = viewField
, subscriptions = subscriptions
}

subscriptions model =
Time.every (Time.second / 5) (always Fall)

update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
Fall ->
let
model_ =
PP.fall model
in
if model_ == model then
( PP.delete model, Cmd.none )
else
( model_, Cmd.none )

viewCircle y x m =
let
color =
case m of
Nothing ->
"black"

Just c ->
toString c
in
S.circle
[ SA.cy (toString <| (y + 1) * 25)
, SA.cx (toString <| (x + 1) * 25)
, SA.r "12"
, SA.fill color
]
[]

viewField : Model -> H.Html Msg
viewField pp =
let
ls =
List.concat <|
Array.toList <|
Array.indexedMap
(\y xs ->
Array.toList <|
Array.indexedMap (\x m -> viewCircle y x m) xs
)
pp.field
in
S.svg
[ SA.height "1100", SA.width "600" ]
ls
```

Why not register and get more from Qiita?
1. We will deliver articles that match you
By following users and tags, you can catch up information on technical fields that you are interested in as a whole
2. you can read useful information later efficiently
By "stocking" the articles you like, you can search right away
Why do not you register as a user and use Qiita more conveniently?
You need to log in to use this function. Qiita can be used more conveniently after logging in.
You seem to be reading articles frequently this month. Qiita can be used more conveniently after logging in.
1. We will deliver articles that match you
By following users and tags, you can catch up information on technical fields that you are interested in as a whole
2. you can read useful information later efficiently
By "stocking" the articles you like, you can search right away
ユーザーは見つかりませんでした