Zmierzam w kierunku symulacji gęstości elektronowej stanu podstawowego atomu wodoru za pomocą nieznanej mi jeszcze ciągłej trajektorii wielowymiarowej. Nie jest to łatwe dla mnie zadanie, ale próbuję znaleźć prostsze przypadki, które mogą podpowiadać jak taką wielowymiarową trajektorię znaleźć (o ile w ogóle istnieje).
Poniżej przedstawiam symulację pokazującą efekt przecięcia trójwymiarowej trajektorii z płaszczyzną xy. Na przedstawionym filmiku punkt się pojawia wtedy, gdy punkt trajektorii znajdzie się w cienkim placku o grubości 2⋅eps. Dodatkowo pojawia się wykres dystrybucji radialnej punktów. Przy czym oś y biegnie w dół ekranu.
Mimo podobieństwa w zachowaniu nie jest to proces chaotyczny. Punkty są generowane systematycznie w miarę zmiany współrzędnych sferycznych. Procedurę, która tworzy powyższy obraz, napisałem w SmallBasicu. Jej tekst jest poniżej.
'Przecięcia trajektorii 3D z płaszczyzną xy
Controls.ButtonClicked=trajektoria 'przycisk uruchamiający procedurę
Controls.AddButton("idź",90,40)
Sub trajektoria 'procedura znajduje punkty przecięcia tr. 3D z płaszczyzną x,y
dane()
For fi = 0 To 4*Math.Pi Step 0.05 'generowanie punktów
For teta = 0 To 40*pi2 Step 0.1
'modulowanie wartości promienia widzącego punktu
r = 0.01 + math.Power(math.Sin(Math.SquareRoot(teta)),2)
x = r*math.cos(teta)*math.sin(fi)
y = r*math.Sin(teta)*math.Sin(fi)
z = r*math.Cos(fi)
rysuj_punkt() 'rysowanie punktu na ekranie
endfor
Endfor
GraphicsWindow.DrawText(10,400, "Koniec obliczeń")
EndSub
Sub dane
eps = 0.01 'błąd znalezienia punktu niedaleko pł. x,y
trans_x = 300 'umiejscowienie punktu 0,0 na ekranie
trans_y = 220 'przesunięcie początku ukł. współdzednych do
trans_z = 250 'nie używana
scale = 200 'skala rysowania
pi2 = 2*math.pi
EndSub
Sub rysuj_punkt
If Math.Abs(z) <= eps Then 'warunek obecności punktu w pobliżu płaszczyzny xy
x_scr = x*scale + trans_x 'współrzędne x,y na ekranie
y_scr = y*scale + trans_y
'z_scr=z*scale+trans_z 'nie pokazana
GraphicsWindow.PenColor = "black" 'rysowanie punktu
GraphicsWindow.DrawEllipse(x_scr,y_scr,2,2)
GraphicsWindow.PenColor = "white" 'niecałkowite mazanie punktu
GraphicsWindow.DrawEllipse(x_scr,y_scr,1,1)
dystrybucja() 'rysuje dystrybucję w kolorze czerwonym
EndIf
EndSub
Sub dystrybucja 'na płaszczyźnie xy
rd = math.SquareRoot(x*x + y*y)
rdmax = math.Round(rd*1000)
licznosc[rdmax] = licznosc[rdmax]+1
GraphicsWindow.SetPixel(rdmax/2+10, licznosc[rdmax]/30,"red")
EndSub
