środa, 8 stycznia 2020

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 

wtorek, 7 stycznia 2020

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.  

niedziela, 5 stycznia 2020

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ń")