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 

Zamknięta sinusoida na okręgu

Wyrażenie całkowitej liczby długości fali, która odpowiada danej orbicie kołowej nie jest skomplikowane. Poniżej pokazuję procedurę, która realizuje to zagadnienie:

'VBA Excel

Sub sinoncircle()

Pi = 3.1415

pi2 = 2 * Pi

i = 1     'numer wiersza

a = 10    'liczba ramion

b = 1 / a 'odwrotność - warunek "gwiazdowania"

 For teta = 0 To pi2 Step 0.01

   r = 1 + b * Sin(a * teta)

   x = r * Cos(teta)

   y = r * Sin(teta)

   Cells(i, 1) = x

   Cells(i, 2) = y

   i = i + 1

 Next teta

End Sub

'powyższa procedura oblicza

'trajektorię drgającego punktu na okręgu

'w płaszczyźnie tego okręgu

Wynikiem działania tego programu i wyświetlenia wyników wykres (Excel) zamieszczony poniżej:

Wynik ten obrazuje mniemanie, że elektron krążąc np. po pierwszej orbicie Bohra może wykonywać ruch drgający.  

Dywan i kartka Sierpińskiego (gry w chaos)

Napisałem program w Small Basicu, który generuje dywan Sierpińskiego. Procedura jest prosta. Ustala się położenie ośmiu punktów, cztery w narożach kwadratu i jeszcze cztery w połowie długości boków kwadratu. Potem wybiera się dowolny punkt i losuje jesten z ustalonych punktów. W następnym kroku ustala się punkt leżący w połowie odległości pomiędzy punktem wybranym a wylosowanym. Procedurę się powtarza. W wyniku powtórzenia jae bardzo dużą liczbę razy, otrzymuje się rysunek jak poniżej (Program 1):

Dywan Sierpińskiego otrzymany z gry w chaos

Jeśli losuje się dowolne punkty na osi x i y, to otrzymuje się coś, co nazwałem kartką Sierpińskiego. Stopień wypełnienia kartki zależy od liczby iteracji:

Teksty programów, które realizują opisane algorytmy:

'Program 1. Dywan  Sierpińskiego utworzony z za pomocą gry w chaos

trans_x=500  'umiejscowienie punktu (0,0) na ekranie

trans_y=400

scale= 100    'skala rysowania 100 dla a=0.69

xw[1] = 1     'wierzchołki i punkty na bokach kwadratu

yw[1] = 1

xw[2] = 1

yw[2] =-1

xw[3] =-1

yw[3] =-1

xw[4] =-1

yw[4] = 1

xw[5] = 1

yw[5] = 0

xw[6] = 0

yw[6] =-1

xw[7] =-1

yw[7] = 0

xw[8] = 0

yw[8] = 1

x=0.1

y=0.1

a = 0.69 'dla 0.69 mamy okno Sierpińskiego i skali 100

GraphicsWindow.Width=1000

GraphicsWindow.Height=800

For i = 1 To 4000000

  rog = math.GetRandomNumber(8) 'losowanie numeru punktu kwadratu

   x = x - (x - xw[rog]) / a

   y = y - (y - yw[rog]) / a

  x_screen=x*scale +trans_x

  y_screen=y*scale +trans_y

  GraphicsWindow.SetPixel(x_screen, y_screen, "blue")

  GraphicsWindow.DrawEllipse(trans_x,trans_y, 1, 1)

Endfor

GraphicsWindow.DrawBoundText(10,400,200, "Koniec obliczeń")

'Program 2.Kartka  Sierpińskiego

'Utworzona z wykorzystaniem losowania punktów na osiach

trans_x=400  'umiejscowienie na ekranie

trans_y=300

scale=200    'skala rysowania 100 dla a=0.69

x=0.1

y=0.1

a = 1

GraphicsWindow.Width=1000

GraphicsWindow.Height=800

For i = 1 To 100000

  xlos = (math.GetRandomNumber(10001)-1)/10000 'losowanie punktu na osi x

  ylos = (math.GetRandomNumber(10001)-1)/10000 'losowanie punktu na osi y

   x = x - (x - xlos) / a

   y = y - (y - ylos) / a

  x_screen=x*scale +trans_x

  y_screen=y*scale +trans_y

  GraphicsWindow.SetPixel(x_screen, y_screen, "blue")

  GraphicsWindow.DrawEllipse(trans_x,trans_y, 1, 1)

Endfor

GraphicsWindow.DrawBoundText(10,400,200, "Koniec obliczeń")