https://community.wolfram.com RSS Feed for Wolfram Community showing any discussions tagged with Astronomy sorted by most replies. https://community.wolfram.com/groups/-/m/t/293403 TL;DR --- I have three issues with getting sun positions in Mathematica V10: - It is extremely slow compared to V9 - It doesn't *seem* to yield correct results - a) It needs an Internet connection, which b) is not assured to always return results and c) if not used optimally can easily consume your monthly allowance of W|A calls Long story === With the advent of V10 `AstronomicalData` has been deprecated, as shown on its documentation page: ![enter image description here][1]. I'm not an astronomer, so my main use of this function has been restricted to its capability to get the sun position using functions calls like this: { AstronomicalData["Sun", {"Azimuth", {2013, 3, 1, #, 0, 0}, {52.37`, 4.89`}}, TimeZone -> 1], AstronomicalData["Sun", {"Altitude", {2013, 3, 1, #, 0, 0}, {52.37`, 4.89`}}, TimeZone -> 1] } & /@ Range[0, 23] > {{341.47732, -43.93930}, {2.33417, -45.21747}, {22.94232, -43.19133}, > {41.52167, -38.28400}, {57.55208, -31.30276}, {71.47253, -23.03159}, > {84.02194, -14.08294}, {95.91940, -4.92723}, {107.80166, 4.03418}, {120.23770, 12.40167}, {133.72303, 19.72563}, {148.59433, > 25.48377}, {164.84179, 29.12209}, {181.93103, 30.19428}, {198.91284, > 28.55117}, {214.89602, 24.41962}, {229.46400, > 18.28613}, {242.70064, 10.70703}, {254.98998, > 2.19073}, {266.84760, -6.82566}, {278.85594, -15.94505}, {291.66723, -24.75464}, {306.00911, -32.75641}, {322.57956, > -39.29877}} So, this gets me the sun positions in steps of an hour during a particular day in Amsterdam (TZ 1). The same call still works in V10, though it now returns numbers with units; degrees in this case. On its first call, it reads some paclet information from a Wolfram server, but on any successive call no Internet connection is needed. I will be going into detail about timing further on, but I'll say here that the V10 function takes about three times longer than its V9 namesake. I blame the addition of units for that. With `AstronomicalData` apparently deprecated we are supposed to use its successors. In this case I need `SunPosition`. A direct translation of the above would be: SunPosition[GeoPosition[{52.37`, 4.89`}], DateObject[{2013, 3, 1, #, 0, 0}, TimeZone -> 1]] & /@ Range[0, 23] > {{95.7, -5.1}, {107.6, 3.9}, {120.0, 12.3}, {133.5, 19.6}, {148.3, 25.4}, {164.5, 29.1}, {181.6, 30.2}, {198.6, 28.6}, {214.6, 24.5}, {229.2, 18.4}, {242.5, 10.9}, {254.8, 2.4}, {266.6, -6.7}, {278.6, -15.8}, {291.4, -24.6}, {305.7, -32.6}, {322.2, -39.2}, {341.3, -43.5}, {2.0, -44.8}, {22.5, -42.9}, {41.1, -38.0}, {57.1, -31.1}, {71.0, -22.9}, {83.6, -13.9}} As with the new `AstronomicalData` the output is actually in degrees which I have removed in the above output for the sake of clarity. There are a few things to note: - `SunPosition` uses position and date objects, the latter being new in V10 - `SunPosition` does not have a `TimeZone` option, but you can set it in `DateObject` - `SunPosition` can use the old lat/long list position indication. It also can use a date list to enter the date instead of a `DateObject`. In the latter case you are out of options with respect to time zones and you have to add the appropriate amount of time offset - It is extremely slow, and it may even time-out: ![enter image description here][2] - Last but not least: the results seem to be plain wrong. It suggests that sunrise is somewhat before 1 am, which is -of course- incorrect. I assume that this has something to do with a `$GeoLocation` setting for the observer of the sun positions, but I haven't managed to sort out what I am supposed to enter to get the correct sun positions for the location provided in the same call. As to timing: I noticed very inconsistent timings for `SunPosition` compared to `AstronomicalData`, so I used the following code to collect a somewhat more statistical sound sample: SetAttributes[timingTest, HoldFirst]; timingTest[code_, repeats_Integer] := Table[ ClearSystemCache[]; code // AbsoluteTiming // First, {repeats} ] Using this, I collected timing of 20 calls to the following code snippets: - `AstronomicalData` V9 and V10: As above - `SunPosition`: As above - `SunPosition` without `GeoPosition`, just the lat/long list. - `SunPosition` without `GeoPosition`, and also without the `DateObject` date, just a classical date list (with the hour set to +1 to accommodate TZ 1) - `SunPosition` V10 without `GeoPosition` and with the `Map` (`/@`) gone and replaced by a `DateRange` inside the call. In the last case, the returned value is a `TimeSeries` object from which I extract the positions using the `"Paths"` method: SunPosition[{52.37`, 4.89`}, DateRange[{2013, 3, 1, 1, 0, 0}, {2013, 3, 1, 24, 0, 0}, "Hour"]]["Paths"][[1, All, 2]] The results were as follows: ![enter image description here][3] Clearly, the `SunPosition` results are very disappointing. Getting the sun positions with `SunPosition` is almost 40 times slower than using the old V9 method (which, I should add, wasn't particularly quick either. I have an implementation in Mathematica code which is faster). The V10 implementation of `AstronomicalData` is also more than three times slower than the V9 version. The `DateRange` version of the call saves a lot of communication overhead. Still, it is almost *five times slower* than in V9. The cause of all this slowness is that `SunPosition` simply does a call to Wolfram|Alpha. Sniffing the communication one sees the following string passed to the server: "1:eJxTTMoPSuNgYGAoZgESPpnFJcHcQEZwaV5AfnFmSWZ+XhoTsmxR/6GvGjH9wg4Qhr6XQxobsnzmXXYGhkxmIC+TEUSIgwggZihigIJgoAIGj/yizKr8PJigA5yBZtubwB1yrdxeDkXVIuvcH1aJOBRzAqUcS0vycxNLMpMBSAArww==" which can be turned into readable form using `Uncompress`: {"SunPosition", {4.89, 52.37}, {2013, 3, 1, 23, 0, 0.}, "Horizon", 2., 2., {52.09, 5.12}, Automatic} Here, we can recognize the lat/long of the position I used (but with lat/long reversed - Is this somehow significant?). At the end is my own `$GeoLocation`, but I don't believe it is used at all (and it shouldn't: I'm asking for the sun position over Amsterdam, not where I live). Changing it with `Block` I get the same results: Block[{$GeoLocation = GeoPosition[{52.37`, 40.89`}]}, SunPosition[{52.37`, 4.89`}, {2013, 3, 1, 1, 0, 0}]] Apart from the slowness, there's the issue of the necessary Internet connectivity (Want to give a demonstration and you don't have Internet? Sorry, you're out of luck). And what of the use of W|A calls? Each of the `SunPosition` tests (except the last one) took me 20 * 24 = 480 calls. So this part of my testing only already took 1440 calls, and one should be reminded that a typical Home Use license allows for only 3,000 calls per month. Things like this can go pretty fast. In fact, I once wrote an application that calculates the impact of building changes on shadows around your house throughout the year. It does in the order of 17,000 `AstronomicalData` calls. I couldn't implement that naively using `SunPosition` and have it actually work. Clearly, one should now use the `DateRange` version of the call as much as possible. ---------- To wrap up: I have one real question, i.e., how to get `SunPosition` to return the same values as `AstronomicalData`, and a request to the WRI team: please put `SunPosition` in the kernel and don't use W|A calls, because the situation as it is now is rather annoying and IMHO a real step backwards. [1]: /c/portal/getImageAttachment?filename=AstronomicalData.png&userId=43903 [2]: /c/portal/getImageAttachment?filename=timeout.png&userId=43903 [3]: /c/portal/getImageAttachment?filename=results.png&userId=43903 Sjoerd de Vries 2014-07-13T16:39:48Z https://community.wolfram.com/groups/-/m/t/763123 I would ask for some help to implement a code to be able to find the center of mass of an annular image of light projection from a fiber optics. The center of mass should be the point where it originates the average radius. On the other hand, the average radius ends at the point, inside the annulus, where the light intensity is maximum. Basically, an initial center is chosen (may be the center of the frame), then 18 sectors are built from that center to the larger circle of the annulus, which is contained in the frame. The fix for the assumed center is calculated as the sum of the average radius times the cosine (in x) and sine (for y) sectors around the circle. The center is shifted to there and the process repeated. In another words, the new coordinates obtained, original center plus delta x and delta y, must to shift the original center closer to the correct center of mass. However the operation should be performed some times until convergence is complete or that the residual value is less than or equal to 1 pixel. This should probably happen after two or three interactions, depending of course the amount initially chosen for the original center. So far, the current code is able to find the value delta x and delta y to be added to the center originally preset. My difficulty is define a loop to redo the operation as many times as necessary. I would really appreciate some help to finish this code to obtain the final value of the center of mass coordinates. Thanks for any help... Antonio de Oliveira 2015-12-23T18:26:51Z https://community.wolfram.com/groups/-/m/t/498246 ![Animation showing movement of a rigid body according to Dzhanibekov effect or tennis racket theorem][1] &[Wolfram Notebook][2] [1]: /c/portal/getImageAttachment?filename=fg546ukuhjfgvg5.gif&userId=11733 [2]: https://www.wolframcloud.com/obj/61fabce7-3d2f-4042-8e61-9fe54c4c353e Mariusz Iwaniuk 2015-05-18T11:39:33Z https://community.wolfram.com/groups/-/m/t/2222977 &[Wolfram Notebook][1] [Original]: https://www.wolframcloud.com/obj/8a8fbd01-b0d8-4798-beec-166e0898b2b1 [1]: https://www.wolframcloud.com/obj/5d2efdc4-f66c-486b-9f5a-298d70381d5d Jack Madden 2021-03-18T17:28:29Z https://community.wolfram.com/groups/-/m/t/3672762 ![Artemis II trajectory: crewed lunar flyby to launch on April 1, 2026][1] &[Wolfram Notebook][2] [ORIGINAL GIF]: https://community.wolfram.com//c/portal/getImageAttachment?filename=10956ArtemisIItrajectorycrewedlunarflybytolaunchonApril1,2026.gif&userId=20103 [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=4398testing2-optimize.gif&userId=20103 [2]: https://www.wolframcloud.com/obj/1f4c613a-e72e-487b-9b5a-c75613d8a099 Jeffrey Bryant 2026-03-31T21:27:57Z https://community.wolfram.com/groups/-/m/t/463610 &[Wolfram Notebook][1] [1]: https://www.wolframcloud.com/obj/2fb30490-e074-40c2-99f3-80634810ef4d Vitaliy Kaurov 2015-03-20T17:02:11Z https://community.wolfram.com/groups/-/m/t/2017849 #Introduction One of the most thrilling parts in Nolan's movie "Interstellar" is the black hole Gargantua and its accretion disk. Its weird shape has surely attracted lots of attention. But do black holes and their accretion disks actually look like that? Not exactly. ![BH and accretion disk in Interstellar][1] In the paper "Gravitational lensing by spinning black holes in astrophysics, and in the movie Interstellar", the authors say that in the movie, redshift and blueshift, as well as the intensity difference is ignored to prevent confusion to the audience. So, although the outline of the accretion disk in "Interstellar" is accurate, the color and the intensity are not. Furthermore, even in the paper, effects brought by the time delay in the propagation of light are ignored, and the influence of gravity lensing on light intensity is simplified. Though I cannot easily render a spinning black hole (Kerr black hole), what I can do is try to render an accretion disk around a Schwarzschild black hole, and as physically correct as possible. The result would be something like this (observer static at 6 times the Schwarzschild radius): ![my rendering result, static observer][2] I strongly recommend you to see the videos at [Bilibili](https://www.bilibili.com/video/BV1Fp4y1S7EF) or [Youtube](https://www.youtube.com/watch?v=Dux1NkTaqwo) (Both have English subtitles) first to have a first impression, and it would be the best if you can click the vote up button XD. After that, If you would like to know more about the Mathematica realization and physical principles behind the scene, please continue. **A disclaimer first:** I know nothing about accretion disk physics, so the property of accretion disks are set arbitrarily. Furthermore, actual accretion disks are actually blazingly bright, and you would be blind instantly if you are looking at it from a short distance, so I have to make some modifications. #Analytics ###Physics Perspective First, we need to analyze this problem from the physics perspective, get to know about the problems we should consider. **For observers**, the intensity of light is determined by how much photons reached their eye in a certain angle range, and the color is determined by the spectrum of the light. However, the orientation, spectrum, and intensity of light beams can be influenced by the observer's movement, so we have to consider that. Naturally, the next question should be, where the light comes? Well, all the light must have come from some **light-emitting materials**, so we have to consider the light-emitting materials' property and movement. But the **light should travel** for some time and distance before reaching the observer's eye. This process involves tracing the light from the emitter to the observer to determine the direction of light the observer perceived, as well as how much portion of light can reach the observer's eyes. Till now, we have already listed out all effects, from the emission to the perception, which could influence our view, so I believe this rendering is "physically accurate". ### Programming Perspective But view from the programming perspective, the zeroth problem should be how lights travel around a black hole: we need the light path to calculate all other effects. Then, based on the light path, we can directly compute the equivalent of "brighter when closer" rule, as well as the time delay between light emission and observation. If combined with the movement of the light-emitting materials and the observer, we can compute the redshift and the blueshift. #Details, Theory, Coding and Results Now let's assume that we are stationary observers viewing from 6 times the Schwarzchild radius. ##Ray Tracing The first problem to solve is tracing the light beam. Light bends around black holes following the geodesics, and the most apparent consequence of this would be that the accretion disk we see would not be on a plane, but rather curved and bent. Fortunately for us, because Schwartzchild black holes are spherically symmetric, we can reduce the problem to 2D. The parametric equation of geodesics around a Schwarzschild black hole can be derived as follows: $$ \left\{ \begin{aligned} t''(\lambda)&=\frac{R_s r' t'}{R_s r-r^2}\\ r''(\lambda)&=\frac{-R_s r^2 r'^2-2r^3\theta'^2(R_s-r)^2+R_s(R_s-r)^2t'^2}{2r^3(R_s-r)}\\ \theta''(\lambda)&=-\frac{2r'\theta'}{r} \end{aligned} \right. $$ Where $\lambda$ is the ray parameter. Now we construct a set of light which originates from the observer, and trace them backward: ![Possible light paths][3] ![Definition of variables][4] ![How interpolation works][5] On each ray, we take some sample points and record the corresponding angle $\theta_0$, $\theta_1$, and time $\Delta T$. By interpolating them, we know about how a random object will look like in our eyes. (*Initial definitions*) Rs = 1; R0 = 6 Rs; Rmax = 6 Rs + 1.*^-6; (*Tracking the light*) parfunc = ParametricNDSolveValue[{{tt''[\[Tau]], rr''[\[Tau]], \[Theta]\[Theta]''[\[Tau]]} == {( Derivative[1][rr][\[Tau]] Derivative[1][tt][\[Tau]])/( rr[\[Tau]] - rr[\[Tau]]^2), ( rr[\[Tau]]^2 Derivative[1][ rr][\[Tau]]^2 - (-1 + rr[\[Tau]])^2 Derivative[1][ tt][\[Tau]]^2)/( 2 (-1 + rr[\[Tau]]) rr[\[Tau]]^3) + (-1 + rr[\[Tau]]) Derivative[1][\[Theta]\[Theta]][\[Tau]]^2, -(( 2 Derivative[1][rr][\[Tau]] Derivative[ 1][\[Theta]\[Theta]][\[Tau]])/rr[\[Tau]])}, {tt'[0], rr'[0], \[Theta]\[Theta]'[ 0]} == {1/(1 - Rs/R0), -Cos[\[Theta]0], Sqrt[1/(1 - Rs/R0)]/R0 Sin[\[Theta]0]}, {tt[0], rr[0], \[Theta]\[Theta][0]} == {0, R0, 0}, WhenEvent[ 1.01 Rs >= rr[\[Tau]] || rr[\[Tau]] >= Rmax || \[Theta]\[Theta][\[Tau]] >= 3.1 Pi, "StopIntegration"]}, {tt[\[Tau]], rr[\[Tau]], \[Theta]\[Theta][\[Tau]]}, {\[Tau], 0, 1000}, {\[Theta]0}]; (*data used in interpolation*) datp = Catenate@ Table[With[{pf = parfunc[\[Theta]]}, With[{\[Tau]max = pf[[1, 0, 1, 1, 2]], df = D[Rest@pf, \[Tau]], f = Rest@pf}, Block[{\[Tau] = Range[RandomReal[{0, \[Tau]max/500}], \[Tau]max, \[Tau]max/ 500]}, Select[ Thread[(Thread@f -> Thread@{\[Theta], ArcTan[-df[[1]], df[[2]] f[[1]] Sqrt[1 - Rs/f[[1]]]], pf[[1]]})], 2.4 Rs < #[[1, 1]] < 5.6 Rs && -0.05 Pi < #[[1, 1]] < 3.08 Pi &]]]], {\[Theta], Range[-2.5 Degree, 80 Degree, 1 Degree]~Join~ Range[20.2 Degree, 28.2 Degree, 0.5 Degree]~Join~ Range[23.025 Degree, 24.05 Degree, 0.05 Degree]~Join~ Range[23.2825 Degree, 23.4 Degree, 0.005 Degree]~Join~ Range[23.28525 Degree, 23.30025 Degree, 0.001 Degree]}]; datp = First /@ GatherBy[datp, Floor[#[[1]]/{0.01 Rs, 1 Degree}] &]; (*Construct InterpolatingFunctions*) ReceiveAngleFunction = Interpolation[Thread[{datp[[;; , 1]], datp[[;; , 2, 1]]}], InterpolationOrder -> 1]; EmitAngleFunction = Interpolation[Thread[{datp[[;; , 1]], datp[[;; , 2, 2]]}], InterpolationOrder -> 1]; DelayFunction = Interpolation[Thread[{datp[[;; , 1]], datp[[;; , 2, 3]]}], InterpolationOrder -> 1]; (*Angle vs time of observation*) GenerateAngleFunctions[R1_, \[Theta]1_] := Block[{\[Phi]1}, With[{interpol = Interpolation@ Table[{DelayFunction[R1, #] + Sqrt[2 R1^3] \[Phi]1, \[Phi]1}, {\[Phi]1, 0., 2 Pi, 10. Degree}]}, With[{ts = interpol[[1, 1, 1]], tperiod = 2. Pi Sqrt[2 R1^3]}, Function[t, interpol[t - Floor[t - ts, tperiod]]]]] & /@ ({#, 2 Pi - #, 2 Pi + #} &@ArcCos[Sin[\[Phi]1] Sin[\[Theta]1]])] If we only consider this effect, then we will have something like this: ![Light bending included][6] The inner two rings correspond to the light that rotates around the black hole for more than half a round. And if we consider the propagation time of light, the right side will be a bit brighter. ![Time correction included][7] This is because on the right, objects are moving away from you. So from your point of view, these particles will stay for a longer time on the right. (The reason is explained in the figure) ![Illustration of how velocity influence timing][8] ##"Brighter when Closer" The next question is about the "brighter when closer" rule. We all know that the further a bulb is, the dimmer it would appear to be. This is because the light from the bulb is approximately evenly distributed across solid angles, but as we move further, the solid angle corresponding to our eyes will be smaller. Mathematically, this is saying $I\propto S_0 \frac{d\Omega}{dS}$ where $S_0$ is the surface area of our eyes, $S$ is area, and $\Omega$ is the solid angle. !["Brighter when closer" rule in flat space][9] The same rules apply here in curved spacetime, except the light beams are weirder. !["Brighter when closer" rule in curved space][10] We know that $\frac{d\Omega}{dS}=(\frac{dx}{d\theta_x}\frac{dy}{d\theta_y})^{-1}$. While $\frac{dy}{d\theta_y}=\frac{R_0 \sin \alpha}{\sin \theta_1}$ can be derived using basic solid geometry, $\frac{dx}{d\theta_x}$ must be calculated numerically by tracing the light from the object to the observer. Similarly, we use interpolating function to generalize the result from a set of sample points to the whole space. (*Reverse ray tracing*) parfuncrev = ParametricNDSolveValue[{{tt''[\[Tau]], rr''[\[Tau]], \[Theta]\[Theta]''[\[Tau]]} == {( Derivative[1][rr][\[Tau]] Derivative[1][tt][\[Tau]])/( rr[\[Tau]] - rr[\[Tau]]^2), ( rr[\[Tau]]^2 Derivative[1][ rr][\[Tau]]^2 - (-1 + rr[\[Tau]])^2 Derivative[1][ tt][\[Tau]]^2)/( 2 (-1 + rr[\[Tau]]) rr[\[Tau]]^3) + (-1 + rr[\[Tau]]) Derivative[1][\[Theta]\[Theta]][\[Tau]]^2, -(( 2 Derivative[1][rr][\[Tau]] Derivative[ 1][\[Theta]\[Theta]][\[Tau]])/rr[\[Tau]])}, {tt'[0], rr'[0], \[Theta]\[Theta]'[0]} == {1/(1 - Rs/R1), Cos[\[Theta]0], -Sqrt[1/(1 - Rs/R1)]/R1 Sin[\[Theta]0]}, {tt[0], rr[0], \[Theta]\[Theta][0]} == {0, R1, \[Theta]1}, WhenEvent[\[Theta]\[Theta][\[Tau]] == 0, "StopIntegration"]}, {tt[\[Tau]], rr[\[Tau]], \[Theta]\[Theta][\[Tau]]}, {\[Tau], 0, 100}, {\[Theta]0, R1, \[Theta]1}]; (*data used in interpolation*) \[CapitalDelta]\[Phi] = 1.*^-5; intensity = Catenate@Table[{{R, \[Theta]}, R0^2 With[{\[Theta] = Abs[\[Theta]]}, Abs[Sin[EmitAngleFunction[ R, \[Theta]]]/(R0 \ Sin[\[Theta]])]*(\[CapitalDelta]\[Phi]/(Sin[ ReceiveAngleFunction[R, \[Theta]]]* Subtract @@ (With[{f = parfuncrev[ EmitAngleFunction[ R, \[Theta]] + # \[CapitalDelta]\[Phi], R, \[Theta]][[2, 0]]}, f@f[[1, 1, -1]]] & /@ {-1, 1})))]}, {R, 2.45 Rs, 5.55 Rs, 0.02 Rs}, {\[Theta], -3 Degree, 543 Degree, 2 Degree}]; (*Construct InterpolatingFunction*) IntensityFunction1 = Interpolation[intensity]; ![With intensity correction 1][11] The figure will be much more realistic in the aspect of intensity after we added this effect. The inner two rings are much dimmer because light bent dramatically is rare after all. ##Doppler Effect and Headlight Effect Now its time for Doppler effect and headlight effect. These two effects are related to the movement of light-emitting objects and observers. Though the names of these effects can be forbidding, these effects are quite common in everyday life. Blueshift refers to the phenomenon that when a car is approaching you, the noise made by the car would be more acute and loud, and redshift means when the car is leaving you, the noise would quieter and be of lower frequency. ![Doppler effect][12] The equation for the relativistic Doppler effect is: $$ f'=f\frac{\sqrt{1-\beta^2}}{1-\beta \cos \theta} $$ where $\beta=\frac{v}{c}$ and $\theta$ is the angle between the velocity direction of the light-emitting object and the light emitted, as observed by an external observer. In this case, we should further add a coefficient of $$ f''=f'\sqrt{\frac{1 - R_s/R_1}{1 - R_s/R_0}} $$ due to general relativistic effects. Headlight effect means when you are driving a car on rainy days, no matter how the wind blows, the raindrops will always run towards the windshield. But if you stop your vehicle, you can see how the wind influences the dropping direction of rain. ![Headlight effect][13] The equation for angle transformation is: $$ \cos \theta'= \frac{\cos \theta +\beta}{1+\beta \cos \theta} $$ and such, the intensity difference introduced by this can be written as: $$ \frac{dP'}{d\Omega}= \frac{dP}{d\Omega}\frac{\sin \theta}{\sin \theta'}\frac{d \theta}{d \theta'}=\frac{dP}{d\Omega}\frac{1 - \beta^2}{(1 -\beta \cos \theta)^2} $$ Except for the difference in timing brought by the curved spacetime, these two effects are purely in the special relativity regime. The only thing involved in coding is tedious coordinate transformation. (*Calculate moving speed*) Calc\[Beta][{R1_, \[Theta]_, \[Phi]_}, {vr_, v\[Theta]_, v\[Phi]_}] := Sqrt[vr^2/(1 - Rs/R1) + (R1 v\[Theta])^2 + (R1 Sin[\[Theta]] v\[Phi])^2]/ Sqrt[1 - Rs/R1] (*Calculate inner product between moving direction and light direction*) CalcCosAngle[{R1_, \[Theta]_, \[Phi]_}, {vr_, v\[Theta]_, v\[Phi]_}] := With[{v = {vr/Sqrt[1 - Rs/R1], R1 v\[Theta], R1 Sin[\[Theta]] v\[Phi]}}, MapThread[With[{\[Theta]0 = EmitAngleFunction[R1, #1]}, With[{vnormed = MapThread[Normalize@*List, v]}, MapThread[ Dot, {vnormed, Thread@{Cos[\[Theta]0], #2 Sin[\[Theta]0], 0}}, 1]]] &, {{\[Theta], 2 Pi - \[Theta], 2 Pi + \[Theta]}, {-1, 1, -1}}]] (*Frequency shift, Doppler effect + GR timing effects*) FrequencyMult[R1_, \[Beta]_, cos_] := Sqrt[(1 - Rs/R1)/(1 - Rs/R0)]*Sqrt[1 - \[Beta]^2]/(1 - \[Beta] cos) (*Intensity shift due to headlight effect only*) IntensityMult2[\[Beta]_, cos_] := (Sqrt[1 - \[Beta]^2]/(1 - \[Beta] cos))^2 Then we can put all these effects together and see how things works out! << PhysicalColor` IntensityFunctionScaling::usage = "Scale Intensity."; Protect@IntensityFunctionScaling; Options[RenderFunc] = {ColorFunction -> TemperatureColor, ColorFunctionScaling -> (# &), IntensityFunctionScaling -> (# &), "StaticObserver" -> True}; RenderFunc[R1_, {\[Theta]1_, t1_, \[Gamma]1_}, {T0_, I0_}, OptionsPattern[]] := Function[t, Through[#[t]]] &@Module[{ (*Velocity of observer*) vobs = N@Sqrt[(1 - Rs/R0) Rs/(2 R0)], (*list of \[Phi]1 parameters*) \[Phi]1l = Range[0., 2 Pi, 1 Degree], (*Polar coordinates \[Theta] and \[Phi]*) \[Theta]l0, \[Phi]l0, (*velocity of object and its norm*) vrl, v\[Theta]l, v\[Phi]l, vnorml }, (*Polar coordinate \[Theta]*) \[Theta]l0 = ArcCos[Sin[\[Phi]1l] Sin[\[Theta]1]]; (*Original \[Phi]*) \[Phi]l0 = ArcTan[Cos[\[Phi]1l], Sin[\[Phi]1l] Cos[\[Theta]1]] + \[Gamma]1; (*velocity of object*) vrl = ConstantArray[0, Length@\[Phi]1l]; v\[Theta]l = -(Cos[\[Phi]1l] Sin[\[Theta]1])/ Sqrt[1 - Sin[\[Theta]1]^2 Sin[\[Phi]1l]^2]*Sqrt[Rs/(2 R1^3)]; v\[Phi]l = 1/(Cos[\[Phi]1l]^2/Cos[\[Theta]1] + Cos[\[Theta]1] Sin[\[Phi]1l]^2)*Sqrt[Rs/(2 R1^3)]; (*velocity norm*) vnorml = Calc\[Beta][{R1, \[Theta]l0, 0}, {vrl, v\[Theta]l, v\[Phi]l}]; MapThread[Module[{ (*Observed \[Phi]1 parameter - t*) \[Phi]1t = #3, (*actual \[Theta] of object*) \[Theta]l = #1, (*angle between velocy and ray*) cosl = #4, (*Observed values - \[Phi]1*) (*Geometry*) \[Theta]obsl, \[Phi]obsl = \[Phi]l0 + #2, (*Frequency and intensity shift*) freqobsl, intobsl, (*helper function*) helpf }, \[Theta]obsl = ReceiveAngleFunction[R1, \[Theta]l]; (*Frequency*) freqobsl = FrequencyMult[R1, vnorml, cosl]; (*Process with the non-static observer*) If[OptionValue["StaticObserver"] =!= True, Module[{\[Theta]transl, \[Phi]transl, \[Delta] = ArcSin[vobs]}, (*Geometrics, static frame*) \[Theta]transl = ArcCos[Sin[\[Theta]obsl] Cos[\[Phi]obsl]]; \[Phi]transl = ArcTan[Sin[\[Theta]obsl] Sin[\[Phi]obsl], Cos[\[Theta]obsl]]; (*Frequency shift due to movement of observer, intensity shift is calculated together later*) freqobsl *= (1 + vobs Cos[\[Theta]transl])/Sqrt[1 - vobs^2]; (*Angle shift due to movement of observer*) \[Theta]transl = ArcCos[(vobs + Cos[\[Theta]transl])/(1 + vobs Cos[\[Theta]transl])]; (*Transform back*) (*Here we change the center of viewing angle so that the \ black hole's center is at {0,0}*) \[Theta]obsl = ArcCos[Sin[\[Delta]] Cos[\[Theta]transl] + Cos[\[Delta]] Sin[\[Theta]transl] Sin[\[Phi]transl]]; \[Phi]obsl = ArcTan[Cos[\[Delta]] Cos[\[Theta]transl] - Sin[\[Delta]] Sin[\[Theta]transl] Sin[\[Phi]transl], Sin[\[Theta]transl] Cos[\[Phi]transl]] ] ]; \[Phi]obsl = Catenate[ MapIndexed[#1 + 2 Pi #2[[1]] &, Split[\[Phi]obsl, Less]]]; (*Intensity*) intobsl = freqobsl^2*IntensityFunction1[R1, \[Theta]l]* IntensityMult2[vnorml, cosl]* TemperatureIntensity[freqobsl T0]/TemperatureIntensity[T0]/ freqobsl^4; (*Helper function to construct interpolating functions*) helpf[l_] := Interpolation[Thread[{\[Phi]1l, l}]]; With[{ cf = OptionValue[ColorFunction], (*Interpolating functions*) t11 = t1, \[Phi]1f = #3, \[Theta]func = helpf[\[Theta]obsl], \[Phi]func = helpf[\[Phi]obsl], freqfunc = helpf[OptionValue[ColorFunctionScaling][T0 freqobsl]], intfunc = helpf[OptionValue[IntensityFunctionScaling][I0 intobsl]] }, (*Final function*) Function[t, With[{\[Phi]11 = \[Phi]1f[t + t11]}, {Append[cf[freqfunc[\[Phi]11]], intfunc[\[Phi]11]], With[{\[Theta] = \[Theta]func[\[Phi]11], \[Phi] = \ \[Phi]func[\[Phi]11]}, (*Point[{Sin[\[Theta]]Cos[\[Phi]],Sin[\[Theta]]Sin[\[Phi]], Cos[\[Theta]]}]*) Point[Tan[\[Theta]] {Cos[\[Phi]], Sin[\[Phi]]}]]} ]] ] ] &, {{\[Theta]l0, 2 Pi - \[Theta]l0, 2 Pi + \[Theta]l0}, {0, Pi, 0}, GenerateAngleFunctions[R1, \[Theta]1], CalcCosAngle[{R1, \[Theta]l0, 0}, {vrl, v\[Theta]l, v\[Phi]l}]}]] (*My version of rasterize, which increase color precision in dimmer areas*) HDRRasterize[gr_Graphics, convertfunc_, opts : OptionsPattern[Rasterize]] := Module[{rasterl = Join[ColorSeparate[ColorConvert[Rasterize[gr, opts], "HSB"]], ColorSeparate[ ColorConvert[ Rasterize[ gr /. RGBColor[r_, g_, b_, op_] :> RGBColor[r, g, b, 16 op], opts], "HSB"]]], mask, invmask}, mask = Binarize[rasterl[[3]], 1/16]; invmask = 1 - mask; ColorCombine[{ mask*rasterl[[1]] + invmask*rasterl[[4]], mask*rasterl[[2]] + invmask*rasterl[[5]], mask*convertfunc[rasterl[[3]]] + invmask*convertfunc[rasterl[[6]]/16.]}, "HSB"] ] (*Preliminary computation*) npts = 5000; rflist = MapThread[ Function[{R1, \[Theta]1, t1, \[Gamma]1, T0, I0}, RenderFunc[R1, {\[Theta]1, t1, \[Gamma]1}, {T0, I0}, "StaticObserver" -> False(*, IntensityFunctionScaling\[Rule](.7(#/.5)^0.5&)*)]], {RandomReal[{3, 4.5}, npts], RandomReal[-{83, 86} Degree, npts], RandomReal[{0, 10000}, npts], RandomReal[15 Degree + {-2, 2} Degree, npts], RandomReal[{4000, 10000}, npts], RandomReal[{.03, .1}, npts] } ]; (*rendering!!!*) g = Graphics[{(*AbsolutePointSize@.1,White,Point[{Sin[20Degree]Cos[#], Sin[20Degree]Sin[#],Cos[20Degree]}&/@Range[0.,360.Degree, 60.Degree]],*)AbsoluteThickness@2, Map[Line[#[[;; , 2, 1]], VertexColors -> MapThread[ Function[{col, len, mult}, MapAt[mult^2*#*0.006/len &, col, 4]], {#[[;; , 1]], Prepend[#, #[[1]]] &@ BlockMap[Norm[#[[2]] - #[[1]]] &, #[[;; , 2, 1]], 2, 1], Subdivide[Length[#] - 1]}]] &, Reverse@Transpose[ Through[rflist[#]] & /@ (Range[0, 3, .1]), {3, 2, 1}], {2}]}, Background -> Black, ImageSize -> {500, Automatic}, PlotRange -> {{-1.28, 1.28}, {-0.72, 0.72}}]; HDRRasterize[g, #^(1/2.2) &, ImageSize -> {1920, 1080}] ![With all effects, static observer][14] Well, because objects at left are moving towards you, they will appear much brighter and blue-ish, while objects at right are much dimmer and red-ish. We can also consider the movement of the observer, which will make the image something like this: ![With all effects, observer moving][15] Hooray! The notebook can be found in the attachment or at [my github repo](https://github.com/wjxway/Realistic_Blackhole_Accretion_Disk). [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=bh10.png&userId=1340903 [2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=T_001.png&userId=1340903 [3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Path_4.png&userId=1340903 [4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=illus2.png&userId=1340903 [5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=illus1.png&userId=1340903 [6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=LightBending.png&userId=1340903 [7]: https://community.wolfram.com//c/portal/getImageAttachment?filename=WithTimeCorrection.png&userId=1340903 [8]: https://community.wolfram.com//c/portal/getImageAttachment?filename=illus3.png&userId=1340903 [9]: https://community.wolfram.com//c/portal/getImageAttachment?filename=IntensityIllus.png&userId=1340903 [10]: https://community.wolfram.com//c/portal/getImageAttachment?filename=illus4.png&userId=1340903 [11]: https://community.wolfram.com//c/portal/getImageAttachment?filename=WithIntensity1.png&userId=1340903 [12]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Doppler.jpg&userId=1340903 [13]: https://community.wolfram.com//c/portal/getImageAttachment?filename=FrontLight.jpg&userId=1340903 [14]: https://community.wolfram.com//c/portal/getImageAttachment?filename=WithAllEffects.png&userId=1340903 [15]: https://community.wolfram.com//c/portal/getImageAttachment?filename=WithObserverMoving.png&userId=1340903 Jingxian Wang 2020-07-02T11:26:03Z https://community.wolfram.com/groups/-/m/t/440994 Dear friends, I have a lot of Raw images in .NEF format (NIKKON). So, I read the section : [http://reference.wolfram.com/language/LibraryLink/tutorial/ImageProcessing.html][1] But I did not understand how implement these libraries in order to work with .NEF extension images, for astrophotography. EDIT 1: a sample of image *.NEF: [https://www.dropbox.com/s/2n5y5xjhhqeh7k0/DSC_5133.NEF?dl=0][2] [1]: http://reference.wolfram.com/language/LibraryLink/tutorial/ImageProcessing.html [2]: https://www.dropbox.com/s/2n5y5xjhhqeh7k0/DSC_5133.NEF?dl=0 Marcelo De Cicco 2015-02-12T13:19:44Z https://community.wolfram.com/groups/-/m/t/1500089 I am using Mathematica 10.3. I want fo perform a computational analysis of the motion of the Earth around the sun based on Kepler’s laws. Here is my code so far. eulerStep[{t_, state_List}, h_, f_List] := {t + h, state + h Through[f[{t, state}]]} solveSystemEuler [{t0_state0 _}, h_, n_Integer, f_List] := NestList[eulerStep[#, h, f] &, {t0, state0}, n] midptStep[{t_, state_List}, h_, f_List] := {t + h, state + h Through[ f[{t + 1/2 h, state + 1/2 h Through[f[{t, state}]]}]]} solveSytemMidPt[{t0_, state0_}, h_, n_Integer, f_List] := NestList[midptStep[#, h, f] &, {t0, state0}, n] L = 1/2 m (x'[t]^2 + y'[t]^2) + GMm/Sqrt[x[t]^2 + y[t]^2]; D[D[L, x'[t]], t] - D[L, x[t]] == 0 D[D[L, y'[t]], t] - D[L, y[t]] == 0 xdot[{t_, {x_, vx_, y_, vy_}}] := vx vxdot[{t_, {x_, vx_, y_, vy_}}] := -x/(x^2 + y^2)^(3/2) ydot[{t_, {x_, vx_, y_, vy_}}] := vy vydot[{t_, {x_, vx_, y_, vy_}}] := -y/(x^2 + y^2)^(3/2) start = {1, 0, 0, 1}; fcns = {xdot, vxdot, ydot, vydot}; orbit = solveSystemEuler[{0, start}, 0.01, 800, fcns]; << Statistics`DataManipulation` xypts = Column[Column[orbit, 2], {1, 3}]; ListPlot[xypts, PlotJoined -> True]; Running the program gave the following error messages. ![enter image description here][1] Please help me to fix my code. [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Capture.JPG&userId=1499975 Senlau Minto 2018-10-08T03:45:10Z https://community.wolfram.com/groups/-/m/t/2040012 I Have two set of data separately, which one of them is pressure and the other one is energy density.(P: pressure, E: energy density) I want to use these data as a function, P(E) or E(P) by utilizing an Interpolation between them. Could you please help me that how I can make a function of these data? For instance in Matlab I wrote the codes below and they work well. E=interp1(Data(:,2),Data(:,1),P); P=interp1(Data(:,1),Data(:,2),E); Regarding the codes in Matlab, I have a Matrix named Data which the first column is related to energy density and the second column is for pressure. In fact, by the codes above in Matlab, I could give an arbitrary pressure and then the result is the corresponding energy density or vice versa. For my Mathematica code, I separated the columns of the matrix mentioned above into two data as two Excel files. Then these two files were imported in the notebook in order to make an interpolation between them to utilize it as a function. Indeed the interpolation between energy density and pressure could work like a function which gives pressure in terms of energy density or vice versa. My question is that how I can write such a code in Mathematica. Davood Rafiei 2020-07-19T13:13:11Z https://community.wolfram.com/groups/-/m/t/574455 Please find attached a small routine that plots the intensity profile between two points in a circular image. I'd like a routine that was able to make several radial routes, such as the example, from the center of the image to its exterior. Perhaps with an adjustable angular variation. I am very grateful for any help. Antonio ![enter image description here][1] [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=sdf34546ygrwefads.png&userId=11733 Antonio de Oliveira 2015-10-02T19:52:07Z https://community.wolfram.com/groups/-/m/t/3545275 ![Bloom pattern for flat-foldable origami orbital solar sail or solar shield][1] &[Wolfram Notebook][2] [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=8711FoldingPanel1.gif&userId=20103 [2]: https://www.wolframcloud.com/obj/d629766d-966c-4dcb-8880-894747e31c6d Gilmer Gary 2025-09-14T03:12:52Z https://community.wolfram.com/groups/-/m/t/2740397 &[Wolfram Notebook][1] [1]: https://www.wolframcloud.com/obj/2d627ca1-036a-4d6e-afaa-bd73bd641674 Jose Martin-Garcia 2022-12-21T15:37:36Z https://community.wolfram.com/groups/-/m/t/533151 Here is my code: (* Take inputs for ECEF *) x = Input["What is the x coordinate?"]; y = Input["What is the y coordinate?"]; z = Input["What is the z coordinate?"]; (* Put in Coordinate Form *) GeoPositionXYZ[{x, y, z}, "ITRF00"]; (* Convert to LLA *) GeoPosition[%] (* Display Map *) GeoGraphics[GeoMarker[GeoPosition[%]],GeoRange -> "World", GeoProjection -> "Robinson"] It lets me input coordinates for one point in ECEF, then converts it to latitude/longitude/height and shows it on a map. I want to keep showing the 2d map... but I also want to show a 3d globe that locates the coordinates on the 3d cartesian plane also. I need to be able to put in more than one coordinate. It needs to keep asking for more x's, more y's, more z's... until I stop inputting them. Eventually it's going to be modified to pull them out of a text file, but for now these two changes need to be made. Any ideas/hints/help/guidance is appreciated. Thanks. Nathan Lundholm 2015-07-20T07:16:28Z https://community.wolfram.com/groups/-/m/t/462064 &[Wolfram Notebook][1] [1]: https://www.wolframcloud.com/obj/dae2b70e-000e-4df5-968f-a9ae0f563eae Jeffrey Bryant 2015-03-18T19:34:05Z https://community.wolfram.com/groups/-/m/t/1306910 ![Saturn Flyby: Detailed Simulation][1] Creating a flyby simulation of a planetary scene in 3D involves multiple steps. This post walks you through the steps used to create the [final animation][2] (click this link or image below to play). I strongly recommend you watch the video in **full screen mode** with low lights so that all of the detail is visible. Some of it is subtle. [![enter image description here][3]][4] The Vimeo video hosting service has a habit of auto-advancing to the next video, but what it chooses as the next one is often strange in my opinion, so be prepared to click the back button to replay it. **Creating the Planet** Saturn can be treated as an oblate spheroid which we can model in the Wolfram Language using [ParametricPlot3D][5] and textures. [EntityValue][6] can give us a few pointers to get things scaled properly. First, we need to know the equatorial radius of the planet and its oblateness (e.g. how flattened it is at the poles compared to the equator). saturnradius = QuantityMagnitude[Entity["Planet", "Saturn"]["EquatorialRadius"], "Kilometers"]; saturnoblateness = Entity["Planet", "Saturn"]["Oblateness"]; texture = ImageReflect[EntityValue[Entity["Planet", "Saturn"], "CylindricalEquidistantTexture"], Bottom]; With the data above, we can construct a ParametericPlot3D of an oblate spheroid scaled to the dimensions of Saturn. We use the curated data from above to perform the scaling. planet = ParametricPlot3D[{saturnradius Cos[t] Sin[p], saturnradius Sin[t] Sin[ p], (1 - saturnoblateness) saturnradius Cos[p]}, {t, 0, 2 Pi}, {p, 0, \[Pi]}, Mesh -> None, PlotStyle -> Texture[texture], Lighting -> "Neutral", Boxed -> False, Axes -> False, PlotPoints -> 100] ![enter image description here][7] **Creating the Rings** The rings of Saturn lie along a plane and can be modeled as an annulus with radial color and opacity variation. We make use of a texture obtained from https://www.classe.cornell.edu/~seb/celestia/hutchison/saturn-rings.png and stored as a [CloudObject][8] in the Wolfram Cloud and use ParametricPlot3D to apply this color and opacity texture to the annulus. ringalpha = Import[ CloudObject[ "https://www.wolframcloud.com/objects/4e39f856-1c09-44d1-b2a9-\ 00ffd480b6dd"]]; ringinnerradius = 74510; ringouterradius = 140390; rings = ParametricPlot3D[{r Cos[t], r Sin[t], 0}, {r, ringinnerradius, ringouterradius}, {t, 0, 2 Pi}, Mesh -> None, PlotStyle -> Texture[ringalpha], PlotPoints -> 100] ![enter image description here][9] **Creating a Star Backdrop** To give some additional subtle detail, we can provide more sense of motion and context for the opacity variations in the rings by providing a backdrop of stars. We make use of EntityValue to obtain position and brightness data for stars visible to the naked-eye (nearly 9,000 stars). This takes a couple minutes depending on your network connection. In[9]:= stardata = EntityValue[ EntityClass["Star", "NakedEyeStar"], {"RightAscension", "Declination", "ApparentMagnitude"}]; In[10]:= stardata // Length Out[10]= 8910 To make use of the previous data in a graphical setting, we need to convert the [Quantity][10] objects to numbers in radians and also rescale the apparent magnitude brightness values to [GrayLevel][11] values between 0 and 1. We round the values of apparent magnitude since we want to optimize the rendering to make use of multi-point primitives later. Takes about a minute to convert the data into the necessary format. In[11]:= triples = With[{magrange = MinMax[stardata[[All, 3]]]}, {-QuantityMagnitude[#[[1]], "Radians"], QuantityMagnitude[#[[2]], "Radians"], Rescale[Round[#[[3]]], magrange, {1, .1}]} & /@ stardata]; Next, we group the stars based on their rounded values. In[12]:= gb = GatherBy[triples, #[[3]] &]; We construct the star background primitives by converting the right ascension and declination values into Cartesian spherical coordinates and place them far enough outside of the Saturn system, 8 ring radii, that they can serve as a spherical backdrop assuming our camera stays inside this distance. Each magnitude value gets a specific GrayLevel and set of points with a single [Point][12] head. In[13]:= stars = With[{r = 8 ringouterradius}, {GrayLevel[#[[1, 3]]], Point[{-r Cos[#[[1]]] Sin[#[[2]] + Pi/2], r Sin[#[[1]]] Sin[#[[2]] + Pi/2], -r Cos[#[[2]] + Pi/2]} & /@ #]}] & /@ gb; We can then assemble the star backdrop and assign a specific [PointSize][13] to all stars, using GrayLevel, not size, to represent brightness variations. In[14]:= starscene = Graphics3D[{PointSize[.004], stars}]; **Defining the Flight Path** The flightpath is a simple straight line. Its starts "in front" of Saturn at 4 ring radii out, and always keeps the camera pointed at the planet. The position of the camera changes with time. We construct the path using [Interpolation][14], one for each Cartesian coordinate. As time progresses, the y-coordinate extends out to the side of Saturn so we don't hit it. We also modify the z-coordinate to start above the ring plane and drop below it at the end. xfun = Interpolation[{4 ringouterradius, 3 ringouterradius, 2 ringouterradius, ringouterradius, 0, -ringouterradius}]; yfun = Interpolation[{0, ringouterradius, 2 ringouterradius, 3 ringouterradius, 4 ringouterradius, 4 ringouterradius}]; zfun = Interpolation[{4 saturnradius, 3 saturnradius, 2 saturnradius, 1 saturnradius, 0, -1 saturnradius}]; **Assembling the Scene and Generating Frames** We can render an initial scene to get a sense of how it will look. We specify a point light source to look as if the system is being illuminated by the Sun from the "front". gr = Show[{planet, Graphics3D[{Lighting -> {{"Ambient", GrayLevel[.33]}}, rings[[1]]}], starscene}, Background -> Black, ImageSize -> .4 {1920, 1080}, SphericalRegion -> True, ViewAngle -> Pi/10, ViewVector -> {{4 ringouterradius, 0, 1 saturnradius}, {0, 0, 0}}, PlotRange -> All, Lighting -> {{"Ambient", GrayLevel[0]}, {"Point", White, {3 ringouterradius, 0, 3 saturnradius}}}] ![enter image description here][15] The first step in animating the scene is to generate a list of frames. The elements are all static, but the camera position changes in time using [ViewVector][16] and making use of the interpolating functions created earlier. The time step is small so that we can obtain enough frames (600) to make the animation play back smoothly. The [ImageSize][17] is set to standard HD resolution. In[19]:= frames = Table[ Show[gr, ViewVector -> {{xfun[t], yfun[t], zfun[t]}, {0, 0, 0}}, ImageSize -> {1920, 1080}], {t, 1, 6 - 1/120, 1/120}]; In[20]:= frames // Length Out[20]= 600 The initial frame can be seen, scaled down, using the following. Stars are more easily seen at full resolution. In[21]:= Show[frames[[1]], ImageSize -> .4 {1920, 1080}] ![enter image description here][18] We need to export the frames to a directory for later assembly. The first step is to set the working directory to the same directory as the notebook. SetDirectory[NotebookDirectory[]]; Finally, we export the frames as PNG files. File names are of the form FrameXXX.png. This step of rasterizing each frame and exporting takes awhile due to the polygon count and opacity in the scene so you will need to be patient. Using [Export][19] to export individual frames, as opposed to generating a Table of frames to be exported in one pass, has at least one major advantage. It allows you to stop, at any point, and see how far you have progressed. You can monitor the directory you are exporting to to see the progress. You can abort the process and continue where you left off later. Do[ Export["Frame" <> ToString[PaddedForm[i - 1, 3, NumberPadding -> "0", NumberSigns -> {"", ""}]] <> ".png", frames[[i]], "PNG"];, {i, 1, 600, 1} ] Once you have the directory of images, you can combine these into whatever video format you prefer. You can even re-import all the frames and export them from the Wolfram Language. Modern video formats are not standardized so leaves you open to a number of choices. I tend to prefer MPEG-4 with an H.264 codec for best quality and compression. Some may prefer a Quicktime animation. The choice is up to you. There are multiple tools available for combining such image sequences that range from command line tools like FFMPEG or packages like Blender. After combining the frames, you can upload the video to your favorite video sharing service such as Vimeo or YouTube. I prefer Vimeo since the compression algorithm they apply seems more optimal for quality. The final animation was already linked in the opening statement, but [here it is again][20]. [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=SaturnFlyby-ezgif.com-optimize.gif&userId=11733 [2]: https://vimeo.com/260948024 [3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Vimeo.png&userId=25355 [4]: https://vimeo.com/260948024 [5]: http://reference.wolfram.com/language/ref/ParametricPlot3D.html [6]: http://reference.wolfram.com/language/ref/EntityValue.html [7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=5996Planet.png&userId=25355 [8]: http://reference.wolfram.com/language/ref/CloudObject.html [9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=7558Rings.png&userId=25355 [10]: http://reference.wolfram.com/language/ref/Quantity.html [11]: http://reference.wolfram.com/language/ref/GrayLevel.html [12]: http://reference.wolfram.com/language/ref/Point.html [13]: http://reference.wolfram.com/language/ref/PointSize.html [14]: http://reference.wolfram.com/language/ref/Interpolation.html [15]: http://community.wolfram.com//c/portal/getImageAttachment?filename=5763init.png&userId=25355 [16]: http://reference.wolfram.com/language/ref/ViewVector.html [17]: http://reference.wolfram.com/language/ref/ImageSize.html [18]: http://community.wolfram.com//c/portal/getImageAttachment?filename=7032Frame1.png&userId=25355 [19]: http://reference.wolfram.com/language/ref/Export.html [20]: https://vimeo.com/260948024 Jeffrey Bryant 2018-03-22T16:09:27Z https://community.wolfram.com/groups/-/m/t/251690 Dear community members, I'm currently try to use Wolfram Mathematica to some gravity research. But i can't find built-in methods do differential geometry calculations in Mathematica. For example, is there any way to compute Einstein or Ricci tensor by metric? Or something more complicate, like create manifold, some medium with fixed state equation and write Einstein equations for this system? Thanks, Boris Latosh Boris Latosh 2014-05-14T18:31:41Z https://community.wolfram.com/groups/-/m/t/2299843 Dear all, when evaluating "HankelH1[n,z]" in Mathematica the resulting real part significantly differs from the result I obtain when I use "scipy.special.hankel1(n,z)" in Python for large values of n. For example, "HankelH1[5,3]" and "scipy.special.hankel1(5,3)" are in sufficient agreement, however for "HankelH1[16,3]" and "scipy.special.hankel1(16,3)" the result significantly differs. Does anybody have an idea why that is the case? Thank you very much. Kind regards D D 2021-06-27T05:37:11Z https://community.wolfram.com/groups/-/m/t/1207400 ![found constellations][9] ## Story Time ## At its first meeting in 1922, the International Astronomical Union (IAU), officially adopted the list of 88 constellations that we use today. These include 14 men and women, 9 birds, two insects, 19 land animals, 10 water creatures, two centaurs, one head of hair, a serpent, a dragon, a flying horse, a river and 29 inanimate objects. As many of us have (frustratingly) witnessed first hand while star-gazing - most of these bear little resemblance to their supposed figures. Instead, it is more likely that the ancient constellation-makers meant them to be symbolic, a kind of celestial "Hall of Fame" for their favorite animals or heroes. This begs two questions I sought to answer with this project: 1. Can we 'do better' now with the WL's StarData[] curated data and Machine Learning functionality? 2. What if the ancient constellation-makers were slightly more creative? Say they looked up at the sky, and only saw yoga-poses! Some examples of the found yoga-pose constellations, projected on images of the night sky are shown here, with a walk-through of the code below: [![example yoga-pose constellations][1]][2] ## Yoga Poses ## First things first, finding images for yoga poses. Turns out, the WL has a built in YogaPose Entity Class with 216(!) available entities and their schematics. A lot of these are very similar (e.g. palms facing up/down) and we therefore only select a subset of them, which differ substantially from each other: yogaposes = EntityClass["YogaPose", All] // EntityList; chosenPoses = List /@ {4, 6, 7, 8, 11, 14, 23, 25, 28, 35, 38, 43, 51, 54, 56, 59, 63, 65, 71, 72, 76, 77, 78, 84, 88, 90, 98, 100, 102, 103, 110, 111, 112, 113, 116, 118, 119, 125, 126, 133, 139, 142, 149, 152, 153, 154, 155, 156, 160, 164, 165, 167, 172, 177, 178, 180, 182, 183, 184, 190, 193, 194, 195, 197, 202, 204, 206, 207, 209, 210, 212, 215, 216}; Shallow[Extract[yogaposes, chosenPoses]] We write a wrapper to ensure the schematics are padded to give a square image and visualize our 73 constellations: makeSquare[gr_, size_, bool_: False] := Block[{range, magnitudes, order, padding, newRanges, res}, range = AbsoluteOptions[gr, PlotRange][[1, 2]]; magnitudes = Abs[Subtract @@@ range]; order = Ordering[magnitudes, 2, Greater]; padding = Subtract @@ magnitudes[[order]]/2; newRanges = {{-1, 1} padding + Last[range[[order]]], First[range[[order]]]}; res = Show[gr, PlotRange -> Reverse@newRanges[[order]], ImageSize -> size]; If[bool, Rasterize[res], res]] Multicolumn[ makeSquare[#["SimplifiedSchematic"], 64] & /@ Most[Extract[yogaposes, chosenPoses]], 9, Frame -> All] ![constellations graphic][3] ## Neural Network ## Our problem now can be worded as a classification one: *given 5-10 stars, classify them as one of the 73 yoga-poses constellations* The problem with that formulation of-course is that 5-10 randomly selected points inside the constellation region isn't specific enough to differentiate between constellations. The image below shows that although 1000 sets of 10 points will define the shape, 10 points alone fall short: ![pointsInMesh][4] Instead, we compute the Voronoi diagram of the points, using DistanceTransform to leverage already-optimized convolutional neural nets used for classifying images. Note that, even if (naturally) the results are less clear with fewer points (left to right) - the result with only 10 points at the far right is still quite recognizable to a human eye: ![distanceTransforms][5] With this in-mind, we create a neural network similar to the [VGG16][6] neural network, with successive 5x5 convolutions, ReLu activation functions and Max pooling layers. Finally note that we use an average pooling instead of fully connected layers to reduce the number of parameters and the use of dropout layers. conv[output_] := ConvolutionLayer[output, {5, 5}, "PaddingSize" -> 2] pool[size_] := PoolingLayer[{size, size}, "Stride" -> size] lenet = NetChain[ {conv[32], Ramp, conv[32], Ramp, pool[2], conv[64], Ramp, conv[64], Ramp, pool[2], conv[128], Ramp, conv[128], Ramp, conv[128], Ramp, PoolingLayer[{9, 9}, "Stride" -> 9, "Function" -> Mean], FlattenLayer[], DropoutLayer[], 73, SoftmaxLayer[]}, "Output" -> NetDecoder[{"Class", Extract[yogaposes, chosenPoses]}], "Input" -> NetEncoder[{"Image", {64, 64}, ColorSpace -> "Grayscale"}] ] The training set then consists of generating 10-15 points inside the constellation region (resized and padded to allow for rotations later), and taking their DistanceTransform: meshes[n_] := meshes[n] = ImagePad[ColorNegate@ makeSquare[ yogaposes[[chosenPoses[[n, 1]]]]["SimplifiedSchematic"], 44], 10] trainingSet[n_, m_, iter_] := With[{reg = ImageMesh[meshes[n], CornerNeighbors -> False, Method -> "MarchingSquares"]}, Thread[ColorConvert[ ImageAdjust[ DistanceTransform[Image[SparseArray[# -> 0, {64, 64}, 1]]]], "Grayscale"] & /@ Clip[Round@RandomPoint[reg, {iter, m}], {1, 64}] -> yogaposes[[chosenPoses[[n, 1]]]]]] exampleTrainingSet = Flatten[trainingSet[#, 10, 1] & /@ RandomInteger[{1, 73}, 10], 1] The net took a couple of hours to train on ~100,000 examples on my CPU. Here we import the trained net: lenetTrained = Import["constellationsNet.wlnet"] ## Night Sky ## We're almost ready to classify the night sky. We first need the location of the 10,000 brightest stars along with their Right Ascension and Declination: brightest = StarData[EntityClass[ "Star", {EntityProperty["Star", "ApparentMagnitude"] -> TakeSmallest[10000]}], {"RightAscension", "Declination", "ApparentMagnitude"}] We can plot these on the night sky using no projection (i.e. RA Vs Dec), using the sinusoidal projection (taken by Kuba's excellent [answer][7] in SE) or on the celestial sphere given by the following transformations respectively: $$sinusoidal:\{(\alpha -\pi ) \cos (\delta ),\delta \}$$ $$map to3D:\{\cos (\alpha ) \cos (\delta ),\sin (\alpha ) \cos (\delta ),\sin (\delta )\}$$ ![brightestStarsProjections][8] ## Classification ## Finally, we use these 10,000 brightest stars to compute a multivariate smooth kernel distribution out of which to sample from and a Nearest function to compute neighboring stars. We need to of-course use our own distance function on the celestial sphere: wrap[list_] := Block[{xs, ys}, {xs, ys} = Transpose[list]; Thread[{Mod[xs, 2 \[Pi]], Mod[ys, \[Pi], -\[Pi]/2]}]] mapTo3D[\[Alpha]_, \[Delta]_] = {Cos[\[Alpha]] Cos[\[Delta]], Cos[\[Delta]] Sin[\[Alpha]], Sin[\[Delta]]}; dist[{u_, v_}, {x_, y_}] := (#1[[1]] - #2[[1]])^2 + (#1[[2]] - #2[[2]])^2 + (#1[[ 3]] - #2[[3]])^2 & @@ mapTo3D @@@ {{u, v}, {x, y}} pts = wrap@QuantityMagnitude[UnitConvert[brightest[[6 ;;, ;; 2]]]]; nf = Nearest[pts, DistanceFunction -> dist] sm = SmoothKernelDistribution[pts] Our search algorithm is therefore defined as follows: 1. Pick a random position from the night sky distribution 2. Compute its 5-10 nearest neighbors 3. Classify those stars and their rotations by $\frac{2 \pi }{15}$ 4. Select the rotation which gives the highest accuracy 5. Associate constellation to running association and repeat rescale[list_] := Block[{xs, ys}, {xs, ys} = Thread[list]; Thread[Rescale[#, MinMax[#], {11, 54}] & /@ {xs, ys}]] rotate[\[Alpha]_, pts_] := ImageAdjust@ DistanceTransform[ Image@SparseArray[ Round@RotationTransform[\[Alpha] , {65/2, 65/2}][rescale[pts]] -> 0, {64, 64}, 1]] sky = <||>; accumulate[] := Block[{pts = nf[Mod[RandomVariate[sm] + {0, \[Pi]}, 2 \[Pi]] - {0, \[Pi]}, RandomInteger[{5, 10}]], \[Alpha], pred}, {\[Alpha], pred} = Last[SortBy[ First /@ Table[Thread[{\[Alpha], lenetTrained[rotate[\[Alpha], pts], "TopProbabilities"]}], {\[Alpha], 0, 2 \[Pi], (2 \[Pi])/ 15}], Last]]; If[Not[KeyExistsQ[sky, pred[[1]]]] || TrueQ[sky[pred[[1]], "Accuracy"] < pred[[2]]], AssociateTo[sky, pred[[1]] -> <|"Accuracy" -> pred[[2]], "Image" -> HighlightImage[ makeSquare[pred[[1]]["SimplifiedSchematic"], 64], {PointSize[Medium], Red, Round[RotationTransform[\[Alpha], 65/2 {1, 1}][rescale@pts], 0.5]}], "Points" -> pts, "Angle" -> \[Alpha]|>], Nothing];] We can import a precomputed association with 20 such constellations: selectedAsc = Import["skyAsc.m.gz"] ## Results ## Finally, we orient the schematic based on the optimally found angle and (manually) connect the dots. orient[pts_, \[Alpha]_] := Round[RotationTransform[\[Alpha], 65/2 {1, 1}][rescale@pts], 0.5] lines = {{{10, 7, 3, 1, 4, 9, 2, 5, 8}, {2, 6}}, {{7, 3, 1, 9, 6}, {10, 2, 1, 8}, {4, 3, 5}}, {{7, 8, 9, 4, 3, 2, 10}, {1, 2, 6, 5}}, {{10, 2, 1, 3, 9, 5}, {7, 1, 4, 6, 8}}, {{5, 4, 1, 2, 3}}, {{10, 4, 5, 7, 9, 3, 8}, {6, 1, 2, 3}}, {{9, 5, 6, 3, 1, 2, 7}, {7, 4, 8}}, {{7, 6, 2, 3, 5, 8}, {9, 5, 4}, {3, 1}}, {{6, 2, 1, 3, 4}, {2, 5}}, {{5, 6, 4, 1, 2, 8, 3, 7}}, {{10, 6, 3, 2, 7}, {5, 2, 1, 4, 9, 8}}, {{9, 5, 1, 2, 4, 8, 7}, {6, 3, 8}}, {{6, 10, 4, 2, 1, 3, 9, 7, 5, 8}}, {{6, 7, 3, 2, 1, 4, 5}}, {{10, 8, 3, 6, 7, 2, 5, 9}, {5, 1, 4, 3}}, {{6, 5, 2, 1, 3}, {1, 4}}, {{5, 1, 2, 3}, {1, 4}}, {{6, 3, 2, 1, 4}, {3, 5}, {2, 7}}, {{3, 6, 8, 2, 4, 5, 1, 7}}, {{3, 1, 2, 6, 5}}}; makeSquareAndScale[gr_, \[Alpha]_, size_, opacity_] := Block[{range, magnitudes, order, padding, newRanges, s}, range = AbsoluteOptions[gr, PlotRange][[1, 2]]; magnitudes = Abs[Subtract @@@ range]; order = Ordering[magnitudes, 2, Greater]; padding = Subtract @@ magnitudes[[order]]/2; s = size/First[magnitudes[[order]]]; newRanges = {{-1, 1} padding + Last[range[[order]]], First[range[[order]]]}; Graphics[{Opacity[opacity], GeometricTransformation[ GeometricTransformation[ gr[[1]], {ScalingMatrix[{s, s}], -1 First /@ (s Reverse@newRanges[[order]])}], RotationTransform[\[Alpha], (size + 1)/2 {1, 1}]]}, ImageSize -> size]] With[{l = Map[Line, lines, {2}]}, Multicolumn[ Table[Show[ makeSquareAndScale[ Keys[selectedAsc][[i]][ "SimplifiedSchematic"], -selectedAsc[[i, -1]], 64, 0.25], Graphics[ GraphicsComplex[ rescale[selectedAsc[[i, -2]]], {l[[i]], Red, PointSize[Large], Point /@ Sort /@ Flatten /@ lines[[i]]}]], ImageSize -> 150], {i, 20}], 5, Frame -> All, Appearance -> "Horizontal"]] ![found constellations][9] These can also be superimposed on the full night-sky: Graphics[{With[{l = Map[Line, lines, {2}]}, Table[GraphicsComplex[ selectedAsc[[i, -2]], {Orange, Thickness[Large], l[[i]], Red, PointSize[Medium], Point /@ Sort /@ Flatten /@ lines[[i]]}], {i, 20}]], Opacity[0.25], PointSize[Small], Point[Complement[pts, Flatten[Values@selectedAsc[[All, -2]], 1]]]}, ImageSize -> 750] ![found overlay][10] sinusoidal[\[Alpha]_, \[Delta]_] = {(\[Alpha] - \[Pi]) Cos[\[Delta]], \ \[Delta]} Graphics[{With[{l = Map[Line, lines, {2}]}, Table[GraphicsComplex[ sinusoidal @@@ selectedAsc[[i, -2]], {Orange, Thickness[Large], l[[i]], Red, PointSize[Medium], Point /@ Sort /@ Flatten /@ lines[[i]]}], {i, 20}]], Opacity[0.25], PointSize[Small], Point[sinusoidal @@@ Complement[pts, Flatten[Values@selectedAsc[[All, -2]], 1]]]}, ImageSize -> 750] ![found sinusoidal][11] It is then a matter of Overlaying these found constellations to existing images of night skies to produce the images at the beginning of the post: overlay[{img_, constellation_}, {size_, loc_, opac_}] := ImageCompose[imgs[[img]], ImageResize[ Show[makeSquareAndScale[ Keys[selectedAsc][[constellation]][ "SimplifiedSchematic"], -selectedAsc[[constellation, -1]], 64, opac], Graphics[ GraphicsComplex[ rescale[selectedAsc[[constellation, -2]]], {White, Thickness[0.0075], Line /@ lines[[constellation]], White, PointSize[.025], Point /@ Sort /@ Flatten /@ lines[[constellation]]}]], ImageSize -> 1000], size], Scaled[loc]] ## Conclusions / Lessons Learned ## - It IS possible to find collections of stars in the night sky matching all sorts of shapes. Other built-in entities to try are Pokemons, Dinosaurs etc - Not all the found constellation work 'perfectly' - Machine Learning is a powerful tool, and the WL implementation makes it easy to get started - Reformulating the problem to an easier, already solved problem (e.g. points -> 2D image input) can help Classification Accuracy - Perhaps the most interesting aspect of neural networks now, is diversifying its applications - so be creative This work was presented at the 2017 WTC (as part of a larger talk entitled "(De)Generative Art"). <br> I look forward to any comments/suggestions. <br> <br>George <br> <br> PS The editor doesn't seem to let me attach the .wlnet and .m.gz files. [1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=exampleImages.png&userId=11733 [2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=exampleImages.png&userId=616023 [3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=4214constellationsGraphic.png&userId=616023 [4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=randomPointsInmesh.png&userId=616023 [5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=distanceTransforms.png&userId=616023 [6]: https://arxiv.org/pdf/1409.1556v6.pdf [7]: https://mathematica.stackexchange.com/questions/89668/geoprojection-for-astronomical-data-wrong-ticks/89792#89792 [8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=maps.png&userId=616023 [9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=foundConstellations.png&userId=616023 [10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=overlaidConstellations.png&userId=616023 [11]: http://community.wolfram.com//c/portal/getImageAttachment?filename=overlaidConstellationsSinusoidal.png&userId=616023 George Varnavides 2017-10-24T04:17:44Z https://community.wolfram.com/groups/-/m/t/1732567 ![enter image description here][1] Abstract -------- The goal of this project was to simulate binary star systems and demonstrate the process of finding binary star systems and their populating planets. To accomplish this goal, I used a function called NBodySimulation, which describes the motions of a number of bodies subjected to predefined laws of motion. Simulating binary star systems, I produced a number of animations that describe the motions of these celestial bodies visually. After I succeeded in creating these animations, I moved to illustrate a practice called photometry, which astronomers use to detect binary star systems and exoplanets. I, following in the footsteps of these astronomers, produced a series of graphics describing the change in a binary star system's brightness over time. Introduction ------------ In 1929, Edwin Hubble discovered the Andromeda galaxy and destroyed our preexisting perceptions of the universe. The size of the universe expanded from 100 thousand light years across to 100 billion. The probability that there exists a planet that is similar to our own increases with every galaxy that is discovered. What was once a fantasy has become a near-reality. Consequently, the search for binary star systems and their populating planets has gained a great deal of attention. Astronomers everywhere are feverishly searching for binary star systems and their populating planets. Unfortunately, finding exoplanets is an incredibly difficult task, so dim and distant are they. Astronomers use photometry—the art of measuring changes in the intensity of light emitting from a defined area—to detect these celestial bodies. In this project, I demonstrate how astronomers detect binary star systems and their planets using photometry. Simulating Binary Star Systems ------------------------------ Here, I have created a simulation of a complete planetary system populated with a binary star and five planets. ExoDataF = NBodySimulation[ "Newtonian", {<|"Mass" -> SM1, "Position" -> SP1, "Velocity" -> SV1|>, <|"Mass" -> SM2, "Position" -> SP2, "Velocity" -> SV2|>, <|"Mass" -> PM1, "Position" -> PP1, "Velocity" -> PV1|>, <|"Mass" -> PM2, "Position" -> PP2, "Velocity" -> PV2|>, <|"Mass" -> PM3, "Position" -> PP3, "Velocity" -> PV3|>, <|"Mass" -> PM4, "Position" -> PP4, "Velocity" -> PV4|>, <|"Mass" -> PM5, "Position" -> PP5, "Velocity" -> PV5|>}, Quantity[10^30, "Years"]]; Manipulate[ Graphics3D[{White, Sphere[Values[ExoDataF["Position", t]][[1]], p*SR1], Sphere[Values[ExoDataF["Position", t]][[2]], p*SR2], Gray, Sphere[Values[ExoDataF["Position", t]][[3]], 2 p*PR1], Sphere[Values[ExoDataF["Position", t]][[4]], 2 p*PR2], Sphere[Values[ExoDataF["Position", t]][[5]], 2 p*PR3], Sphere[Values[ExoDataF["Position", t]][[6]], 2 p*PR4], Sphere[Values[ExoDataF["Position", t]][[7]], 2 p*PR5]}, Background -> Black, Boxed -> False, PlotRange -> {{-2*^12, 2*^12}, {-2*^12, 2*^12}, {-2*^12, 2*^12}}], {p, 10^5, 10^6}, {t, 0, ExoDataF["SimulationTime"]/4, 1}, SaveDefinitions -> True] ![enter image description here][1] To create this simulation, I pulled data from the Alpha Centauri system to generate the stars and data from our solar system to generate the planets. This simulation is not representative of an actual binary star system; it has been artificially generated. With that said, it can be used to demonstrate the difficult nature of detecting exoplanets. It is relatively easy to detect the two stars (represented as large, white spheres); however, it is much more difficult to detect their populating planets (represented as small, gray spheres). Despite access to state-of-the-art equipment, astronomers also struggle to detect exoplanets. They have to resort to other methods. Using Photometry to Detect Exoplanets ------------------------------------------------------------- One can detect binary star systems and exoplanets by plotting the intensity of the light that an area in space is emitting vs time. Here, I plot the intensity of the light that a single star in space that is unpopulated with planets is emitting vs time. ImageA = Table[ ImageResize[#, {75, 75}] & /@ (Binarize[Graphics3D[{ Glow[White], Black, Sphere[{0, 0, 0}, 500000 SR1]}, Background -> Black, Boxed -> False, PlotRange -> {{-3*^12, 3*^12}, {-3*^12, 3*^12}, {-3*^12, 3*^12}}]]), 40]; ImageAData = ImageData /@ ImageA; ListLinePlot[Count[1] /@ (Flatten /@ ImageAData), PlotLabel -> "Brightness Curve", AxesLabel -> {"Time", "Brightness"}] ![enter image description here][3] Unsurprisingly, the intensity of the light does not fluctuate over time. From this graph, one determines that there exists exactly one star and zero planets in this area. Here, I plot the intensity of the light that a binary star system emits over time. ImageB = Take[ Flatten[ Table[ImageResize[#, {75, 75}] & /@ (Binarize[Graphics3D[{ Glow[White], Black, Sphere[Values[ExoDataF["Position", t]][[1]], p*SR1], Sphere[Values[ExoDataF["Position", t]][[2]], p*SR2]}, Background -> Black, Boxed -> False, PlotRange -> {{-3*^12, 3*^12}, {-3*^12, 3*^12}, {-3*^12, 3*^12}}]]), {p, {500000}}, {t, 0, ExoDataF["SimulationTime"]/2, ExoDataF["SimulationTime"]/100}]], 40]; ImageBData = ImageData /@ ImageB; ListLinePlot[{Count[1] /@ (Flatten /@ ImageBData)}, PlotRange -> All, PlotLabel -> "Brightness Curve", AxesLabel -> {"Time", "Brightness"}] ![enter image description here][4] Notice that the intensity of the light dips periodically. These fluctuations indicate that there exist two celestial bodies. The intensity of the light is greatest when both bodies are visible: ![enter image description here][5] And least when one body eclipses the other: ![enter image description here][6] Here, I plot the intensity of the light that a binary star system populated with exactly one planet emits. ImageC = Take[ Flatten[ Table[ImageResize[#, {75, 75}] & /@ (Binarize[Graphics3D[{ Glow[White], Black, Sphere[Values[ExoDataF["Position", t]][[1]], p*SR1], Sphere[Values[ExoDataF["Position", t]][[2]], p*SR2], Glow[Black], Sphere[Values[ExoDataF["Position", t]][[4]], 3 p*PR2]}, Background -> Black, Boxed -> False, PlotRange -> {{-3*^12, 3*^12}, {-3*^12, 3*^12}, {-3*^12, 3*^12}}]]), {p, {500000}}, {t, 0, ExoDataF["SimulationTime"]/2, ExoDataF["SimulationTime"]/100}]], 40]; ImageCData = ImageData /@ ImageC; ListLinePlot[{Count[1] /@ (Flatten /@ ImageCData)}, PlotRange -> All, PlotLabel -> "Brightness Curve", AxesLabel -> {"Time", "Brightness"}] ![enter image description here][7] One determines that there exist two stars and at least one planet by observing the magnitude of each fluctuation. A change of 200 units indicates that one of the stars eclipses the other. A change of 30 units a planet. The planet is much smaller than both of the two stars; therefore, it has a much smaller impact on the intensity of the light emitting from the area. Notice that the planet covers but a small portion of the stars: ![enter image description here][8] Conclusions ----------- It is difficult to detect binary star systems and their populating planets; however, it is not impossible. Using photometry, astronomers can uncover small, dimly-lit bodies orbiting stars light years away. In this project, I explain how difficult it is to detect the planets populating a binary star system and demonstrate the methods used to do so. I had to learn how to use a function called NBodySimulation in order to produce the simulations shown in this notebook. Once I learned how to use this function effectively, I began generating data and creating visualizations depicting dots in a 2D plane. Most of the simulations that I created I made using data that I generated. After producing these simulations, I moved to create a complete planetary system populated with a binary star and five planets. Generating this simulation, I noticed that the planets are difficult to see, much smaller and dimmer than their parents. I began to wonder how astronomers detect binary star systems and their populating planets, which led me to investigate a practice used to detect these bodies called photometry. To demonstrate how one detects binary star systems and exoplanets using photometry, I produced a series of graphs that depict the changes in the intensity of the light emitting from the window. One should be able to detect the stars and planets in the simulation solely from these graphs. Future Works ------------ Allotted more time, I would design a function that would allow the user to alter the masses, radii, positions, velocities, and number of bodies present in the interface in real time. I attempted to apply Manipulate to NBodySimulation, but since NBodySimulation produces cooked data, such an approach is not applicable. I also would create a visualization describing what happens when a star expands beyond its Roche Lobe. Such a visualization would help illustrate the chaotic nature of these binary star systems. I also would produce a visualization depicting what one would see, standing on the surface of an exoplanet looking up. Imagine standing on the surface of a planet orbiting between a pair of stars. Everywhere is day; only along the planets prime meridian would you be able to experience twilight. It would have been a fun, engaging endeavor to try to create such a visualization. Definitions ----------- I generated the data to make the simulations shown here. However, I based these numbers on data that I pulled on the Alpha Centauri system and the planets present in our solar system. SM1 = Quantity[2.188*^32, "kg"]; SM2 = Quantity[2.80402*^31, "kg"]; PM1 = Quantity[2.00*^24, "kg"]; PM2 = Quantity[1.97*^26, "kg"]; PM3 = Quantity[3.35*^23, "kg"]; PM4 = Quantity[5.69*^24, "kg"]; PM5 = Quantity[2.777*^25, "kg"]; SR1 := 8.511*^5; SR2 := 6.005*^5; PR1 := 6.371*^4; PR2 := 6.991*^4; PR3 := 2.439*^4; PR4 := 6.371*^4; PR5 := 5.823*^4; SP1 = Quantity[{0, 0, 0}, "AstronomicalUnit"]; SP2 = Quantity[{0, 11.2, 0}, "AstronomicalUnit"]; PP1 = Quantity[{-11.2, 5.6, 0}, "AstronomicalUnit"]; PP2 = Quantity[{0, -5.2, 5.2}, "AstronomicalUnit"]; PP3 = Quantity[{5.2, -5.2, 13.5}, "AstronomicalUnit"]; PP4 = Quantity[{1, -11.2, 11.2}, "AstronomicalUnit"]; PP5 = Quantity[{1, 13.5, -5}, "AstronomicalUnit"]; SV1 = Quantity[{-21.4, 0, 0}, "km"]/sec; SV2 = Quantity[{20.6, 0, 0}, "km"]/sec; PV1 = Quantity[{20.5, 0, 0}, "km"]/sec; PV2 = Quantity[{0, 15.7, 0}, "km"]/sec; PV3 = Quantity[{-19.5, 0, 0}, "km"]/sec; PV4 = Quantity[{-21.5, 0, 0}, "km"]/sec; PV5 = Quantity[{0, 18.9, 0}, "km"]/sec; References ---------- “Transit Photometry: A Method for Finding Earths.” The Planetary Society, [www.planetary.org/explore/space-topics/exoplanets/transit-photometry.html][9]. Accessed 11 Jul. 2019. “Discovery: Other Galaxies Exist.” Amazing Space, amazing-[space.stsci.edu/resources/explorations/groundup/lesson/scopes/mt_wilson/discovery.php][10]. Accessed 11 Jul. 2019. [1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=10441PlanetarySystem.gif&userId=1724598 [2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=PlanetarySystem.gif&userId=1724598 [3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=BrightnessCurve.PNG&userId=1724598 [4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=BrightnessCurveB.PNG&userId=1724598 [5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=BinaryStarBAV.PNG&userId=1724598 [6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=BinaryStarOIV.PNG&userId=1724598 [7]: https://community.wolfram.com//c/portal/getImageAttachment?filename=BrightnessCurveC.PNG&userId=1724598 [8]: https://community.wolfram.com//c/portal/getImageAttachment?filename=BinaryStarE3.PNG&userId=1724598 [9]: http://www.planetary.org/explore/space-topics/exoplanets/transit-photometry.html [10]: http://space.stsci.edu/resources/explorations/groundup/lesson/scopes/mt_wilson/discovery.php Drake Hayes 2019-07-12T01:03:09Z