[プログラム]塗りつぶしプログラム

塗りつぶしプログラムを作ろうとおもいたち、その際いろいろ調べたり、考えたりしたので書いていきます。
ペイントとかで簡単に塗りつぶしを使えるのに、実際作ったり高速化考えたりするとむずかし面白いですね。

今回は、わかりやすくエクセルで『１』を『２』に塗りつぶす感じで作っていきます。
ペイントで言う塗りつぶしに設定してマウスで『１』のところを一箇所クリックした想定で考えていきます。

ズームするとこんなかんじ

原始プログラム

はい、まずは最適化とか基本何も考えていないプログラムです。

Do
flg = False
For x = MinWidth To MaxWidth
    For y = MinHeight To MaxHeight
        If (Cells(y, x) = 2) Then
            For i = -1 To 1 Step 2
                If (Cells(y + i, x) = 1) Then
                    Cells(y + i, x) = 2
                    flg = True
                End If
            Next i
        
            For i = -1 To 1 Step 2
                If (Cells(y, x + i) = 1) Then
                    Cells(y, x + i) = 2
                    flg = True
                End If
            Next i
        End If
    Next y
Next x
If (flg = False) Then
    Exit Do
End If
Loop

仕組みとしては、画面の端っこからひたすらループを行い『２』を探します。見つけたらそのセルから前後左右に『１』があるか確認します。
有った場合は『２』に変えてフラグをTrueにする

全部見たあとにフラグがTrueだったらまた画面左上から調べ直し….を繰り返します。
全部見たあとにフラグがFalseだったら塗りつぶし終了です。

ものっそい時間がかかりそうですね。
時間を計測してみます。

時間計測参考リンク

今回、この４箇所からスタートして、塗りつぶしが完了するまでの時間を計測していきます。
測定は１箇所あたり１０回行いその平均を求めます。
また、プログラムには
Application.ScreenUpdating = False　
を追加し、画面の更新を行わないことにし、
実行中はパソコンに触れないようにしました。
『クリックで拡大』

以下が結果となります。

今回系の大きさが、120ｘ60です。
うーんめちゃくちゃ遅いですね。
ペイントの塗りつぶしなんて1000px x 1000px とかでも一瞬じゃないですか。

今回の速度を基準に最適化を考えていきます。

基本は同じだけど、最前線のみ実行させるプログラム

上のプログラムだと既に実行して上下左右が『２』である箇所も、再度確認しながら処理をすすめているので非常に遅いです。

なので最前線部分のみ上下左右の確認処理を行うようにしていきます。

考え方としては、『３』である箇所を探し、上下左右を確認し『１』の箇所に『３』を入れる。
最後に中心に『２』を入れる。というふうにします。
そうすれば、既に調査した箇所を再度調査すること無く前線のみ調査するようになります。

実行時、画面更新をオンにするとこんな感じで動作します。

Do
flg = False
For x = MinWidth To MaxWidth
    For y = MinHeight To MaxHeight
        If (Cells(y, x) = 3) Then
            For i = -1 To 1 Step 2
                If (Cells(y + i, x) = 1) Then
                    Cells(y + i, x) = 3
                    flg = True
                End If
            Next i
        
            For i = -1 To 1 Step 2
                If (Cells(y, x + i) = 1) Then
                    Cells(y, x + i) = 3
                    flg = True
                End If
            Next i
            Cells(y, x) = 2
        End If
    Next y
Next x
If (flg = False) Then
    Exit Do
End If
Loop

結果は。

おお！早くなりました。！次回はもっともっと早くしていきましょう