スポンサーサイト

上記の広告は1ヶ月以上更新のないブログに表示されています。
新しい記事を書く事で広告が消せます。

ライフゲームの次世代を求める

Excel VBA

Function NextGen(ByVal PresentGen As Variant, ByVal EdgeLoop As Boolean) As Variant
    Dim tmpX As Long, tmpY As Long, LLX As Long, LLY As Long
    Dim tmpG() As Boolean, tmpL As Long
    Dim tmpA As Long, tmpB As Long
    LLX = UBound(PresentGen, 1)
    LLY = UBound(PresentGen, 2)
    If EdgeLoop Then
        For tmpL = 1 To LLX - 1
            PresentGen(tmpL, 0) = PresentGen(tmpL, LLY - 1)
            PresentGen(tmpL, LLY) = PresentGen(tmpL, 1)
        Next
        For tmpL = 1 To LLY - 1
            PresentGen(0, tmpL) = PresentGen(LLX - 1, tmpL)
            PresentGen(LLX, tmpL) = PresentGen(1, tmpL)
        Next
        PresentGen(0, 0) = PresentGen(LLX - 1, LLY - 1)
        PresentGen(LLX, 0) = PresentGen(1, LLY - 1)
        PresentGen(0, LLY) = PresentGen(LLX - 1, 1)
        PresentGen(LLX, LLY) = PresentGen(1, 1)
    Else
        For tmpL = 0 To LLX
            PresentGen(tmpL, 0) = 0
            PresentGen(tmpL, LLY) = 0
        Next
        For tmpL = 0 To LLY
            PresentGen(0, tmpL) = 0
            PresentGen(LLX, tmpL) = 0
        Next
    End If
    ReDim tmpG(LLX, LLY) As Boolean
    For tmpX = 1 To LLX - 1
        For tmpY = 1 To LLY - 1
            tmpL = 0
            For tmpA = tmpX - 1 To tmpX + 1
                For tmpB = tmpY - 1 To tmpY + 1
                    If (PresentGen(tmpA, tmpB) And ((tmpA <> tmpX) Or (tmpB <> tmpY))) Then
                        tmpL = tmpL + 1
                    End If
                Next
            Next
            If PresentGen(tmpX, tmpY) Then
                If (tmpL <= 1) Then tmpG(tmpX, tmpY) = False
                If ((tmpL = 2) Or (tmpL = 3)) Then tmpG(tmpX, tmpY) = True
                If (4 <= tmpL) Then tmpG(tmpX, tmpY) = False
            Else
                If (tmpL = 3) Then tmpG(tmpX, tmpY) = True
            End If
        Next
    Next
    NextGen = tmpG
End Function
 
John Horton Conwayによって考案されたライフゲームは以下のような法則に従う。
 
①誕生:ある生物の居ない升目に隣接する升目で、生物が居る升目が3つあれば、その升目に次の世代で生物が誕生する。
②生存:ある生物の居る升目に隣接する升目で、生物が居る升目が2つか3つならば、その升目の生物は引き続き生存する。
③過疎:ある生物の居る升目に隣接する升目で、生物が居る升目が1つ以下ならば、その升目の生物は過疎により死滅する。
④過密:ある生物の居る升目に隣接する升目で、生物が居る升目が4つ以上ならば、その升目の生物は過密により死滅する。
 
これを盤面全体に対して同時に判定し次の世代に置き換えるという事を繰り返し行うことで、 生命の誕生から死滅のプロセスを簡易的なモデルで再現するシミュレーションだ。
 
この次世代の様子を求めるには上記のような関数を用意すれば良い。
第1引数に現在の盤面のBoolean2次元配列を、第2引数に盤面の端を逆側に繋げるかどうかの フラグを与えて呼び出せば、次の世代の2次元配列が返ってくる。
実際には端の処理を行うためにX・Yそれぞれ0の升と最大値の升を利用するため、 0から盤面に使いたいX・Yの最大値にプラス1した配列を準備して実行する。
 
これを使って、例えばエクセルのA1~AD30までの縦横30升の盤面を使ってシミュレーションを 行う場合、次のようなコードでこれを次世代に更新することができる。
 
Sub LifeTest()
    Dim tmpG As Variant
    Dim tmpR As Long, tmpC As Long
    Dim tmpS As String
    ReDim tmpG(31, 31) As Boolean
    For tmpR = 1 To 30
        For tmpC = 1 To 30
            tmpS = CStr(ThisWorkbook.Sheets(1).Cells(tmpR, tmpC).Value)
            If (tmpS <> "") Then tmpG(tmpC, tmpR) = True
        Next
    Next
    tmpG = NextGen(tmpG, True)
    For tmpR = 1 To 30
        For tmpC = 1 To 30
            If tmpG(tmpC, tmpR) Then
                ThisWorkbook.Sheets(1).Cells(tmpR, tmpC).Value = "*"
            Else
                ThisWorkbook.Sheets(1).Cells(tmpR, tmpC).Value = ""
            End If
        Next
    Next
End Sub
 
スポンサーサイト

テーマ : 算数・数学の学習
ジャンル : 学校・教育

UTF-8からShift_JISに変換する

Excel VBA VBScript

Sub UTF8toSJIS(ByVal InFile As String, ByVal OutFile As String)
    Const adTypeText = 2
    Const adSaveCreateOverWrite = 2
    Dim myST1 As Object, myST2 As Object
    Set myST1 = CreateObject("ADODB.Stream")
    Set myST2 = CreateObject("ADODB.Stream")
    myST1.Type = adTypeText
    myST1.Charset = "UTF-8"
    myST1.Open
    myST1.LoadFromFile InFile
    myST1.Position = 0
    myST2.Type = adTypeText
    myST2.Charset = "Shift_JIS"
    myST2.Open
    myST1.CopyTo myST2
    myST2.SaveToFile OutFile, adSaveCreateOverWrite
    myST2.Close
    myST1.Close
    Set myST1 = Nothing
    Set myST2 = Nothing
End Sub
 
UTF-8で保存されているテキストファイルの文字コードをADODBを使って Shift_JISに変換するには、上記のような処理を書けばよい。
 
このプロシージャを、InFileに読み込むファイルのフルパス、 OutFileに書き出すファイルのフルパスを与えて呼び出してやれば、 文字コードが変換された状態の新しいファイルが作成される。
 
Excel VBAで使える形で書いているが、他のVBAでもこのままで動くはずだ。
また、型宣言を省いてやるだけでVBScriptでも使用可能となる。
 

テーマ : エクセル
ジャンル : コンピュータ

特定のセルに移動する

Excel VBA

Application.Goto ThisWorkbook.Sheets("Sheet1").Cells(1, 1), True
 
ApplicationのGotoメソッドを使えば特定のセルに移動できる。
 
第1引数に飛び先のセルを、第2引数にはTrueを指定する。
このTrueは実際に移動することを意味するもので、 これによりそのセルをアクティブにした状態にもできる。
 

テーマ : プログラミング
ジャンル : コンピュータ

Shift_JISからJISへ変換する

Excel VBA VB 6.0

Function ShJIS2JIS(ByVal SrcStr As String) As String
    Const adTypeText = 2
    Dim myStream As Object
    Dim tmpS As String
    Set myStream = CreateObject("ADODB.Stream")
    myStream.Open
    myStream.Type = adTypeText
    myStream.Charset = "iso-2022-jp"
    myStream.WriteText SrcStr
    myStream.Position = 0
    myStream.Type = adTypeText
    myStream.Charset = "Shift_JIS"
    tmpS = myStream.ReadText()
    myStream.Close
    Set myStream = Nothing
    ShJIS2JIS = tmpS
End Function
 
JISコード(ISO-2022-JP)の文字列からShift_JISコードの文字列への 変換と同様、ADODB.Streamを使えば Shift_JISコードの文字列からJISコードの文字列への変換も簡単にできる。
 

テーマ : プログラミング
ジャンル : コンピュータ

JISからShift_JISへ変換する

Excel VBA VB 6.0

Function JIS2ShJIS(ByVal SrcStr As String) As String
    Const adTypeText = 2
    Dim myStream As Object
    Dim tmpS As String
    Set myStream = CreateObject("ADODB.Stream")
    myStream.Open
    myStream.Type = adTypeText
    myStream.Charset = "Shift_JIS"
    myStream.WriteText SrcStr
    myStream.Position = 0
    myStream.Type = adTypeText
    myStream.Charset = "iso-2022-jp"
    tmpS = myStream.ReadText()
    myStream.Close
    Set myStream = Nothing
    JIS2ShJIS = tmpS
End Function
 
ADODB.Streamを使えば JISコード(ISO-2022-JP)の文字列をShift_JISコードの文字列に 簡単に変換することができる。
 
漢字(全角文字)だけの文字列の場合、変換元となる文字列に JIS X 0208へ切替えるエスケープシーケンスが付いていない場合がある。
こういう場合は、JIS X 0208へ切替えるエスケープシーケンスは 『[ESC]$B』なので、次のような補助関数を作って呼び出せば良い。
 
Function JIS2ShJISex(ByVal SrcStr As String) As String
    Dim tmpS As String
    tmpS = Chr(&H1B) + Chr(&H24) + Chr(&H42)
    tmpS = tmpS + SrcStr
    tmpS = JIS2ShJIS(tmpS)
    JIS2ShJISex = tmpS
End Function
 
補足だが、当然ながらアルファベット(半角文字)については どちらもASCIIコードを使っているので変化は無い。
更におまけで書いておくと、JIS X 0208からASCIIへの切替え エスケープシーケンスは『[ESC](B』(&H1B2842)である。
 

テーマ : プログラミング
ジャンル : コンピュータ

プロフィール

みっちょ (田上 暢顕)

Author:みっちょ (田上 暢顕)
 
30年以上ひたすら毎日プログラミングを続けているエンジニアの『みっちょ』です。

ここでは開発を行う際の覚書の他、私が日頃から色々な開発を行う中で便利だと感じているツールやサービスなどを紹介しています。



連絡先
 110651321
 michyox
 4348126
 Ravijour

友達申請などWelcomeです☆
基本的に断りませんので、お気軽に申請してください♪

最新記事
最新コメント
最新トラックバック
月別アーカイブ
カテゴリ
検索フォーム
RSSリンクの表示
リンク
ブロとも申請フォーム

この人とブロともになる

QRコード
QR
上記広告は1ヶ月以上更新のないブログに表示されています。新しい記事を書くことで広告を消せます。