Community RSS Feed
https://community.wolfram.com
RSS Feed for Wolfram Community showing any discussions in tag Wolfram Language sorted by activeColebrook equation
https://community.wolfram.com/groups/-/m/t/2054486
Hello
I´m programming someting about pumps
I have the flow vector (from the pump chart) (Caudal in spanish)
Cau={0.0001,.025,.05,.076,.101,.126,.151}
I find the Reynolds number vector :
Rei={212.207,53051.6,106103.,161277.,214329.,267380.,320432.}
I can find the friction factor, applying individually the colebrook equation to any Reynols number
Rei1=Part[Rei,1];
Solve[1/f1^(1/2) ==-2* Log10[(\[Alpha])/3.7+2.51/(Rei1*f1^(1/2))], f1]
Rei2=Part[Rei,2];
Solve[1/f2^(1/2) ==-2* Log10[(\[Alpha])/3.7+2.51/(Rei2*f2^(1/2))],f2] ..... etc....
I obtain in each case:
{{f1->0.117072}}
{{f12->0.0206185}} ........etc ......
After that I recopilate manually the friction factor values in the vector "f"
f={0.117072,0.0206185, .......... etc ....,}
The questions are :
- Can I solve the Colebrook equation for the Reynolds number vector ?
- Can I recopilate automatically the values and build the vector "f".LUIS ARBOLEDA2020-08-09T23:03:28ZNumber of paths from Start to End through each node
https://community.wolfram.com/groups/-/m/t/2057533
Given an acyclic network g I am trying to figure out how to compute the number of paths in g going from the Start vertex to the End vertex through each vertex, i, in the network.
The closest function I found is BetweennessCentrality[g]. This looks at all pairs of start and end vertex and finds the fraction of the 'shortest paths' which goes through a vertex,i, of interest. This is close to what I want and shows that the basic functionality of computing number of paths through a vertex exists within Mathematica.
However, this isn't what I am looking for as I am not not interested in all possible start and end nodes and I am not interested in just shortest paths.
thxLes Servi2020-08-13T20:20:44ZFinding the function given the gradient vector
https://community.wolfram.com/groups/-/m/t/2055912
Hello.
The gradient vector Grad(f) of the function f is given as in the file.
Question 1: How can I find the smallest value of Grad(f) based on variables x1 and x2 ?
Question 2: Given only Grad(f) vector, how can I find the function f ?
I will be very happy if those who know this subject can help.
&[Wolfram Notebook][1]
[1]: https://www.wolframcloud.com/obj/2c50d808-2486-4584-ab36-0f0039c6450bMeryem Aslı2020-08-11T23:45:03Zopen loop transfer function 50/(s^3+2s^2+s+4) ?
https://community.wolfram.com/groups/-/m/t/2057256
When I examine open loop transfer function L(s)= 50/(s^3+2s^2+s+4) using Routh-Hurowitz as well as the Roots[L(s)] function in Mathematica, both show two poles in right half plane. Yet, when I do a NyquistPlot[L(s) ], there is no encirclement of -1. Why is that?Don Patterson2020-08-13T15:34:56Z[WSS20] Local Dimension Measure and Rotation Groups in Wolfram Models
https://community.wolfram.com/groups/-/m/t/2027996
![enter image description here][1]
&[Wolfram Notebook][2]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=9678wormholefpost.png&userId=1919403
[2]: https://www.wolframcloud.com/obj/tobiascanavesi/Published/canavesipost.nbTobias Canavesi2020-07-14T14:16:12ZColorizing tomography images
https://community.wolfram.com/groups/-/m/t/2056734
Hi there I would like to share a color tomography I was able to obtain using Wolfram, even though the image looks Ok, it is far from what I wanted to make, the image comes out of a long program in which I am not able to change the relation of the numbers that represent the pixels, as I thought I could do on Mathematica. If there is a later advancement on being able to manipulate the pixel values let me know. I would be happy to place the lines of the program, but it is too long, but it does have medical applications for those acquainted with medical images:
![LUNGS AND HEART TOMOGRAPHY][1]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=LUNGSANDHEART.jpg&userId=1147177Luis Felipe Massena Misiec2020-08-12T20:06:04Z[WSS20] Deep Learning Applied to Gravitational Wave Detection
https://community.wolfram.com/groups/-/m/t/2027779
![enter image description here][1]
&[Wolfram Notebook][2]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=FrontCover.png&userId=2026413
[2]: https://www.wolframcloud.com/obj/a3f59ae7-f159-4ee0-8588-55da81973c64Bar Alluf2020-07-14T11:32:54Z[WSS20] Implementing Mutual Information
https://community.wolfram.com/groups/-/m/t/2030629
![Karman vortex street and an estimation of mutual information][1]
&[Wolfram Notebook][2]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=animationkarman.gif&userId=1894013
[2]: https://www.wolframcloud.com/obj/luigi.brancati93/Published/WSS20-Project-Notebook-final.nbLuigi Brancati2020-07-14T18:12:42Z[Solved] InteractiveTradingChart not working on my installation
https://community.wolfram.com/groups/-/m/t/2055429
Hi there guys,
I'm on Mathematica 12.1.1 on Linux, trying to work with InteractiveTradingChart, sadly I can't make any of the examples work. All I get is a red box and a bunch of errors.
![enter image description here][1]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=wmtc.png&userId=1998036
I need help in trying to debug this feature. I'd like to understand if the problem is because of bad data provided to the function or the function itself is kind of deprecated.
EDIT:
The code I used in this test is the first (at the moment) example in the doc page about InteractiveTradingChart, I am copying it here for completeness:
InteractiveTradingChart[{"GOOGL", {{2009, 1, 1}, {2009, 12, 31}}}]Francesco Lasco2020-08-10T18:29:42Z[WSS20] Constructing protein surfaces
https://community.wolfram.com/groups/-/m/t/2029621
![enter image description here][2]
&[Wolfram Notebook][1]
[1]:
https://www.wolframcloud.com/obj/polyachenko.yua/Published/WSS2020%20Construction%20of%20protein%20surfaces.nb
[2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=mainpic.jpg&userId=2025530Yury POLYACHENKO2020-07-14T16:48:25ZDefinition of derivatives using Limit : D[f[x]=Limit(( f{x+h) - f(x) )/h ]
https://community.wolfram.com/groups/-/m/t/2053448
Definition of derivatives using Limit :
D[f[x]=Limit(( f{x+h) - f(x) )/h ] as h approaches zero.
Given f[x_]:=PieceWise[{{x^3,-4<==x<==1}},{3x,x>1}];
Show using the definition of Limit that that D[f[x],x] is not defined at x = 1Abraham Gadalla2020-08-07T14:53:16ZHow do you find out the structure of an the output of a function
https://community.wolfram.com/groups/-/m/t/2056842
I am using the function FinancialData["stock","OHLCV", {start,end,period}] to get daily stock prices and the function returns a time series. My problem is that I want to visualize what I am getting so that I can extract just the high and low prices for each day. My issue is that I don't know how the returned data is organized. Without that knowledge I can't just extract the highs or the lows as a simple list. Can someone tell me where I can find detailed information on how the results of a function are organized.
Things seem easy when asking for just one thing (like the closing price) but when asking for the "OHLCV" (Open, High, Low, Close, and Volume), I don't know where the date and the O,H,L,C,V are and how they are organized.Henrick Jeanty2020-08-12T22:14:59Z[WSS20] Full Discretization of Local Gauge Invariance
https://community.wolfram.com/groups/-/m/t/2030337
![A U(1) Graph Bundle over an R^3 Lattice Space][1]
&[Wolfram Notebook][2]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=c6bundle.jpg&userId=2029929
[2]: https://www.wolframcloud.com/obj/a439a840-9244-444b-98d8-d6dffb146c87Graham Van Goffrier2020-07-14T17:35:37ZSolving equation by radical expression
https://community.wolfram.com/groups/-/m/t/2055313
This gives square and cubic radical expressions, but of complex numbers:
ToRadicals[RootReduce[ReIm[x /. Solve[x^7 == 1]]]]Gianluca Gorni2020-08-10T15:34:44Z[WSG20] Calculus Daily Study Group begins August 3 (Free!)
https://community.wolfram.com/groups/-/m/t/2041687
The latest [Wolfram Daily Study Group][1] features one of our favorite math instructors, [Devendra Kapadia][at1], and focuses on building fundamental concepts in calculus. This is a great opportunity for students to refresh their knowledge or get a head start on the subject. Sign up: https://wolfr.am/od7nlnga
[1]: https://www.wolfram.com/wolfram-u/special-event/study-groups/
[at0]: https://community.wolfram.com/web/dkapadia
[at1]: https://community.wolfram.com/web/dkapadiaJamie Peterson2020-07-21T15:27:37ZTop 20 COVID countries HeatMap by absolute death and death in ppm
https://community.wolfram.com/groups/-/m/t/2004800
*MODERATOR NOTE: coronavirus resources & updates:* https://wolfr.am/coronavirus *Click on image to zoom in. Click browser back button to return.*
----------
[![enter image description here][1]][1]
I would like to share with the community this HeatMap that I did using ArrayPlot, with the Top 20 countries in Absolute Covid Death number. Below is the notebook used to generate code.
&[Wolfram Notebook][2]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=5458heatMap.png&userId=25532
[2]: https://www.wolframcloud.com/obj/a37f339f-4172-4cd2-9233-09f5931a31edRodrigo Murta2020-06-15T19:56:27ZTable Function generating setraw message
https://community.wolfram.com/groups/-/m/t/2056187
Hi;
In the function that I am using x is undefined at value 3 (see attached). To circumvent the problem of x being undefined, I created a piecewise function defining x at value 3 to be zero and subsequently created a table using the piecewise function. When the table executes, I am receiving the message
"Set::setraw: Cannot assign to raw object 3.`." and do not understand why. Is there anything I need to do to get rid of the message or just live with it?
Another unrelated question - how can I past code from a notebook into this forum. All of my pasting using Ctrl V (from windows) looks awful.
Thanks,
Mitch SandlinMitchell Sandlin2020-08-12T17:25:48ZChanging free variable for a Function that results from NDsolve
https://community.wolfram.com/groups/-/m/t/2055573
Hi There
I'm trying to use Inverse function result from NDSolve, the inverse works, but when i'm trying to re-define the free variable as function of another variable(time) in order to solve a new ODE, and im' getting some errors.
im not sure i change variable the right way
Thx
EzraEzra Kohavi2020-08-11T17:10:58Z[WSC20] Computing Radioactive Decay Products as a Function of Time
https://community.wolfram.com/groups/-/m/t/2034014
![enter image description here][1]
&[Wolfram Notebook][2]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Cover_Image_3.png&userId=2033261
[2]: https://www.wolframcloud.com/obj/regosheldon2003/Published/RadioactiveDecayVisualization2.nbSheldon Rego2020-07-15T20:02:17ZCatch comet C/2020 F3 (NEOWISE) which is putting on quite a show
https://community.wolfram.com/groups/-/m/t/2024815
&[Wolfram Notebook][1]
[1]: https://www.wolframcloud.com/obj/cf70227c-9327-43a4-b99a-2682df626bb4Jeff Bryant2020-07-12T02:07:28ZOptical Illusions and Self-Anamorphism in a Conical Mirror
https://community.wolfram.com/groups/-/m/t/2027565
![enter image description here][1]
Looking at the above simulations and as demonstrated in [my past Wolfram community contribution][2], reflection and anamorphism in a conical mirror result in considerable deformation of an image. It seems therefore unlikely that an image could be equal to its reflection in a conical mirror. I was therefore surprised reading the article "[Self Anamorphic Images][3]" by Andrew Crompton illustrating the existence of "self-anamorphic" images. "Self anamorphic" meaning: the image and its reflection are identical except for scaling and rotation.
I wanted to investigate this further with Mathematica and constructed my own conical mirror to test this. A conical mirror is very sensitive to geometric precision and cannot be made accurately enough with reflecting foil as is the case for a [cylindrical mirror][4]. I needed to make a [CNC precision turned][5] cone, polished and subsequently [chrome plated][6].
![enter image description here][7]
**1. Geometry of reflection and anamorphism in a conical mirror**
![enter image description here][8]
We first need another look at the geometry of reflection in a conical mirror: we take a cone with apex T, base radius 1 and opening angle 2alpha. Look down from an infinite viewpoint along the z-axis and we see a point A in the xy-plane reflected as a point R on the cone's base. Due to the radial symmetry of the cone, polar coordinates are the ideal choice. The polar coordinates of R are (r,t) and of A are (R,t). We can say that R is the reflection of A and A is the anamorphic image of R. A and R can be considered as an [enantiomorphic][9] point pair.
According to the laws of reflection, in the triangles BRS and ARS, we can derive the relation: (1 - r) cot(alpha) == (R - r) cot(2 alpha). We solve this equation for r and R as follows (we standardize for a cone opening angle of alpha -> Pi/6):
eqn = (1 - r) Cot[alpha] == (R - r) Cot[2 alpha];
Solve[eqn, #] & /@ {R, r} // Flatten // Simplify
% /. alpha -> Pi/6 // Simplify
(*{R->1-(-1+r) Sec[2 alpha],r->1-(-1+R) Cos[2 alpha]}
{R->3-2 r,r->(3-R)/2}*)
We can now make the functions *reflect* and *anamorph* that convert the radial coordinates from R and A into one another. Since the points R and A are on the same line through the origin, their angular coordinate t remains unchanged.
reflect[r_] := (3 - r)/2
anamorph[r_] := 3 - 2 r
The functions reflect and anamorph are the inverse of one-another.
anamorph@reflect[2.75] == 2.75 (*True*)
**2. Reflection of (filled) polar curves in a conical mirror**
As curves can be interpreted as sets of points, we can also have enantiomorph curve-pairs. When expressed in polar coordinates, we apply the functions *reflect* or *anamorph* to the radial coordinates of each point in the curve. This is a simple curve and its reflection as seen looking down in a conical mirror:
butterfly[t_, a1_, a2_] := a1 - a2 Cos[t] Sin[3 t]
PolarPlot[{1, butterfly[t, 2, -1], reflect[butterfly[t, 2, -1]],
3}, {t, -\[Pi], \[Pi]},
PlotStyle -> {Gray, Directive[Black, AbsoluteThickness[4]],
Directive[Gray, AbsoluteThickness[4]], Directive[Gray, DotDashed]},
PlotLegends -> {"mirror rim", "anamorphic curve",
"reflection curve", Nothing}]
![enter image description here][10]
Regular polygons are interesting curves for reflection in a conical mirror. We see that reflect converts a square into a 4-petaled rose-like curve (left) and a 4-petaled rose-like curve into a square (right). The cone is represented by a gray disk in the center.
square[r_] := r Cos[Pi/4] Sec[2/4 ArcTan[Cot[2 t]]]
GraphicsRow[{Show[Graphics[{Point[{0, 0}], Opacity[.15], Disk[]}],
PolarPlot[{square[2.5], reflect[square[1.75]]}, {t, -Pi, Pi},
PlotStyle -> Blue]],
Show[Graphics[{Point[{0, 0}], Opacity[.15], Disk[]}],
PolarPlot[{square[.75], anamorph[square[.75]]}, {t, -Pi, Pi},
PlotStyle -> Red]]}]
![enter image description here][11]
In 3D now, we can see below: (left) a pentagon reflects as a 5-petaled rose-like curve and (right) a 5-petaled rose-like curve reflects as a pentagon in a conical mirror. Or inversely: (left) the anamorphic image of a rose curve is a pentagon and (right) the anamorphic image of a pentagon is a rose curve using a conical mirror.
pentagon[r_] := r Cos[\[Pi]/5] Sec[2/5 ArcTan[Cot[(5 t)/2]]]
GraphicsRow[
MapThread[
Module[{alpha = Pi/6, op = .5, pts, ptsA, ptsR},
pts = Table[{pentagon[#2], t}, {t, -3.141, 3.14, .01}];
ptsR = (Flatten[{FromPolarCoordinates[#1], 0}] &) /@ pts;
ptsA = Table[
Flatten[{FromPolarCoordinates[{#1[pentagon[#2]], t}],
0}], {t, -3.141, 3.14, .01}];
Graphics3D[{{FaceForm[Lighter[LightGray, 1]],
Cylinder[{{0, 0, 0}, {0, 0, -.01}}, 3]}, {Opacity[op],
Cone[{{0, 0, 0}, {0, 0, 1/Tan[alpha]}}, 1]}, {#3,
AbsoluteThickness[3], Line[ptsA]}, {#3, AbsoluteThickness[3],
Line[ptsR]}}]] &, {{reflect, anamorph}, {2.1, .7}, {Blue,
Red}}]]
![enter image description here][12]
Using filled curves reveals an "optical illusion" with the **apparent** inversion of black and white: the white pentagon **seems** to reflect as a black rose and the black pentagon as a white rose?
filledPolarPlot[r_, edgeCol_, faceCol_] :=
PolarPlot[r, {t, 0, 2 \[Pi]}, Axes -> False] /.
Line[x__] :> {EdgeForm[edgeCol], FaceForm[faceCol], Polygon[x]}
GraphicsRow[MapThread[Show[filledPolarPlot[3, Black, #1],
filledPolarPlot[pentagon[2.25], Black, #2],
filledPolarPlot[1, Lighter[Gray, .5], Lighter[Gray, .5]],
filledPolarPlot[reflect@pentagon[2.25], #3, #3]] &, {{Black,
White}, {White, Black}, {Black, White}}]]
![enter image description here][13]
![enter image description here][14]
**3. Condition for self anamorphism in a conical mirror**
According to [A. Crompton, Self Anamorphic Images][15], Journal of Mathematics and the ArtsPublication, June 2008: "A curve is called self-anamorphic if it has the same shape as its reflection in a curved mirror except for rotation and rescaling".
We are looking for a periodic curve in polar coordinates in the x-y plane and centered around and reflected in an upright conical mirror. The radial coordinate R(t) of the curve should have a period of 2 Pi and can be represented by its Fourier series approximation:
R[t] = Sum[
an Cos[n t] + bn Sin[n t], {n, 0,
7}] (*limit of 8 terms sufficient for the discussion here*)
As stated at the beginning, to be self - anamorphic, the reflected curve r(t) needs to be a scaled and rotated version of R(t) and a linear combination of R(t) a +b R(t+t0) . If the scaling factor is m and the rotation angle t0, we can write the equations:
eqns = TrigExpand //@ (a + b (Cos[n t] an + Sin[n t] bn) ==
m (Cos[n (t + t0)] an + Sin[n (t + t0)] bn))
(*a+an b Cos[n t]+b bn Sin[n t]== an m Cos[n t] Cos[n t0]+bn m Cos[n \
t0] Sin[n t]+bn m Cos[n t] Sin[n t0]-an m Sin[n t] Sin[n t0]*)
\
Solve[eqns, {an, bn}]
(*{an->(a+b Sin[n t] bn-m Sin[n (t+t0)] bi)/(b Cos[n t]+m Cos[n \
(t+t0)])}
{bn->(a-b Cos[n t] an-m Cos[n (t+t0)] an)/(b Sin[n t]+m Sin[n \
(t+t0)])}*)
We have now two equations with as coefficient matrix:
mat = {{b/m + Cos[n t0], Sin[n t0]}, {-Sin[n t0], b/m + Cos[n t0]}}
(*{{b/m+Cos[n t0],Sin[n t0]},{-Sin[n t0],b/m+Cos[n t0]}}*)
To have (an indefinite number of) solutions, we need the determinant of the coefficient matrix to be zero.
det = Det[mat] // FullSimplify // Apart
(*( b^2+m^2)/m^2+(2 b Cos[n t0])/m*)
FindInstance[
det == 0, {m, b, Cos[n t0]}]
(*{{m->1,b\[Rule]1,Cos[n t0]->-1}}*)
Flatten@
Solve[Cos[(nt0)] == -1, (nt0)]
(* nt0->ConditionalExpression[-Pi+2 Pi \
c1,Element[c1,Integers]],nt0->ConditionalExpression[Pi+2 Pi \
c1,Element[c1,Integers]] *)
For Cos(n t0) to be -1, possible combinations of t0 and (n t0) must be odd integer multiples of Pi . This gives a table of the possible combinations of frequency indices n and rotations t0 that will produce self-anamorphic curves. t0 is the rotation angle between the curve and its reflection and n is the frequency index of the coefficient of the Fourier expansion of the curve:
Grid[lst =
Prepend[Cases[
Table[Flatten[{t0,
Table[180 \[Degree]/t0 (2 p + 1), {p, 0, 6}]}], {t0,
10 \[Degree], 360 \[Degree], 1 \[Degree]}], {_?NumericQ, _?
IntegerQ, ___}],
Style[#, 15] & /@ {t0, n1, n2, n3, n4, n5, n6, n7}],
Background -> {{LightGray}, {LightGray}}]
![enter image description here][16]
We can conclude that we have an infinite amount of self-anamorphic curves by reflection in a conical mirror. Curves represented by Fourier series can have any values of the a and b coefficients provided that n*t0 is an odd multiple of Pi. The above table gives the values of n needed for each rotation t0 between the curve and its reflection.
**4. Examples of self anamorphism in a conical mirror.**
The curve that will reflect as a scaled copy of itself, rotated over 90 degree can be approximately represented by an expansion of the form a0+a1 cos(2t)+a2 cos(6t)+a3 cos(10t)+a4cos(14t)+a5 cos(18t)+... The ai can be any combination that keeps the curve within the limits of reflection by the cone. (this is for an opening angle of 30 degrees, the annulus((0,0),(1,3))). here is one example out of an infinite many:
With[{a1 = 0.189, a2 = -0.08, a3 = 0.048, a4 = 0},
Module[{polaR},
polaR = 1.5` + a1 Cos[2 t] + a2 Cos[6 t] + a3 Cos[10 t] +
a4 Cos[14 t];
Show[filledPolarPlot[polaR, Thick, White],
Graphics[{Circle[], LightGray, Disk[]}],
filledPolarPlot[reflect[polaR], Thick, White],
Graphics[Circle[{0, 0}, .01]], Background -> LightGray]]]
![enter image description here][17]
This animation shows the shape variations if we change only the coefficient a1. All these intermediate curves are self-anamorphic with their reflections in a conical mirror.
![enter image description here][18]
This is a set of 3 curves with t0=60 degree:
GraphicsRow@
MapThread[
Module[{polaR},
polaR = 1.95 + #1 Cos[3 t] + #2 Cos[9 t] + #3 Cos[15 t];
Show[filledPolarPlot[3, Thin, White],
filledPolarPlot[polaR, Thick, White],
filledPolarPlot[1, Black, LightGray],
filledPolarPlot[reflect[polaR], Thick,
White]]] &, {{.35, .3, .34}, {-.035, .164, .238}, {.4, .09, \
-.222}}]
![enter image description here][19]
... and 6 self anamorphic curves rotated over 45 degree:(here, we use filled curves and one can observe again the apparent black-white inversion between the white curves and their black reflections. As was demonstrated before, this inversion is merely an optical illusion.
Grid@Partition[
MapThread[
Module[{polaR},
polaR = 1.5 + #1 Cos[4 t] + #2 Cos[12 t] + #3 Cos[20 t] + #4 Cos[
28 t]; Show[filledPolarPlot[2.1, Black, Black],
filledPolarPlot[polaR, Black, White],
filledPolarPlot[1, Black, LightGray],
filledPolarPlot[
reflect[1.5 + #1 Cos[4 t] + #2 Cos[12 t] + #3 Cos[
20 t] + #4 Cos[28 t]], Black,
Black]]] &, {{-0.424`, -0.424`, -0.003`,
0.4`, -0.219`, -0.074`}, {0.008`, 0.128`, 0.127`, -0.037`, 0,
0.377`}, {0.002`, 0.002`, 0.053`, 0.`, 0, 0}, {0.001`, 0.001`,
0.001`, 0, 0.143`, 0.03`}}], 3]
![enter image description here][20]
This GIF shows a test to check if the curves are self-anamorphic i.e. the curves and their reflections are equal except for rotation and scaling. The video shows a 45 degree curve (bleu) of the form 1.5+a0.4 Cos[4t]-.137 Cos[12t]+a3Cos[20t] (n values per previous table) and its reflection (red). We first rotate the reflected curve up to 45 degrees and scale it up to coincide with the red original. Both are equal and, even if we change e.g the a3 coefficient at the end of the video, both shapes stay identical.
![enter image description here][21]
**4. The remarkable Heart Curve.**
An exceptional curve was found by Andrew Crompton in the above mentioned article: a certain combination of the 180 degree coefficients produces a heart-like curve which is quite remarkable. I am repeating his calculations here...
Module[{heart, a1 = -0.1061`, a2 = -.3806, a3 = 0.0843`,
a4 = -0.0552`, a5 = 0.028`, a6 = -0.0165`, a7 = 0.0068`},
heart[aa_] :=
1.5` + a1 Cos[t] - aa Cos[3 t] + a3 Cos[5 t] - a4 Cos[7 t] +
a5 Cos[9 t] - a6 Cos[11 t] + a7 Cos[13 t];
Rotate[Show[{Graphics[{Disk[{0, 0}, 3]}],
filledPolarPlot[heart[a2], Black, White],
Graphics[{Lighter[Gray, .5], Circle[], Disk[]}],
filledPolarPlot[reflect[heart[a2]], Black, Black],
Graphics[{EdgeForm[Black], FaceForm[White], Disk[{0, 0}, .025]}]},
Axes -> False, PlotRange -> 3], 3 Pi/2]]
![enter image description here][22]
... and show the result as reflected it in my conical mirror.
![enter image description here][23]
If we do the same in two colors, as in the following photo, we can easily see why the apparent black-white inversion above was an optical illusion:
![enter image description here][24]
The following illustration shows how it is not the green heart that reflects as the red heart but it is the green ring that becomes the green heart and the red ring that reflects as the red heart! This can easily be observed in two colors but it creates optical confusion when in black and white.
Module[{heart, a1 = -0.1061`, a2 = -.3806, a3 = 0.0843`,
a4 = -0.0552`, a5 = 0.028`, a6 = -0.0165`, a7 = 0.0068`,
green = RGBColor[12/256, 150/256, 100/256],
red = RGBColor[225/256, 45/256, 52/256]},
polaR = 1.5` + a1 Cos[t] - a2 Cos[3 t] + a3 Cos[5 t] - a4 Cos[7 t] +
a5 Cos[9 t] - a6 Cos[11 t] + a7 Cos[13 t];
Column[{Row[{Rotate[Show[filledPolarPlot[3., green, green],
filledPolarPlot[polaR, White, White]], 3 Pi/2],
Style[" \[DoubleRightArrow] ", 26],
Rotate[Show[filledPolarPlot[reflect@polaR, green, green],
ImageSize -> 50], 3 Pi/2]}],
Row[{Rotate[Show[
filledPolarPlot[polaR, red, red],
filledPolarPlot[1, White, White], ImageSize -> 200], 3 Pi/2],
Style[" \[DoubleRightArrow] ", 26],
Rotate[Show[filledPolarPlot[1, red, red],
filledPolarPlot[reflect@polaR, White, White]], 3 Pi/2]}]}]]
![enter image description here][25]
To conclude, here is a Manipulate that can be used to explore the infinite amount of self-anamorphic curves. Select the rotation angle between the curve and its reflection, then set the 7 coefficients of the curves Fourier expansion and see the resulting curve and it, self-anamorphic reflection. Maybe you can find another recognizable or exceptional curve among the millions? Good luck and have fun!
Manipulate[
Module[{lst, curves, polaR},
lst = Cases[
Table[Flatten[{t0,
Table[180 Degree/t0 (2 p + 1), {p, 0, 6}]}], {t0, 10 Degree,
360 Degree, 1 Degree}], {_?NumericQ, _?IntegerQ, ___}];
curves = MapThread[
1.5 + a1 Cos[#1 t] + a2 Cos[#2 t] + a3 Cos[#3 t] + a4 Cos[#4 t] +
a5 Cos[#5 t] + a6 Cos[#6 t] + a7 Cos[#7 t] &,
Transpose[Rest /@ lst]]; polaR = curves[[sc]];
Rotate[Show[{Graphics[{Disk[{0, 0}, 2.5]}],
filledPolarPlot[polaR, Black, White],
Graphics[{Lighter[Gray, .5], Circle[], LightGray, Disk[]}],
filledPolarPlot[reflect[polaR], Black, Black],
Graphics[{EdgeForm[Black], FaceForm[White],
Disk[{0, 0}, .025]}]}, Axes -> False, PlotRange -> 2.5],
3 Pi/2]],
{{sc, 11, "select curve"},
Rule @@@ Transpose@{Range[1, 11],
ToString /@ (First /@ lst)}}, Delimiter, "select coefficients",
{{a1, -0.1061}, -.5, .5, .0001, ImageSize -> Small,
Appearance -> "Labeled"},
{{a2, .3806}, -.5, .5, .0001, ImageSize -> Small,
Appearance -> "Labeled"}, {{a3, .0843}, -.5, .5, .0001,
ImageSize -> Small, Appearance -> "Labeled"},
{{a4, 0.0552}, -.5, .5, .0001, ImageSize -> Small,
Appearance -> "Labeled"},
{{a5, .028}, -.5, .5, .0001, ImageSize -> Small,
Appearance -> "Labeled"},
{{a6, .0165}, -.2, .2, .0001, ImageSize -> Small,
Appearance -> "Labeled"}, {{a7, .0068}, -.1, .1, .0001,
ImageSize -> Small, Appearance -> "Labeled"}]
![enter image description here][26]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=10920GEandAlpha.png&userId=68637
[2]: https://community.wolfram.com/groups/-/m/t/1865458
[3]: https://www.researchgate.net/publication/232844275_Self-anamorphic_images
[4]: https://community.wolfram.com/groups/-/m/t/1597207
[5]: https://en.wikipedia.org/wiki/Numerical_control
[6]: https://en.wikipedia.org/wiki/Chrome_plating
[7]: https://community.wolfram.com//c/portal/getImageAttachment?filename=chromecone.jpg&userId=68637
[8]: https://community.wolfram.com//c/portal/getImageAttachment?filename=3146geometryinfinity.png&userId=68637
[9]: https://www.thefreedictionary.com/enantiomorphic
[10]: https://community.wolfram.com//c/portal/getImageAttachment?filename=4176butterflygraph.png&userId=68637
[11]: https://community.wolfram.com//c/portal/getImageAttachment?filename=1440square-roseconvert.png&userId=68637
[12]: https://community.wolfram.com//c/portal/getImageAttachment?filename=9935roseandpentagonconvert3D.png&userId=68637
[13]: https://community.wolfram.com//c/portal/getImageAttachment?filename=6129penta-roseblack-white.png&userId=68637
[14]: https://community.wolfram.com//c/portal/getImageAttachment?filename=1954whitepentagonduo.png&userId=68637
[15]: https://www.researchgate.net/publication/232844275_Self-anamorphic_images
[16]: https://community.wolfram.com//c/portal/getImageAttachment?filename=3123frequencytable.png&userId=68637
[17]: https://community.wolfram.com//c/portal/getImageAttachment?filename=337790degreevariation.png&userId=68637
[18]: https://community.wolfram.com//c/portal/getImageAttachment?filename=486990degreevariation.gif&userId=68637
[19]: https://community.wolfram.com//c/portal/getImageAttachment?filename=4912t060degreetrio.png&userId=68637
[20]: https://community.wolfram.com//c/portal/getImageAttachment?filename=3781t045degreesextet.png&userId=68637
[21]: https://community.wolfram.com//c/portal/getImageAttachment?filename=3079testingscaleandrotation.gif&userId=68637
[22]: https://community.wolfram.com//c/portal/getImageAttachment?filename=8188heartMathematica.png&userId=68637
[23]: https://community.wolfram.com//c/portal/getImageAttachment?filename=10513heartduo.png&userId=68637
[24]: https://community.wolfram.com//c/portal/getImageAttachment?filename=coloredheartduo.png&userId=68637
[25]: https://community.wolfram.com//c/portal/getImageAttachment?filename=9431colorheartdiscussion.png&userId=68637
[26]: https://community.wolfram.com//c/portal/getImageAttachment?filename=6314finalManupulate.png&userId=68637Erik Mahieu2020-07-14T09:46:16ZVisualizing Radioactive Decay using Object Oriented Programming
https://community.wolfram.com/groups/-/m/t/2036781
![enter image description here][1]
&[Wolfram Notebook][2]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Radon-222.png&userId=2033261
[2]: https://www.wolframcloud.com/obj/regosheldon2003/Published/RadioactiveDecayVisualizationOOP.nbSheldon Rego2020-07-16T18:44:05Z[Notebook] Step by Step Solution to Iran MO 2019 Geometric Problem
https://community.wolfram.com/groups/-/m/t/2013794
![enter image description here][1]
&[Wolfram Notebook][2]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=3254demo.gif&userId=23928
[2]: https://www.wolframcloud.com/obj/dc692df0-f49b-4c94-86d0-1376ad465b9aShenghui Yang2020-06-26T16:09:03ZExploring a marine annelid worm along the phases of the moon
https://community.wolfram.com/groups/-/m/t/2046184
&[Wolfram Notebook][1]
[1]: https://www.wolframcloud.com/obj/jofree/Published/Circalunar_rythm.nbJofre Espigule-Pons2020-07-27T12:59:36ZHow to rotate a 3D plot along its perpendicular axis?
https://community.wolfram.com/groups/-/m/t/2055533
I'm trying to rotate a 3D plot for a complex polynomial along its perpendicular axis but its giving me an error. I'm using the inbuilt function RevolutionPlot3D. Please advise me the correction.Rahul Chakrabory2020-08-11T13:40:57ZQuestion on transition from Mathematica to Matlab using Tomatlab.m
https://community.wolfram.com/groups/-/m/t/2055970
I am trying to calculate some function with Mathematica and move it to the Matlab, and I would appreciate it if you help me.
1. The Tomatlab.m produces ` Derivative(1)(sin)(2.*y)` from Mathematica to Matlab. However, there is no function like `Derivative(1)(sin)(2.*y)` in Matlab. So, I was wondering how `Derivative(1)(sin)(2.*y)` is calculated? Is it `cos(2.*y)` or `2*cos(2.*y)`? in Matlab Code?** The different representation says that `Derivative(1)(sin)(2.*y) = sin'[2.*y].`, but still not sure `sin'[2.*y] = cos[2.*y] or 2cos[2.*y]`
2. Even if I use the Tomatlab.m file, I have to modify my code in Matlab to run the code. For example, I have to change (s+(-1).*t) to bsxfun(@minus,t,s'). Since my code is complicated, I have been struggling with the dimension error when I changed these things. Is there any function or file like Tomatlab.m that I can directly use the code output without modification? I saw that there is another function Math link that transfer the code output from Mathematica to Matlab. Any Ideas about this function?
Thank you.
exp(1).^(logsigma+(-1).*logthetat+(-2).*logthetax+(-1/2).*exp(1) ...
.^((-1).*logthetat).*(s+(-1).*t).^2+(-1/2).*exp(1).^((-1).* ...
logthetax).*(x+(-1).*y).^2).*(R.*((-1)+s)+(-1).*s).^(-1).*((-1).* ...
exp(1).^(2.*logthetax).*R.*(s+(-1).*t)+exp(1).^logthetat.*(R.*(( ...
-1)+s)+(-1).*s).*((x+(-1).*y).^2.*\[Alpha]+(-1).*exp(1).^logthetax.*\
(\[Alpha]+ ...R.*((-1).*x+y).*sin(2.*y))+2.*exp(1).^(2.*logthetax).*R.* ...
**Derivative(1)(sin)(2.*y)**));Jinhyeun Kim2020-08-12T06:40:58ZMatrix multiplication T2*T1, I am not getting the output
https://community.wolfram.com/groups/-/m/t/2055888
a = \[Alpha]*(r + s)/2 /. {r -> 0.00037, s -> 0.0013};
b = \[Alpha]*(\[Alpha]*r*s - 1) /. {r -> 0.00037, s -> 0.0013};
Subscript[\[Beta], 1] = Sqrt[Sqrt[a^2 - b] - a];
Subscript[\[Beta], 2] = Sqrt[Sqrt[a^2 - b] + a];
Subscript[m,
1] = (\[Alpha]*s + Subscript[\[Beta], 1]^2)/Subscript[\[Beta], 1];
Subscript[m,
2] = (\[Alpha]*s - Subscript[\[Beta], 2]^2)/Subscript[\[Beta], 2];
T1 = {{1, 0, 1, 0}, {Subscript[m, 1]*Subscript[\[Beta], 1], 0,
Subscript[m, 2]*Subscript[\[Beta], 2],
0}, {0, (Subscript[\[Beta], 1] - Subscript[m, 1]),
0, (Subscript[\[Beta], 2] + Subscript[m, 2])}, {-Subscript[m, 1]*
Subscript[\[Beta], 1]*t, Subscript[\[Beta],
1], -Subscript[m, 2]*Subscript[\[Beta], 2]*t, Subscript[\[Beta],
2]}} /. {t -> 0.2154};
T2 = Inverse[{{Cosh[Subscript[\[Beta], 1]/2],
Sinh[Subscript[\[Beta], 1]/2], Cos[Subscript[\[Beta], 2]/2],
Sin[Subscript[\[Beta], 2]/2]}, {Subscript[m, 1]*Subscript[\[Beta],
1]*Cosh[Subscript[\[Beta], 1]/2],
Subscript[m, 1]*Subscript[\[Beta], 1]*
Sinh[Subscript[\[Beta], 1]/2],
Subscript[m, 2]*Subscript[\[Beta], 2]*
Cos[Subscript[\[Beta], 2]/2],
Subscript[m, 2]*Subscript[\[Beta], 2]*
Sin[Subscript[\[Beta], 2]/2]}, {(Subscript[\[Beta], 1] -
Subscript[m, 1])*
Sinh[Subscript[\[Beta], 1]/2], (Subscript[\[Beta], 1] -
Subscript[m, 1])*
Cosh[Subscript[\[Beta], 1]/
2], -(Subscript[\[Beta], 2] + Subscript[m, 2])*
Sin[Subscript[\[Beta], 2]/2], (Subscript[\[Beta], 2] + Subscript[
m, 2])*Cos[Subscript[\[Beta], 2]/2]}, {Subscript[\[Beta], 1]*
Sinh[Subscript[\[Beta], 1]/2],
Subscript[\[Beta], 1]*
Cosh[Subscript[\[Beta], 1]/2], -Subscript[\[Beta], 2]*
Sin[Subscript[\[Beta], 2]
/2], Subscript[\[Beta], 2]*Cos[Subscript[\[Beta], 2]/2]}}]Kumar Arpit2020-08-11T18:34:02ZBest way to produce interactive 3d images of tangles/knots?
https://community.wolfram.com/groups/-/m/t/2053300
On my html5 website on physics, I would like to add 3d computer graphics of tangles. (Tangles are cousins of knots.) The tangles would be similar to the one in the following photograph. I would like to allow users to rotate the image of such a tangle and thus allow them to view the tangle from all sides.
Question1 : How can I generate such a tangle most easily in Mathematica?
Question 2: What is the best 3d format to export it, and what is the best/easiest way to embed the 3d image in a html5 page, so that viewers can rotate the image with their mouse or with sliders?
(P.S. Tubular ropes are completely sufficient, without any substructure.
P.P.S. Apart from Mathematica, I also own KnotPlot.)
![A tangle photograph][1]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=DAVN3.jpg&userId=2053250Chris S2020-08-07T12:02:35ZHow to convert into fraction form
https://community.wolfram.com/groups/-/m/t/2055494
I would like to convert symbolic fraction form into standard fraction form like Matlab as PDF.Sheng Dai2020-08-11T07:16:16ZAssigning a name to variables depending on the thread number.
https://community.wolfram.com/groups/-/m/t/2055205
Hello,
I would like to name the variables dynamically, e.g. so that their names depend on the number of the thread being executed. Something like below:
n = 3;(*numer wątku*)
ParallelDo[
Subscript[t, i] = Table[Random[], {10}], {i, n}];
t = Table[0, {10}];
Do[t += Subscript[t, i], {i, n}];
t
Unfortunately, table t has all zeros.
I tried to sum in a loop, I tried to use the $KernelID variable. Unfortunately, it didn't help.
The program "sees" the results because it can write them out:
n = 3;(*numer wątku*)
ParallelDo[
Subscript[t, i] = Table[Random[], {10}];
Print[Subscript[t, i]], {i, n}]
I am asking for a hint (it is certainly not very simple).
If "n" is greater than the number of threads, will the program (after the prompt) also work?
Best regards,
DMD M2020-08-10T13:58:13ZReflection and Anamorphism in a Hanging Conical Mirror
https://community.wolfram.com/groups/-/m/t/2053926
![enter image description here][1]
I took the chrome plated conical mirror used in my [previous Wolfram Community contribution][2], suspended it upside down, and asked myself the (anamorphism) question : what should a (deformed) image look like to be reflected in this mirror as the (undeformed) original? We can use Mathematica to solve this problem!
![enter image description here][3]
**1. Geometry of reflection in a hanging conical mirror**
![enter image description here][4]
An observer looking from a viewpoint at V in the direction of the cone, will see the point S reflected as the point I. Q is the intersection point of the view line VI with the cone. This function computes this intersection:
viewlineConeIntersection[{yi_, zi_}, {xv_, zv_}, h0_, h_] :=
Module[{t1, t2},
t1 = Sqrt[-h^2 xv^2 yi^2 + h0^2 (xv^2 + yi^2) + xv^2 zi^2 +
yi^2 zv^2 - 2 h0 (xv^2 zi + yi^2 zv)];
t2 = 1/(h^2 (xv^2 + yi^2) - (zi - zv)^2);
{t2 xv ((h0 - zi) (zi - zv) + h (h yi^2 + t1)),
t2 yi (h^2 xv^2 + (h0 - zv) (-zi + zv) - h t1),
t2 (-h0 (zi - zv)^2 + h^2 (xv^2 zi + yi^2 zv) + h (-zi + zv) t1)}]
With the help of viewlineConeIntersection, the following function computes the intersection of the reflection line IQ with the x-y plane. This intersection is the anamorphic map of I.
hangingConeAnamorphicMap[{yi_, zi_}, {xv_, zv_}, h0_, h_] :=
Quiet[Module[{mirror, ptI, ptV, imageTriangle, vwLine, xq, yq, zq,
ptQ, xn, yn, zn, ptVr},
mirror = Cone[{{0, 0, h0 + h}, {0, 0, h0}}, 1]; ptI = {0, yi, zi};
ptV = {xv, 0, zv};
imageTriangle =
Triangle[{{0, 0, h0}, {0, -1, h + h0 - .001}, {0, 1,
h + h0 - .001}}];
If[! RegionMember[imageTriangle, {0, yi, zi}], {yi, zi} =
Rest[RegionNearest[imageTriangle, {0, yi, zi}]], {yi, zi}];
vwLine = Line[{ptI, ptV}]; {xq, yq, zq} =
viewlineConeIntersection[{yi, zi}, {xv, zv}, h0, h];
ptQ = {xq, yq, zq}; {xn, yn} = Normalize[{xq, yq}];
zn = -Sin[ArcTan[1/h]];
ptVr = ReflectionTransform[{xn, yn, zn}, ptQ][ptV];
Solve[{{x, y, z} \[Element] HalfLine[{ptVr, ptQ}] && z == 0}, {x,
y, z}][[1, All, -1]]]]
This is the function in action as the pointS follows the anamorphic map of a reflected circle:
![enter image description here][5]
**2. Preparing the images**
It is clear that the points I all will have to belong to the triangular region Triangle[{{-1,51.98/30},{1,51.98/30},{0,0}}]. The following code computes the function range staring from its triangular domain.
Module[{xv = 5., zv = 3., r = 1, h = 51.98/30, h0 = .5, triangle,
circlePts, anaCirclePts, trianglePts, anaTrianglePts},
triangle = Triangle[{{-h0 - .02, 0}, {-h0 - h, 1}, {-h0 - h, -1}}];
trianglePts =
DeleteDuplicates[
RegionNearest[triangle,
CirclePoints[{0, (h0 + h)/2}, 4, 1000]] /. {x_?NumericQ,
y_} :> {y, -x}];
anaTrianglePts =
DeleteCases[
ParallelMap[Most[hangingConeAnamorphicMap[#1, {xv, zv}, h0, h]] &,
trianglePts], {}];
Grid[{Style[#, Bold, 14] & /@ {"Domain", "Range"}, {Rotate[
Graphics[{HatchFilling[], FaceForm[LightGray],
EdgeForm[AbsoluteThickness[1.5]], triangle},
PlotRange -> {{-4, 2}, {-2, 2}}, Axes -> True,
TicksStyle -> Small, ImageSize -> 400], -Pi/2],
Rotate[Graphics[{HatchFilling[], FaceForm[LightGray],
EdgeForm[AbsoluteThickness[1.5]], FaceForm[Lighter[Gray, .85]],
Polygon[anaTrianglePts]},
PlotRange -> {{-4, 2.5}, {-4.5, 4.5}}, Axes -> True,
TicksStyle -> Small, ImageSize -> 300], -Pi/2]}}]]
![enter image description here][6]
The reflection appearing in the inverted cone will maximum be triangular in shape or at least fit inside a triangle. In our case (we suspend the cone with its tip at .5 above the x-y plane), this is the triangle Triangle[{{-1,51.98/30},{1,51.98/30},{0,0}}]:
Graphics[{EdgeForm[Black], HatchFilling[], FaceForm[LightGray],
Triangle[{{-1, 51.98/30}, {1, 51.98/30}, {0, 0}}] /. {x_?NumericQ,
y_} :> {x, y + 0.5}}, Axes -> True, AxesOrigin -> {0, 0}]
![enter image description here][7]
In order to fit an image inside this triangle, we need a function that convert the image to a set of colored polygons that fit into the triangle (or other) region.
Module[{mandrill, irc},
mandrill = ImageResize[ExampleData[{"TestImage", "Mandrill"}], 100];
irc = imageRegionCrop[mandrill,
Region@Triangle[{{-.99, 1}, {.97, 1}, {-.01, -.97}}]];
Graphics[{irc /. {x_?NumericQ, y_} :> {x, y + 1.5}, FaceForm[],
EdgeForm[Black],
Triangle[{{-.99, 1}, {.97, 1}, {-.01, -.97}}] /. {x_?NumericQ,
y_} :> {x, y + 1.5}}, Axes -> True,
AxesOrigin -> {0, 0} Axes -> True, AxesOrigin -> {0, 0}]]
![enter image description here][8]
**3. 3D simulation in Mathematica**
Now, we convert the triangular set of colored polygons into its anamorphic map with our function hangingConeAnamorphicMap. With Graphics3D, we can see a simulation of how the anamorphic image will look reflected in the hanging cone:
Module[{r = 1., h = 51.98/30, h0 = .5, xv = 5, zv = 3.5, mirrorCone,
ptV, imageTriangle, img, splitLogo, pixelPolys, anaPolys},
mirrorCone = Cone[{{0, 0, h0 + h}, {0, 0, h0}}, r];
ptV = {xv, 0, zv};
imageTriangle =
Triangle[{{0, 0, h0}, {0, -r, h + h0}, {0, r, h + h0}}];
img = ImageResize[ExampleData[{"TestImage", "Mandrill"}], 200];
splitLogo =
imageRegionCrop[img,
Triangle[{{-1, 51.98/30/2.}, {1,
51.98/30/2.}, {0, -51.98/30/2.}}]];
pixelPolys = splitLogo /. {x_?NumericQ, y_} :> {x, y + 1.5};
anaPolys =
DeleteCases[
MapAt[hangingConeAnamorphicMap[#, {5, 1.367}, .5, 51.98/30] &,
pixelPolys, {All, -1, All, All}] /. {x_?NumericQ, y_, z_} :> {x,
y}, {z == 0}, \[Infinity]];
Graphics3D[{{LightGray,
InfinitePlane[{{0, 0, 0}, {1, 0, 0}, {0, 1, 0}}]},
{Opacity[.35], LightGray, Specularity[1, 2],
mirrorCone}, {AbsoluteThickness[2],
Line[{{0, 0, h + h0 + 2}, {0, 0, h + h0}}], AbsolutePointSize[3],
Point[{0, 0, h + h0 + 22}]},
{FaceForm[], EdgeForm[{Blue, AbsoluteThickness[.5]}],
imageTriangle},
pixelPolys /. {y_, z_} :> {0, y, z},
anaPolys /. {x_?NumericQ, y_} :> {x, y, 0.001}}]]
![enter image description here][9]
**5. Real world testing**
To test this in a real world setting, we need a printout of the anamorphic image...
Graphics[{{Thin, Circle[]}, anaPolys}]
![enter image description here][10]
...locate the printout under our hanging conical mirror....
![enter image description here][11]
...and see the result reflected as the original and undeformed image!
![enter image description here][12]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=mandrillsetupintro.jpg&userId=68637
[2]: https://community.wolfram.com/groups/-/m/t/2050345?p_p_auth=DRO9ZQfD
[3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=chromecone.jpg&userId=68637
[4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=6150geometryhangingcone.png&userId=68637
[5]: https://community.wolfram.com//c/portal/getImageAttachment?filename=hangingcone.gif&userId=68637
[6]: https://community.wolfram.com//c/portal/getImageAttachment?filename=7783domainandrange.png&userId=68637
[7]: https://community.wolfram.com//c/portal/getImageAttachment?filename=triangle.png&userId=68637
[8]: https://community.wolfram.com//c/portal/getImageAttachment?filename=9702mandriltriangle.png&userId=68637
[9]: https://community.wolfram.com//c/portal/getImageAttachment?filename=mandrill3D.png&userId=68637
[10]: https://community.wolfram.com//c/portal/getImageAttachment?filename=6839mandrill.jpg&userId=68637
[11]: https://community.wolfram.com//c/portal/getImageAttachment?filename=8974mandrillsetup.jpg&userId=68637
[12]: https://community.wolfram.com//c/portal/getImageAttachment?filename=mandrillresult-2.jpg&userId=68637Erik Mahieu2020-08-08T11:58:47ZProblem with importing Dataset
https://community.wolfram.com/groups/-/m/t/2055189
I'm trying to import the dataset "Genetic Sequences for the SARS-CoV-2 Coronavirus". However, the function ResourceData doesn't work (actually it is not working for any dataset).
It shows this message: Cannot open ResourceSystemClientLoader`
Can anyone help me to understand what is going on?Vitor Marquioni Monteiro2020-08-11T05:34:10ZChanging Input when I use == or >
https://community.wolfram.com/groups/-/m/t/2055820
I am using Mathematica 12.1.1.0 and am having a really annoying issue that when I type an equal sign = it changes the input type in line so that I can't enter == to use in Solve or Reduce. Similarly, any time I use a greater than symbol, >, it converts to Python input. This is making working very very frustrating and tedious.
I have already re-downloaded and re-installed the most up-to-date version from my User Portal. Does anyone know what to do??Ian Turner2020-08-11T16:21:54ZAnalysis of the Change in Phillips Curve After COVID-19 with Regression
https://community.wolfram.com/groups/-/m/t/2055704
&[Wolfram Notebook][1]
[1]: https://www.wolframcloud.com/obj/49617701-004c-42f2-ba32-335a2b365baeSeojin Yoon2020-08-11T09:09:47ZI could not plot the 3D PDE equation,
https://community.wolfram.com/groups/-/m/t/2009272
I am trying to solve this homogeneous 3D PDE, but I could not. Could you please find the problem?M al2020-06-21T07:39:37ZSolve Function on a Specific Interval
https://community.wolfram.com/groups/-/m/t/2053841
In order to get the exact answer using the Solve[] function, it would be useful to enter the specific interval. For example in calculating the values of x in the Solve function
Solve[2 Sin[x]^2 - Sin[x] - 1 == 0, x, Reals]
I would like the answer on the interval from 0 to 2 Pi.
Without the ability to enter the desired interval, I get the answer of:
{{x -> ConditionalExpression[-(\[Pi]/6) + 2 \[Pi] C[1],
C[1] \[Element] Integers]}, {x ->
ConditionalExpression[\[Pi]/2 + 2 \[Pi] C[1],
C[1] \[Element] Integers]}, {x ->
ConditionalExpression[(7 \[Pi])/6 + 2 \[Pi] C[1],
C[1] \[Element] Integers]}}
Which is not exactly correct since answer #1 is less than 0 and the answer for 2 pi (11pi/6) is not listed.
Thanks,
Mitch SandlinMitchell Sandlin2020-08-07T19:44:50ZGraphics out of "Manipulate" function : habitable zone around a star
https://community.wolfram.com/groups/-/m/t/2054443
Dear sirs,
my skills with Wolfram Language are still quite basic.
I have created a very simple calculation of the boundaries of a star's goldilocks zone (rough calculation that doesn't take into account the complexity of greenhouse effects and geothermal energies).
I used the function 'Manipulate' , but then (for the sake of learning) I wish to create a graphic visualization of the results, maybe a 3D disk, where the habitable zone is just a coloured ring around a star (the star should be placed at the center of the disk, and its colour should vary, depending on the chosen luminosity.
This task is far too difficult for me, at this stage.
Anybody would like to help me?
please find the relevant notebook, our task refers to the last calculation, at the bottom of the file.
Thank you in advance
Cpt Mauro B. Mistretta
&[Wolfram Notebook][1]
[1]: https://www.wolframcloud.com/obj/corsaire.mbm/Published/Goldilocks%20Zone.nbMauro Benjamin Mistretta2020-08-09T09:23:04ZExcluding the input value say j=0 from the input values {j, -30, 30, 10}
https://community.wolfram.com/groups/-/m/t/2053978
lat = Table[j Pi/180., {j, -30, 30, 10}]; Show[Graphics3D[Sphere[]],
ParametricPlot3D[{Cos[x] Sin[Pi/2 - #], Sin[x] Sin[Pi/2 - #],
Cos[Pi/2 - #]}, {x, 0, 2 Pi}] & /@ lat, Boxed -> False]
Is it possible to exclude an input value say j=0 from the input values {{j, -30, 30, 10} for the function Table[j Pi/180., {{j, -30, 30, 10}] in the above Mathematica code just so the middle latitude which happens to be the equator will not be drawn
The Mathematica code happens to be a code I want to adopt from the reply of Hans Dolhaine, retired in the community post "How to display latitude and longitude lines on the sphere?" contributed by Qiu Mianp, SOHOYaw Antoa Onyina2020-08-08T22:21:03ZSave as pdf
https://community.wolfram.com/groups/-/m/t/2054599
Who can help me?
When I save a notebook in pdf, the pdf file is corrupt, it cannot be opened.
I tried online at library.wolfram.com/Explore/Publishing/NBtoPDF.jsp, but it doesn't work.
Thank you.Ion Ganea2020-08-09T19:18:47ZEstimation of energy yield of 2020 Beirut port explosion
https://community.wolfram.com/groups/-/m/t/2051264
Probably most of you heard the sad news that there was a giant explosion in the port of Beirut today August 3rd 2020. Several videos were released on which we can do analysis. Note that the method I will use was also famously used by G.I. Taylor to find the energy of the Trinity nuclear bomb test, and he found the right amount to within 10%! We will not be so lucky as the video quality was relatively poor as compared to the high-speed imaging done back then.
I extracted several frames from one of the videos:
![enter image description here][1]
SetDirectory[NotebookDirectory[]];
v1 = Import["1.mp4"];
fra = VideoExtractFrames[v1, Interval[{11, 12}]]
fra = ImageRotate[#, Right] & /@ fra;
For each of the frames I identified the explosion by clicking 3 point on the circle:
data={
{7,{{157.15625,365.20703125000006`},{233.83984375,379.76562500000006`},{272.015625,312.91015625000006`}}},
{8,{{318.16796874999994`,322.81640625000006`},{228.7890625,462.8515625},{103.61328125,393.38281250000006`}}},
{9,{{341.03515625000006`,311.34765625},{308.27734375,478.125},{93.86328125,420.34375}}},
{10,{{359.08984375,315.546875},{351.48828125,478.63671875000006`},{86.55078125,454.5078125}}},
{11,{{375.62109375,325.64453125},{330.05859375,535.3984375},{62.0390625,434.51171875}}},
{12,{{376.0390625,326.765625},{337.94140625,539.9257812499999},{46.4140625,462.55859375}}}
};
The first is the index of the frames, the last elements are points of the circle:
circs = CircleThrough /@ data[[;; 6, 2]];
r = circs[[All, 2]];
Here is the visualization:
Table[HighlightImage[fra[[data[[i, 1]]]], circs[[i]], "Boundary"], {i, Length[data]}]
![enter image description here][2]
Notice that I tracked the orange 'glow', not the shockwave or the smoke that was there partially before the main explosion (so on the conservative side and underestimating the energy release).
From Google earth I estimated the size of the face of the building on the left (a grain elevator) and found that every pixel corresponds to 0.59 m roughly (~22 meters corresponding to ~37 pixels).
cali = 0.5888486673789164`;
realr = r cali
The timestamps can be found from the video framerate.
Information[Import["video.mp4"]].
And so the timestamps are created and the dataset is created:
t = (Range[0, Length[realr] - 1]) 1/29.97;
tr = Transpose[{t, realr}]
Since the explosion started between two frames we include that in the fit (the t0):
fit = FindFit[
tr, { a (x + t0)^0.4, 0 < t0 < 1/30}, {{a, 200}, {t0, 1/60}}, x]
realfit = a (x + t0)^0.4 /. fit
tzero = t0 /. fit
realfitshifted = a (x)^0.4 /. fit
prefactor = a /. fit
The fit can be found [here][3] and is based on dimensional analysis with the variable E (energy), r (radius of the explosion), t (time), and ρ (density). This also explains the exponent 0.4 used for fitting.
We plot the data and the fit:
Show[{ListPlot[Transpose[{t + tzero, realr}]],
Plot[realfitshifted, {x, 0, 0.2}]},
PlotRange -> {{0, 0.2}, {0, 120}}, Frame -> True,
FrameLabel -> {"t", "r [m]"}]
![enter image description here][4]
Which is a pretty good fit.
We can now calculate the energy back from the explosion:
ClearAll[r, e, t, \[Rho]]
r == (e t^2/\[Rho])^(1/5)
Refine[DivideSides[%, t^(2/5)], t > 0]
%[[2]] == Quantity[prefactor, "Meters"/"Seconds"^(2/5)]
% /. \[Rho] -> Quantity[1, "Kilograms"/"Meters"^3]
energy = e /. Solve[%, e][[1]]
Yielding:
Quantity[4.2808721214488837`*^11, "Joules"]
and we can convert it to kiloton of TNT:
UnitConvert[energy, "KilotonsOfTNT"]
yielding:
Quantity[0.102315, "KilotonsOfTNT"]
This number is comparable to the 2015 Tianjin explosion (0.3 kilo tonnes of TNT).
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2020-08-04at21.44.20.png&userId=73716
[2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2020-08-05at12.00.12.png&userId=73716
[3]: https://en.wikipedia.org/wiki/Nuclear_weapon_yield#Calculating_yields_and_controversy
[4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2020-08-04at21.53.18.png&userId=73716Sander Huisman2020-08-04T19:57:48ZSharing your work with non-Mathematica users
https://community.wolfram.com/groups/-/m/t/2054137
Dear sirs,
I appreciate that this topic might have been already covered in the past.
However, I could not find any valuable solution to the problem.
Suppose I wanted to show my work to a fellow student or my professor (who are NOT Mathematica users) , which is the best option / line of action available?
As far as I understand PDFs are not an option, since they would lose the 'manipulated' content of my calculations.
Thank you
Cpt Mauro B. MistrettaMauro Benjamin Mistretta2020-08-08T11:33:55ZIs this a bug with GraphicsGrid?
https://community.wolfram.com/groups/-/m/t/2054288
Hi!
I am trying to reproduce a GraphicsGrid to visualize data as follows:
ofdata = ExampleData[{"Statistics", "OldFaithful"}];
GraphicsGrid[{
{ListPlot[ofdata], DensityHistogram[ofdata, 20, "PDF"]},
{Histogram3D[ofdata, 20, "PDF"], SmoothHistogram3D[ofdata]}
}, ImageSize -> 400]
But the result was not the expected since the first ListPlot graphic was not shown (see figure below)
![enter image description here][1]
If I make the ListPlot isolated I success
ListPlot[ofdata]
![enter image description here][2]
I have Mathematica Version 12.1.1. I don't know why this happens, is this a bug?.
Thanks for your comments!
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Capture.PNG&userId=391135
[2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Capture2.PNG&userId=391135Diego Ramos2020-08-08T20:57:39Z