Mathematica を使って画像や光学に関する面白い現象をシミュレーションしてみました

・執筆者：ペンネーム：おもしろ計算OYAJI 様
・掲載日：2024/ / /
・使用したバージョン：Mathematica 12.3 J Home Edition
・計算環境 : Windows 10 & 11 Home 64 bit
・使用した主な関数：NetTrain, ImageData, Fourier, Table, Label, Goto, Conjugate, ListDensityPlot

はじめに

趣味として表記の内容の光学現象をMathematicaを使ってシミュレーションしHPを立ち上げました。
具体的テーマはオリジナルなものもありますがOSAが無償で公開しているOpticsExpress等から取り上げています。
Mathematicaの利用歴は長いですが、用いたコマンドも限られていますので深く理解しているとは言い難いです。
HPは分かっている結果がきちんと出てそれが視覚に訴えることを第一にプログラミングしました 。
そのためcodeは単純で速度等も考慮されていませんが、かえって初学者には分かり易いかも知れません。
これまでHP上に載せたシミュレーションテーマの一覧を記しておきます。
https://www.asahi-net.or.jp/~wq7i-htky/
また、いくつかのテーマで私がよく使った手続きとコードも載せておきます。

シミュレーションテーマ

1
.
デープラーニングによるフーリエ変換像から画像復元
2
.
ゴーストイメージングによる光検出器から画像検出
3
.
おもしろマンデルブロ集合を描く
4
.
画像から音を復元する
5
.
光をあやつる
6
.
究極のクリヤ化画像検出方法
7
.
エアリービーム、不思議な光を体験する
8
.
デープラーニングを使ってラドン変換像から元画像を予測する
9
.
文字画像の位相情報をデープラーニングで推定する:その1,その2
10
.
光渦を使って極端な低コントラスト画像を大きく改善する
11
.
すりガラスを透過したボケ画像の元画像をデープラーニングで推測する
12
.
文字画像のフレネルホログラムをデープラーニングで推定する
13
.
焦点深度が超長いレンズを回折レンズで実現する
14
.
画像を使ってステガノグラフィを作ってみる
15
.
デープラーニングで色を学習し各色を分類する
16
.
画像の暗号化と復号化；暗号化の強さをデープラーニングで検証する
17
.
拡散板を使ったレンズレスカメラの動作を検証する
18
.
散乱体の中で光を集光させる
19
.
ChatGPTを使ってアスキーアートを作ってみる
20
.
経路中の擾乱が時間変化しても可能な画像の記録復元
21
.
ピンホールアレイを使った立体カメラ
22
.
スーモース配列を使ったゾンプレートレンズの２重焦点
23
.
デープラーニングを使ってエッジ画像から物体像を再生する
24
.
低コヒーレンス干渉法による物体内部の計測シュミレーション
25
.
タイムオブフライトカメラで物体の形状や距離を測定する
26
.
カラーホログラフィ

よく使った手続きとcode

繰り返し処理

繰り返し処理の方法はたくさんありますが条件を入れやすく使いやすかったのが次に示すLabelを入れて条件を満たすまでGotoでLabelに戻すものでした。
例として次のコードはレンズからの出射光を横から見た画面を得るものです。レンズからの距離をステップで変えその点の像を加算して作りました。
直径180のDiskレンズを含む矩形fnarのDimensions = {360, 360}, 波長 λ = 1, 波数k = 2 Pi/λ, 焦点距離ff = 200*λ, 距離の最小値 zmin = 50*λ, 最大値 zmax = 400*λ, ステップ値 dz = 20*λ, 画像の中央値 k1 = 180 として
In[]:=
(*波長*)λ=1;​​(*波数*)k=2Pi/λ;​​(*焦点距離*)ff=200*λ;​​(*距離の最小値*)zmin=50*λ;​​(*最大値*)zmax=400*λ;​​(*ステップ値*)dz=20*λ;​​(*画像の中央値*)k1=180;​​
In[]:=
ListDensityPlot[fnar]
Out[]=
In[]:=
z11=zmin;bff={};​​Label[start];​​fr=Table[(1/(I*λ*z11))*Exp[I*k*(z11+((i-ymax/2)^2+(j-xmax/2)^2)/(2*z11))],{i,ymax},{j,xmax}];(*レンズからの距離z11での光分布の係数*)​​lenz=Table[fnar[[i,j]]*Exp[I*k*(((i-ymax/2)^2+(j-xmax/2)^2))*(1/(2*z11)-1/(2*ff))],{i,ymax},{j,xmax}];​​fobj=Fourier[lenz];(*レンズのフレネル変換*)​​u1=fr*fobj;(*->距離z11での光分布*)​​ans1=Take[u1,360/2];​​ans2=Take[u1,-360/2];​​ans11=Transpose[Take[Transpose[ans1],360/2]];​​ans12=Transpose[Take[Transpose[ans1],-360/2]];​​ans21=Transpose[Take[Transpose[ans2],360/2]];​​ans22=Transpose[Take[Transpose[ans2],-360/2]];​​fin1=Join[ans22,ans12];fin2=Join[ans21,ans11];​​awaseuu=Transpose[Join[Transpose[fin1],Transpose[fin2]]];(*4隅合わせ(Mathematica特有の処置）*)​​bff=Append[bff,awaseuu[[k1]]];(*画像の中央(k1)部をbffに入れz11の増加ごとに加えていく*)​​z11+=dz;(*1ステップごとにz11をdzだけ増加する*)​​If[z11≤zmax,Goto[start]];(*条件に合うまでstartに戻る.又始めと終わりの()はその中が一括して処理される*)
In[]:=
ListDensityPlot[Abs[bff]]
Out[]=
レンズは下にあり、くびれが焦点です。

ディープラーニング

ディープラーニングはWOLFRAM NEURAL NET REPOSITORYに掲載の" Pix2pix Photo - to - Street - Map Translation "のコードを主に利用して行いました。
​
その他テーマの名称から推定されますようにいろいろ面白い働きをするプログラミングを載せています。公開されているWolfram Researchの REPOSITORY やGoogle Colaboratoryから借用したものもありますが、その他はほぼ独自に試行錯誤しながら作りました。それについては私のHPを見ていただきたいと思います。

おわりに

Mathematicaの良さの一つはコマンドが意味のある言葉でできているため、他の人が書いたプログラムを理解するのが比較的容易であることと思います。このことを前提に私のHPには使ったコードをすべて載せています。Mathematica に対して初学者の皆さんに使ってみようとする動機づけになれば幸いと思います。

Initialization Code

In[]:=
c5=Disk[{0,0},0.54];​​r1=Rectangle[{-1,-1},{1,1}];​​circle=Graphics[{GrayLevel[0.00],r1,GrayLevel[0.6],c5}];​​ringg=Image[circle,ImageSize->{360,359}];​​rin4=ImageData[ringg,"Byte"];​​fla=Flatten[rin4];​​tft=Take[fla,{2077,121792}];​​tab=Table[fla[[i]],{i,1,387720,3}];​​ptab=Partition[tab,360];​​ffn=Flatten[ptab];​​tt=Table[If[Part[ffn,nn]>254,0,Part[ffn,nn]],{nn,1,129240}];​​tt2=Table[If[Part[tt,nn]>152,1,0],{nn,1,129240}];​​fnar=Partition[tt2,360];​​ss=Table[0,{i,1,1},{j,1,360}];​​fnar2=Join[fnar,ss];​​fnar=fnar2;​​xymax=Dimensions[fnar2];​​xmax=xymax[[2]];​​ymax=xymax[[1]];