人工知能は天使か悪魔か
羽生さんの番組、面白かったです。
なんとなく知ってはいましたが、自動運転、小説や絵画の創作、病気の発見など、色々なことができるようになっているみたいですね。
- ゲームに勝つための最善の手を見つける
- 病気の兆候を発見する
- 事故らないように運転する
という、「いいこと」というか、ゴールがわかりやすいものに関してはどんどん活用されるべきだろうと思います。
ただ、「タワーを崩すという命令に背く（友人がせっかく積み上げたから）」という部分に関しては危うさを感じました。
その判断をどうやってさせるのか？ ということなんですよね。
何がよくて何がよくないのか、という「判断」の部分を人工知能に任せてよいのかどうか。
例えば
ゲームには負けたけどみんな笑ってるからいいか
みたいなシーンがありましたが、
世間的にはあんまりよくないことでも、近くの人が喜んでくれるからOK
みたいなことにつながるんじゃないでしょうか。
まあ、そんなことを言いつつ、実際には
「俺の仕事をコンピュータなんかにやらせてたまるか！」
とか
「人工知能は自我に目覚めて人間に危害を加えるから危険だ！」
みたいなことで、役に立つ分野でも導入が阻害されることのほうが現実的には心配です。
うまいこと、便利な世の中になっていけばいいなと。
あと、羽生さんが花札強いのと英語しゃべれるのがすごいなと思いました。
Excelでドット絵作成ツールを作る その7
コード
現時点でのコードは
'///標準モジュール/// <<mod00変更履歴>> Option Explicit Public Const TateHaba As Long = 10000 '１履歴に使う縦のセル数 '履歴保存 Sub saveHistory() Dim rg As Range Dim gyo As Long Application.ScreenUpdating = False CurHistory = CurHistory + 1 CntHistory = CurHistory Call setCurHistory Set rg = Range(BaseRng.Offset(1, 1), Cells(BaseRng.Row + Tate, _ BaseRng.Column + Yoko)) gyo = CurHistory * TateHaba + 1 With Sheets("変更履歴") rg.Copy Destination:=.Cells(gyo, 1) 'コピー .Range(.Cells(gyo + Tate, 1), _ .Cells(Rows.Count, Columns.Count)).Clear 'クリア End With Application.ScreenUpdating = True End Sub '元に戻す Sub doUndo() Call setSettings '設定を共通変数にセット If CurHistory <= 0 Then Exit Sub End If CurHistory = CurHistory - 1 Call setCurHistory Call copyFromHistory End Sub 'やり直し Sub doRedo() Call setSettings '設定を共通変数にセット If CurHistory >= CntHistory Then Exit Sub End If CurHistory = CurHistory + 1 Call setCurHistory Call copyFromHistory End Sub '現在の表示が履歴のどの段階なのかを記録 Sub setCurHistory() Application.EnableEvents = False With Sheets("ドット絵作成") .Range(CurHistoryAddress) = CurHistory .Range(CntHistoryAddress) = CntHistory End With Application.EnableEvents = True End Sub Sub copyFromHistory() Dim rg As Range Dim Tgt As Range '貼り付け前選択セル Dim gyo As Long gyo = CurHistory * TateHaba + 1 With Sheets("変更履歴") Set rg = .Range(.Cells(gyo, 1), .Cells(gyo + Tate - 1, Yoko)) End With Application.ScreenUpdating = False Application.EnableEvents = False rg.Copy Sheets("ドット絵作成").Activate Set Tgt = Selection BaseRng.Offset(1, 1).Select ActiveSheet.Paste Tgt.Select Application.EnableEvents = True Application.ScreenUpdating = True End Sub
こんな感じです。
今回いじったのは履歴の部分だけでした。
今後の課題
ボタンを押せない時に、押せない感を出したいところです。
（ただの図形にマクロをくっつけているので、標準ではできない）
あと、画像出力だけではなくて、描画した部分を新しいブックに出力したりしたいかなと思います。
Life Is Strange 面白かった
以前の記事
vba-belle-equipe.hatenablog.com
で書いた、Life Is Strange というゲームが終わりました。（全５章）
よかったところ
最後まで先が読めない展開で、面白かったです。
あと、空気感というか、世界感がすばらしい。
あちこちにある落書きとか、キャラクターごとの部屋とか、すごく作りこまれています。
タイムトラベルに関して
- その時間の自分が別に存在する
- その時間の自分のパネルが立っている
わけではなく
時間を戻せるけど、主人公は影響を受けない
という、考え出すとよくわからなくなる条件を生かした謎解きとかもよかったです。
残念？ だったところ
パソコンのキーボード（移動）とマウス（視点変更アンド選択肢）での操作が、大変でした。
左指がつりそうになりました。
あと、
こちらの動画を観て面白そう、と思ったわけですが、わりと早めのコメントでネタバレしているバカがいたのが残念でした。
もう１周
動画で解説を観て、もう１周したいです。
その前にとりあえず、コメンタリー（無料）でしょうか。
ゲームの中の世界に触れるようになる
ゲームの中の世界に触れるようになるコントローラーがあるということを
こちらで知りました。
VR、ほんとに楽しみです。
いずれ、視覚、聴覚、触覚以外にも感じることができるようになって、「現実」との境がなくなっていくのでしょうか。
部屋の中にいながら色々な世界に行けて、触れて、体験できるようになる。
イメージした未来が近づいてきていると感じます。
没入度が増した時に、ネトゲ廃人みたいになる人が増えていくのか、そういう方面は心配といえば心配ですが。
VRについて考えるとき、いつも、NHKでヴァーチャルリアリティっぽいドラマやってたなあと思い出します。
（佐藤藍子が出てたということしか思い出せない）
あと、
人間が移動するということが「贅沢」になっていく
みたいなことを何かの小説で読んだことを思い出します。
（思い出すだけで、引用できるわけではない）
ということで、満員電車がなくなればいいな。
Excelでドット絵作成ツールを作る その6
現状報告
こんな感じです。
見た目が変わらないと寂しいので、「元に戻す」ボタンを変えてみました。
元に戻す
- 描画の際に「履歴」シートに現状を記録し、
- 「元に戻す」ボタンで、描画部分に貼り付けて戻す
という風にしています。
履歴シート
今のところ、単純に
こんな感じです。
コード
現時点でのコードは
'///シートモジュール/// Option Explicit Private Tgt As Range Private Sub Worksheet_Change(ByVal target As Range) Call setSettings '設定を共通変数にセット If target.Address = TateAddress Or target.Address = YokoAddress Then Call setCamvas 'キャンバスセット Exit Sub End If End Sub Private Sub Worksheet_SelectionChange(ByVal target As Range) Application.ScreenUpdating = False Set Tgt = target '手動モードか、選択範囲多すぎる場合何もしない If Range("A1") = "手動モード" Or target.Count > 1000 Then Call exitChangeEvent End If Call setSettings '設定を共通変数にセット '//描画色選択// Dim lngNewColor As Long '----(カラーピッカー) If target.Address = DrawColorAddress Then lngNewColor = GetColorDlg If lngNewColor <> -1 Then Call changeDrawColor(lngNewColor) End If Call exitChangeEvent End If '----(選択履歴) If target.Count = 1 And _ Not Application.Intersect(target, Range(RirekiAddress)) Is Nothing Then lngNewColor = target.Interior.Color Call changeDrawColor(lngNewColor) Call exitChangeEvent End If Call drawCells(target) '描画 Call exitChangeEvent End Sub Sub exitChangeEvent() Application.CutCopyMode = False Tgt.Select Application.ScreenUpdating = True End End Sub '///標準モジュール/// <<mod00共通処理>> Option Explicit Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Public Const DrawColorAddress As String = "$B$4:$B$5" Public Const RirekiAddress As String = "$D$1:$D$35" Public Const TateAddress As String = "$B$15" Public Const YokoAddress As String = "$B$18" Public Const CamvasBaseAddress As String = "$F$1" Public BaseRng As Range '描画範囲 Public CamvasRng As Range 'キャンバス基準（左上セル） Public Tate As Long, Yoko As Long 'キャンバスサイズ（縦、横） '設定を共通変数にセット Sub setSettings() With Sheets("ドット絵作成") Set BaseRng = .Range(CamvasBaseAddress) Tate = .Range("B15") Yoko = .Range("B18") Set CamvasRng = .Range(BaseRng, .Cells(BaseRng.Row + Tate + 1, _ BaseRng.Column + Yoko + 1)) End With End Sub '///標準モジュール/// <<描画>> Option Explicit '描画色変更 Sub changeDrawColor(lngNewColor As Long) Dim i As Long Application.ScreenUpdating = False If Range(DrawColorAddress).Interior.Color = lngNewColor Then Exit Sub End If Range(DrawColorAddress).Interior.Color = lngNewColor Range("A1").Select '色選択履歴 Dim fnd As Boolean fnd = False For i = 1 To 35 If Cells(i, 4).Interior.Color = lngNewColor Then fnd = True Exit For End If Next If fnd Then Exit Sub '新しい色が履歴にある場合何もしない For i = 35 To 2 Step -1 Cells(i, 4).Interior.Color = Cells(i - 1, 4).Interior.Color Next Cells(1, 4).Interior.Color = lngNewColor Application.ScreenUpdating = True End Sub 'キャンバス Sub setCamvas() Dim r As Range Application.ScreenUpdating = False Cells.Interior.Pattern = xlSolid For Each r In CamvasRng If r.Row = BaseRng.Row Or r.Row = BaseRng.Row + Tate + 1 Or _ r.Column = BaseRng.Column Or r.Column = BaseRng.Column + Yoko + 1 Then r.Interior.Pattern = xlGrid End If Next Application.ScreenUpdating = True End Sub '描画 Sub drawCells(target As Range) Dim r As Range Dim copyRng As Range Dim minCol As Long, maxCol As Long Dim minRow As Long, maxRow As Long Dim clr1 As Long '描画色 Dim drwRng As Range Application.ScreenUpdating = False clr1 = Range(DrawColorAddress).Interior.Color minCol = BaseRng.Column + 1 maxCol = BaseRng.Column + Yoko minRow = BaseRng.Row + 1 maxRow = BaseRng.Row + Tate Set copyRng = Sheets("ドット絵作成").Range _ (Cells(minRow, minCol), Cells(maxRow, maxCol)) For Each r In target If minCol <= r.Column And r.Column <= maxCol And _ minRow <= r.Row And r.Row <= maxRow Then If drwRng Is Nothing Then Set drwRng = r Else Set drwRng = Union(drwRng, r) End If End If Next '範囲内セルを描画する If drwRng Is Nothing Then Else Call saveHistory '履歴残す drwRng.Interior.Color = clr1 End If target.Select Application.ScreenUpdating = True End Sub '///標準モジュール/// <<mod00変更履歴>> Option Explicit '履歴保存 Sub saveHistory() Dim rg As Range Application.ScreenUpdating = False Set rg = Range(BaseRng.Offset(1, 1), Cells(BaseRng.Row + Tate, _ BaseRng.Column + Yoko)) rg.Copy Destination:=Sheets("変更履歴").Cells(1, 1) Application.ScreenUpdating = True End Sub 'やり直し Sub doUndo() Call copyFromHistory End Sub Sub copyFromHistory() Dim rg As Range Dim Tgt As Range '貼り付け前選択セル Call setSettings '設定を共通変数にセット With Sheets("変更履歴") Set rg = .Range(.Cells(1, 1), .Cells(Tate, Yoko)) End With Application.ScreenUpdating = False Application.EnableEvents = False rg.Copy Sheets("ドット絵作成").Activate Set Tgt = Selection BaseRng.Offset(1, 1).Select ActiveSheet.Paste Tgt.Select Application.EnableEvents = True Application.ScreenUpdating = True End Sub
こんな感じです。*1
カブっている処理をまとめたりしています。
画面のちらつき
履歴を残す際に画面がちらつくのをなおすのに結構時間をとられました。
Application.ScreenUpdating = False
を入れたりいれなかったりして検証したり、
rg.Copy Sheets("変更履歴").Cells(1, 1).PasteSpecial Paste:=xlPasteAll
を
rg.Copy Destination:=Sheets("変更履歴").Cells(1, 1)
に変更したりで、今のところ大丈夫な感じです。
今後の課題
まだ「元に戻す」が直前の画像に戻すだけなので、もう少し履歴をとりたいところです。
*1:カラーピッカー（色選択）と画像出力の部分は変更ないので今回は割愛します
