Przecięcie trajektorii 3D z płaszczyzną xy

    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