Community RSS Feed
http://community.wolfram.com
RSS Feed for Wolfram Community showing any discussions in tag Wolfram Language sorted by activeCan't format polynomials the way I want
http://community.wolfram.com/groups/-/m/t/1303669
Hello! I would really appreciate any help with this as I have tried looking for an answer for more than 2 weeks. So this is my code
K[Q_, n_Integer] :=
Module[{z, x},
SymmetricReduction[
SeriesCoefficient[
Product[ComposeSeries[Series[Q[z], {z, 0, n}],
Series[x[i] z, {z, 0, n}]], {i, 1, n}], n],
Table[x[i], {i, 1, n}], Table[Subscript[c, i], {i, 1, n}]][[1]]]
primeFactorForm[n_] :=
If[Length@# == 1, First@#, CenterDot @@ #] &[
Superscript @@@ FactorInteger[n]];
string = StringJoin[
Riffle[Table[poly = K[Sqrt[#]/Tanh[Sqrt[#]] &, i] /. c -> p;
gcd = GCD @@ List @@ poly /. Rational[n_, d_]*c_ :> d;
ToString[
Inactive[Set][Subscript[L, i],
1/primeFactorForm[gcd]*Plus @@ List @@ Distribute[gcd*poly] /.
Times[Rational[n_, d_], e__] :>
primeFactorForm[n]/primeFactorForm[d]*e], TeXForm], {i, 0,
7}], "\\\\"]]
CopyToClipboard[string]
And this is the output (I have to do this many times with mad=ny different polynomials but the output is similar in all the cases):
$L_0=\frac{1}{1^1}\\L_1=\frac{\gcd \left(\frac{1}{3},p_1\right)+p_1+\frac{1}{3}}{\frac{1}{3}^{p_1}}\\L_2=\frac{7 p_2-p_1^2}{3^2\cdot 5^1}\\L_3=\frac{2 p_1^3-13 p_2 p_1+62 p_3}{3^3\cdot 5^1\cdot 7^1}\\L_4=\frac{\frac{p_2 p_1^2 2^1\cdot 11^1}{3^1}+\frac{p_3 p_1 -1^1\cdot 71^1}{3^1}+\frac{p_2^2 -1^1\cdot 19^1}{3^1}-p_1^4+127 p_4}{3^3\cdot 5^2\cdot 7^1}\\L_5=\frac{\frac{p_1^5 2^1}{3^1\cdot 7^1}+\frac{p_2 p_1^3 -1^1\cdot 83^1}{3^1\cdot 5^1\cdot 7^1}+\frac{p_3 p_1^2 79^1}{5^1\cdot 7^1}+\frac{p_4 p_1 -1^1\cdot 919^1}{3^1\cdot 5^1\cdot 7^1}+\frac{p_2^2 p_1 127^1}{3^1\cdot 5^1\cdot 7^1}+\frac{p_5 2^1\cdot 73^1}{3^1}+\frac{p_2 p_3 -1^1\cdot 2^4}{5^1}}{3^4\cdot 5^1\cdot 11^1}\\L_6=\frac{\frac{p_4 p_1^2 40841^1}{5^1}+\frac{p_1^6 -1^1\cdot 2^1\cdot 691^1}{3^1\cdot 5^1}+\frac{p_2 p_1^4 2^1\cdot 6421^1}{3^1\cdot 5^1}+\frac{p_3 p_1^3 -1^1\cdot 33863^1}{3^1\cdot 5^1}+\frac{p_2^2 p_1^2 -1^1\cdot 5527^1}{3^1}+\frac{p_2 p_3 p_1 83^1\cdot 349^1}{5^1}+\frac{p_5 p_1 -1^1\cdot 2^5\cdot 29^1\cdot 181^1}{5^1}+\frac{p_3^2 -1^1\cdot 167^1\cdot 241^1}{3^1\cdot 5^1}+\frac{p_2 p_4 -1^1\cdot 159287^1}{3^1\cdot 5^1}+\frac{p_6 2^1\cdot 23^1\cdot 89^1\cdot 691^1}{3^1\cdot 5^1}+\frac{p_2^3 2^1\cdot 1453^1}{5^1}}{3^5\cdot 5^2\cdot 7^2\cdot 11^1\cdot 13^1}\\L_7=\frac{\frac{p_1^7 2^2}{3^4\cdot 5^1\cdot 11^1}+\frac{p_2 p_1^5 -1^1\cdot 2^1\cdot 2161^1}{3^5\cdot 5^2\cdot 7^1\cdot 11^1}+\frac{p_3 p_1^4 2^2}{5^2\cdot 7^1}+\frac{p_4 p_1^3 -1^1\cdot 2^1\cdot 113^1}{3^4\cdot 5^1\cdot 7^1}+\frac{p_2^2 p_1^3 2^3}{3^2\cdot 5^1\cdot 7^1}+\frac{p_2 p_3 p_1^2 -1^1\cdot 39341^1}{3^5\cdot 5^2\cdot 7^1\cdot 11^1}+\frac{p_5 p_1^2 2^4\cdot 277^1}{3^4\cdot 5^2\cdot 7^1}+\frac{p_2^3 p_1 -1^1\cdot 2^1\cdot 3989^1}{3^5\cdot 5^2\cdot 7^1\cdot 11^1}+\frac{p_6 p_1 -1^1\cdot 2^1\cdot 305633^1}{3^5\cdot 5^2\cdot 7^1\cdot 11^1}+\frac{p_2 p_4 p_1 1399^1}{3^3\cdot 5^2\cdot 11^1}+\frac{p_3^2 p_1 22027^1}{3^5\cdot 5^2\cdot 7^1\cdot 11^1}+\frac{p_2^2 p_3 2^3\cdot 2087^1}{3^5\cdot 5^2\cdot 7^1\cdot 11^1}+\frac{p_3 p_4 -1^1\cdot 2^1\cdot 97^1\cdot 107^1}{3^4\cdot 5^2\cdot 7^1\cdot 11^1}+\frac{p_2 p_5 -1^1\cdot 2^1\cdot 23^2}{3^5\cdot 11^1}+\frac{p_7 2^2\cdot 8191^1}{3^4\cdot 5^1\cdot 11^1}}{3^2\cdot 5^1\cdot 7^1\cdot 13^1}$
Now here are the things I was struggling with. I need to use these results in a paper so I was requested to have a certain format. I need the variables out of the fraction and I need the common denominator to be in front of everything, instead of having a fraction over a fraction i.e. instead of let's say $\frac{\frac{7p_ 2}{2} -p_ 1^2}{3^2\cdot 5^1}$ I need $\frac{1}{3^2\cdot 5^1}(\frac{7}{2} p_ 2-p_ 1^2)$. Also, in the example I gave $L_1$ is weird and this happens sometimes in other polynomials. Why is this? (but this is less important). So, can anyone tell me how to fix this formating problem as I tried so so many functions and stuff, but nothing works, and doing it by hand in Latex, not only it is time consuming, but it is seriously prone to error... Thank you!Silviu Udrescu2018-03-17T18:50:14Z[✓] High resolution GeoElevationData ?
http://community.wolfram.com/groups/-/m/t/1188722
I'm trying to produce 3D models in the Wolfram Language of various mountains around the world. The GeoElevationData[] function does not have enough resolution for a good looking model at the scale of a mountain, so I'm searching for online data sets that have more resolution and can be imported into Wolfram. For mountains in the United States, the United States Geological Survey offers ArcGRID files that Wolfram can import. This has worked fabulously, producing models such as this:
![enter image description here][1]
(Can you tell what mountain it is?)
But when I try to find data for mountains outside the US, like Mt. Fuji or Mt. Everest, I get overwhelmed by the abundance of file formats that, as far as I can tell, won't work in Wolfram. I sense that there is a way to do this. Has anyone solved this problem before? I could sure use some help here.
Thanks in advance,
Mark Greenberg
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-09-20at8.14.21AM.png&userId=788861Mark Greenberg2017-09-20T15:35:58ZMathematica beyond mathematics
http://community.wolfram.com/groups/-/m/t/1109299
For the past 25 years I’ve been conducting Mathematica seminars and teaching students how to develop applications using the program in a wide variety of campuses. These experiences have taught me several things:
i. A majority of both experienced users and newcomers, still think erroneously that Mathematica is mostly a language for solving symbolic math problems.
ii. Plenty of long-term users are not aware of many of the new capabilities that that have been added to the program over the years.
iii. The number of functions available has grown enormously and now there are more than 6,000. With so many functions, it very time consuming to learn about them using the extensive Wolfram documentation.
I decided to address these issues and show that the program has capabilities that go beyond math calculations writing a book ([Mathematica beyond mathematics][1]). Throughout the text, Mathematica’s features, including of course the latest ones, are introduced while solving problems in many different fields such as: astronomy, biology, chemistry, economics, finance, geography, linguistics and nuclear physics among many others (See Contents) . When choosing the problems, I have relied on my own experience and also modified a few selected examples from Wolfram Research vast information resources. At the end of each chapter there’re also additional sources to further explore the topics. I have also strived to avoid writing too complicated programs and except in a reduced number of cases, all the examples contain just a few lines of code.
[1]: http://diarium.usal.es/guillermo/mathematica/Guillermo Sanchez2017-05-28T09:06:58ZHow to select elements of a list based on a condition and order position
http://community.wolfram.com/groups/-/m/t/1303625
I encounter a common problem in data science that is difficult to solve in some languages and easier in others, and I'm wondering how Wolfram language can solve it.
In ordered lists, there is an implicit "before" and "after" relationship. Often I need to select or operate on this element after a conditional.
For instance, in the english word list, return the letters (and perhaps make a histogram) that follow the letter "i", to prove or disprove "i before e, except after c".
Another example, given a list of dates with an associated measure for each, calculate the difference of the measures between any two dates. The most needed calculation is "now" from "last".
Trigger events are another variation of this problem, i.e. capture all elements that meet "this" criteria, after "that" condition has been set. I've used this extensively in digital signal processing and other pattern recognition programs.
Thanks.Andy Hollister2018-03-17T15:17:07Z[✓] Understand orderings in ToExpression and RowBox?
http://community.wolfram.com/groups/-/m/t/1302184
(Posted to StackExchange a week ago, with no response.)
With:
ToExpression[RowBox[{"c", ToBoxes[Plot[Sin[x], {x, -2, 2}]], "a"}]]
I get the three elements of the array, but with "a" and then "c" at the beginning. I would like to retain the order as I have input it.
I found that:
ToExpression[RowBox[{"c", "b", "a"}]]
reverses the order, but:
ToExpression[RowBox[{"\(", "c", "b", "a", "\)"}]]
retains the input order (and removes spaces in between).
However, applying this to my original snippet:
ToExpression[
RowBox[{"\(", "c", ToBoxes[Plot[Sin[x], {x, -2, 2}]], "a", "\)"}]]
it comes back with:
RowBox[{"c", "\"Private`zztop$3\"", "a"}]
(zztop??).
Please help me understand the restrictions here, as well as possible work-arounds.
Thank you.Aaron Naiman2018-03-14T09:08:17ZParametricPlot3D doesn't work at all
http://community.wolfram.com/groups/-/m/t/1303304
Hey folks,
I recently installed Wolfram Mathematica on my laptop and I have just noticed that my program is completely incapable of producing three-dimensional parametric plots. I've tried looking for errors in my syntax but it didn't change a thing. I even ended up copying the example functions for parametricPlot3D and pasting them in my documents, but Mathematica only produced a blank cartesian coordinate system in two dimensions.
This is the line I used: ParametricPlot3D[{Sin[u], Cos[u], u/10}, {u, 0, 20}].. and Mathematica only produces blank two-dimensional coordinates.
Has anyone else experienced this problem? As I am fairily new to Mathematica it very well may be that I've committed a fundamental mistake but I sure can't seem to find one no matter how hard I try.
Anyway, I just wanted to show you my problem... If anyone knows a fix to this, make sure to let me know. Thank you in advance!Elia Schmidt2018-03-16T14:59:45ZImprove neural network performance with Mathematica 11.3 ?
http://community.wolfram.com/groups/-/m/t/1298554
I look at the blog post with the 11.3 word cloud with 'Blockchain' as the BIG center and ask how important is that? As I run the exact same data science GPU code on identical hardware software configuration except for the change from Mathematica 11.2 to Mathematica 11.3 and see my neural network performance go from 295 seconds on 11.2 to 2038 seconds on 11.3. Again NO change other than Mathematica version. And then I see that Mathematica 11.3 still does not support current XCode LLVM/GCC compiler or NVIDIA for CUDA tools (watch it move back to old paclet for Mathematica 10.5 after you upgrade your XCode command line tools to current version, am I expected to pay money to figure this out?) .
This is my experience as I explore the value of Mathematica since release 10 to today for data science and at the same time see the massive improvements and quality of Python, Jupyter, NVIDIA, iOS CoreML, Vulkan, Tensorflow and core GPU computing on MacOS, iOS and Linux.
Really questioning the value proposition of Wolfram for data science going forward. Sad.David Proffer2018-03-10T04:14:59ZMathematica Local WebServer on Mac OS X Failed to Start
http://community.wolfram.com/groups/-/m/t/1269849
I recently watched the video class on [Web Programming and Development][1] and was greatly intrigued by the ability to serve web related work locally before CloudDeploy'ing. In the video class, the StartWebServer function was used so I immediately stopped the on demand video to try it out. After realizing the **StartWebServer** command was not "standard" (at least not found in the standard Mathematica docs), I was able to uncover it lives in **HTTPHandling**.
I'm running Mathematica 11.2.0.0 on Mac OS 10.13.2 and executing the command below fails.
HTTPHandling`StartWebServer[ExportForm["Hello", "HTML"]]
The error message reported is:
WebServer: The HTTP server failed to start with error code None and stderr output:
EndOfFile.
Any ideas what I'm doing wrong? Perhaps there is some other dependency I need.
Regards.
[1]: http://www.wolfram.com/training/courses/wl050.htmlMac Rod2018-01-20T21:50:46ZUse CellGroup[] in current Notebook?
http://community.wolfram.com/groups/-/m/t/1302175
(Posted to StackExchange a week ago, with no response.)
I have used the Option Inspector to set `CellGrouping` to `Manual` for the current, selected Notebook. Nonetheless, the following does not group these two cells together:
CellPrint[CellGroup[{TextCell["hello"], TextCell["goodbye"]}]]
Also, adding the second argument to `CellGroup[]` to specify which cell should be open, does not work.
Please note that both of these work if I create the cells in a new Notebook, created with `CellGrouping -> Manual`.
I saw the same behavior with `Cell[CellGroupData[...]]`.
What am I missing?Aaron Naiman2018-03-14T09:04:14Z[GIF] Caught (Voronoi cells of stereographically projected pattern)
http://community.wolfram.com/groups/-/m/t/1286395
![Voronoi cells of stereographically projected pattern][1]
**Caught**
Continuing with the stereographic projection theme. This time, I generated a bunch of points arranged in spirals on the sphere, like so:
![Points on the sphere][2]
Then I stereographically project the points to the plane and compute the Voronoi diagram of the resulting points. Throw in a rotation of the sphere and you get the above animation.
As for the code, first of all we need the stereographic projection map:
Stereo[p_] := p[[;; -2]]/(1 - p[[-1]])
Next, we need to define the points. It turned out that without throwing in some noise in the definition of the points, `VoronoiMesh[]` would occasionally fail, which is why I put in the `RandomVariate[]` business in both cylindrical coordinates:
pts = With[{n = 20},
Table[
CoordinateTransformData["Cylindrical" -> "Cartesian", "Mapping"]
[{Sqrt[1 - (z + #)^2], θ + RandomVariate[UniformDistribution[{-.00001, .00001}]]
+ (z + # + 2)/2 * π/2, z + #}
&[RandomVariate[UniformDistribution[{-.00001, .00001}]]]
],
{z, -.9, .9, 2/n}, {θ, 0, 2 π - 2 π/n, 2 π/n}]
];
Finally, then, here's the animation:
With[{cols = RGBColor /@ {"#F5841A", "#03002C"}},
Manipulate[
VoronoiMesh[
Stereo[RotationMatrix[θ, {1., 0, 0}].#] & /@ Flatten[pts, 1],
{{-4.1, 4.1}, {-4.1, 4.1}}, PlotTheme -> "Lines", PlotRange -> 4,
MeshCellStyle -> {{1, All} -> Directive[Thickness[.005], cols[[1]]]},
ImageSize -> 540, Background -> cols[[-1]]],
{θ, 0, π}
]
]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=r11Lqrc.gif&userId=610054
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=5946Untitled-13.png&userId=610054Clayton Shonkwiler2018-02-16T21:10:29ZSimulate a stochastic differential equation?
http://community.wolfram.com/groups/-/m/t/1300502
Hello there
I need to reproduce the results of a simulation found elsewhere. The model is a set of nonlinear differential equations with 5 variables (x1,x2,z,y1,y2). To the equations on the derivatives of x1 and y1 I need to add a Gaussian noise with standard deviation set to 0.025. To the ones on x2 and y2, 0.25.
Something like:
dx1/dt=fx1(x1,x2,y1,y2,z)+WGN(0,0.025),
dx2/dt=fx2(x1,x2,y1,y2,z)+WGN(0,0.25)
and so on
Could someone help me out with directions, methods to be used and etc, please?
Thank you.
EdEduardo Mendes2018-03-11T21:47:06Z[Numberphile] - The Square-Sum Problem
http://community.wolfram.com/groups/-/m/t/1264240
As part of my Numberphile series of posts:
- [\[Numberphile\] - Frog Jumping - Solving the puzzle][1]
- [\[Numberphile\] - The Illumination Problem][2]
- [\[Numberphile\] - Sandpiles - Done in the Wolfram Language][3]
here is another one about a recent video called [The Square-Sum Problem][4]
[![enter image description here][5]][6]
The question is: if you have the integers 1 through n, can you arrange that list in such a way that every two adjacent ones sum to a square number. As seen in the video and the [extra footage][7].
We can easily check this in the Wolfram Language:
Let's see which number can pair up to a pair:
SquareEdges[n_Integer?Positive]:=Reap[Do[If[IntegerQ[Sqrt[i+j]],Sow[{i,j}]],{i,n-1},{j,i+1,n}]][[2,1]]
Now let's try for 15, as in the main video:
n = 15;
poss = SquareEdges[n];
gr = Graph[TwoWayRule @@@ poss, VertexLabels -> Automatic];
path = FindHamiltonianPath[gr, PerformanceGoal :> "Speed"]
HighlightGraph[gr, BlockMap[Rule @@ # &, path, 2, 1]]
giving:
{9, 7, 2, 14, 11, 5, 4, 12, 13, 3, 6, 10, 15, 1, 8}
![enter image description here][8]
In the extra footage, it is revealed that they found the solution for up to n=299. Can we do better? Yes we can! Changing n to 300 in the above code and rerunning gives us the solution in 0.28 sec on my laptop.
{289,35,65,259,30,294,67,257,32,292,69,100,44,125,71,154,135,189,211,113,248,8,281,119,205,195,166,158,283,6,250,191,133,156,285,4,252,277,12,244,117,207,193,168,273,16,240,160,164,236,20,269,131,94,230,59,197,92,232,57,199,90,234,22,267,217,224,137,152,73,123,46,150,75,121,48,148,77,179,110,214,270,19,237,163,161,239,17,272,128,41,103,297,27,262,62,227,97,99,190,210,114,175,50,146,79,177,112,212,188,253,3,286,155,134,266,23,233,91,198,58,231,93,196,60,229,95,130,159,165,276,13,243,118,206,194,167,274,15,241,288,1,255,186,138,223,218,143,181,108,88,201,55,170,86,203,53,172,84,37,107,182,142,299,25,264,220,221,140,184,216,225,64,36,85,171,54,202,87,169,56,200,89,235,21,268,132,157,284,5,251,278,11,245,116,208,192,249,7,282,247,9,280,204,120,136,153,72,124,45,151,74,122,47,149,76,180,109,215,185,139,222,219,265,24,300,141,183,106,38,83,173,52,144,81,40,104,296,28,261,63,226,98,127,42,102,298,26,263,61,228,96,129,271,18,238,162,279,10,246,115,209,275,14,242,287,2,254,187,213,111,178,78,147,49,176,80,145,51,174,82,39,105,295,29,260,101,43,126,70,291,33,256,68,293,31,258,66,34,290}
and a completely mess of a graph:
![enter image description here][9]
Can we go beyond? Let's optimize a code a bit, and let's find the solution for larger n:
Let's store our intermediate results in the association **db**:
SetDirectory[NotebookDirectory[]];
$HistoryLength=1;
db=If[FileExistsQ["squaresumdb.mx"],
Import["squaresumdb.mx"]
,
<||>
];
And now our main code:
ClearAll[SquareEdges,SquareEdges2,CheckSol,TryToFind]
SquareEdges[n_Integer?Positive]:=Reap[Do[If[IntegerQ[Sqrt[i+j]],Sow[{i,j}]],{i,n-1},{j,i+1,n}]][[2,1]]
SquareEdges2[n_Integer]:=Module[{tmp},
tmp=Table[
{i,#}&/@(Range[Ceiling[Sqrt[2 i]],Floor[Sqrt[i+n]]]^2-i)
,
{i,1,n-1}
];
tmp=Join@@tmp;
Select[tmp,Less@@#&]
]
CheckSol[l_List]:=Sort[l]===Range[Length[l]]\[And](And@@BlockMap[IntegerQ@*Sqrt@*Total,l,2,1])
TryToFind[n_Integer?Positive]:=Module[{edges,out},
If[!KeyExistsQ[db,n],
edges=SquareEdges2[n];
If[Union[Flatten[edges]]===Range[n],
edges=TwoWayRule@@@edges;
edges=RandomSample[edges];
Do[
out=TimeConstrained[FindHamiltonianPath[Graph[edges],PerformanceGoal:>"Speed"],5+i,$Failed];
If[out=!=$Failed,
If[Length[out]==0,
Print[Style["No solution for ",Red],n];
,
status=Row[{"Found solution for ",n,":",i}];
];
AssociateTo[db,n->out];
Break[]
];
Print["Failed ",n,":",i];
edges=RandomSample[edges];
,
{i,5}
]
,
Print["Edges are not connected for ",n];
AssociateTo[db,n->{}]
]
]
]
Let's scan the first 1000:
Dynamic[status]
status = "";
Do[TryToFind[k], {k, 3, 1000}]
Export["squaresumdb.mx", db];
Note that if finding the Hamiltonian path takes too long I mix the edges and try again, sometimes, seemingly random, it then finds the solution quickly.
I can tell you now that all of them have a solution. In fact I went up to larger numbers and found that all up to 2667 have a solution, and possibly beyond. I attached the notebook and the solutions in form of a mx file.
[1]: http://community.wolfram.com/groups/-/m/t/1055504
[2]: http://community.wolfram.com/groups/-/m/t/1048489
[3]: http://community.wolfram.com/groups/-/m/t/1058615
[4]: https://www.youtube.com/watch?v=G1m7goLCJDY
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-11at23.36.51.png&userId=73716
[6]: https://www.youtube.com/watch?v=G1m7goLCJDY
[7]: https://www.youtube.com/watch?v=7_ph5djCCnM
[8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-11at23.43.52.png&userId=73716
[9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-11at23.46.51.png&userId=73716Sander Huisman2018-01-11T23:29:05Z[✓] Override the default square aspect ratio of Contour or Plot3D images?
http://community.wolfram.com/groups/-/m/t/1303102
When one uses the default Plot3D command like:
Plot3D[Re[ufun[x, y]], {x, xlow, xhigh}, {y, ylow, yhigh},
ColorFunction -> "TemperatureMap"]
You get square (x,y) base plane plots. The actual aspect ratio is Aratio=(xhigh-xlow)/(yhigh-ylow). But when Aratio is say 10/1,
it would be nicer to have a rectangular shape base than the default Aratio=1 square one.
Do how to alter the above command to get a user controlled aspect ratio?
Thanks in advanceAnthony Kalinowski2018-03-15T19:56:43Z[✓] Use transformation matrices that act on vector?
http://community.wolfram.com/groups/-/m/t/1302857
Hi ,
I'm new with Mathematica and would like to know how to write transformation matrices (operators) that act on vectors (for tensor analysis). Or a Jacobinan-type matrix For example, a differential operator that acts on a column vector of functions:
row 1: d[ ]/dx1 d[ ]/dx2
row 2: d[ ]/dx3 d[ ]/dx4
How can I do that in Mathematica? The regular linear algebra functions don't work.
AUSP6andreusp62018-03-15T15:21:08ZSolve problem with the lambert W function?
http://community.wolfram.com/groups/-/m/t/1302783
I have facing a problem in solving the lambert W function in mathematica. I have generated the x values from lambert function but I cant get the solution .ProductLog",
\[Phi] = 0.5; \[Kappa] = 0.2; u = RandomReal[ {0, 1}, 10];
x = (1/\[Phi])*
Log[(\[Kappa] - 1 + ((1 + \[Kappa])^2 - 4*\[Kappa]*u)^0.5)/(
2*\[Kappa])] - (1/\[Phi]^2) - (1/\[Phi])*\!\(\*
ButtonBox["ProductLog",
BaseStyle->"Link",
ButtonData->"paclet:ref/ProductLog"]\)[-(1/\[Phi])*
Exp[-(1/\[Phi])] ((\[Kappa] -
1 + ((1 + \[Kappa])^2 - 4*\[Kappa]*u)^0.5)/(2*\[Kappa]))]Maha haroon2018-03-15T14:13:52ZThe spherical Lloyd algorithm
http://community.wolfram.com/groups/-/m/t/1302146
![visualization of Lloyd relaxation with a Voronoi diagram][1]
[Lloyd's algorithm](https://en.wikipedia.org/wiki/Lloyd%27s_algorithm) is a method that repeatedly generates the Voronoi diagram of a given set of points, and then replaces each point with the centroid of its corresponding Voronoi cell. It is useful for evenly redistributing points around a rectangular region.
Code for the usual Euclidean version can be found in [this Mathematica Stack Exchange post](https://mathematica.stackexchange.com/a/97358).
In this post, I will be demonstrating the spherical version of Lloyd's algorithm.
The code has its roots in [a Wolfram Demonstration written by Maxim Rytin](http://demonstrations.wolfram.com/VoronoiDiagramOnASphere/) for rendering a spherical Voronoi diagram. I had modernized it in [this Mathematica Stack Exchange post](https://mathematica.stackexchange.com/a/142100), and then had the notion that this code could be extended to implement the spherical Lloyd algorithm.
First, we need a few auxiliary routines. Older versions of *Mathematica* had an unstable implementation of `VectorAngle[]`, so I wrote [a stable version](https://mathematica.stackexchange.com/a/97854):
vecang[v1_?VectorQ, v2_?VectorQ] := Module[{n1 = Norm[v1], n2 = Norm[v2]},
2 ArcTan[Norm[v1 n2 + n1 v2], Norm[v1 n2 - n1 v2]]]
(You should be able to replace this with `VectorAngle[]` from version 11.2 onwards.)
Next, I needed a faster version of `RotationMatrix[]` for rotating one vector into another, so I wrote [a routine for doing that](https://mathematica.stackexchange.com/a/167114), too:
vectorRotate[vv1_?VectorQ, vv2_?VectorQ] :=
Module[{v1 = Normalize[vv1], v2 = Normalize[vv2], c, d, d1, d2, t1, t2},
d = v1.v2;
If[TrueQ[Chop[1 + d] == 0],
c = UnitVector[3, First[Ordering[Abs[v1], 1]]];
t1 = c - v1; t2 = c - v2; d1 = t1.t1; d2 = t2.t2;
IdentityMatrix[3] - 2 (Outer[Times, t2, t2]/d2 -
2 t2.t1 Outer[Times, t2, t1]/(d2 d1) + Outer[Times, t1, t1]/d1),
c = Cross[v1, v2];
d IdentityMatrix[3] + Outer[Times, c, c]/(1 + d) - LeviCivitaTensor[3].c]]
These two are needed for computing the "spherical centroid" of a spherical polygon, as defined by [Buss and Fillmore](https://doi.org/10.1145/502122.502124):
(* exponential map for sphere *)
sphereExp[q_?VectorQ, p_?VectorQ] /; Length[q] == Length[p] + 1 :=
With[{n = Norm[p]}, vectorRotate[{0, 0, 1}, q].Append[p Sinc[n], Cos[n]]]
(* inverse of exponential map for sphere *)
sphereLog[q_?VectorQ, p_?VectorQ] /; Length[q] == Length[p] :=
Most[vectorRotate[q, {0, 0, 1}].p]/Sinc[vecang[p, q]]
SphericalPolygonCentroid[pts_?MatrixQ] := Module[{k = 0, n = Length[pts], cp, h, pr},
cp = Normalize[Total[pts]];
pr = Internal`EffectivePrecision[pts];
While[cp = sphereExp[cp, h = Sum[sphereLog[cp, p], {p, pts}]/n];
k++; Norm[h] > 10^(-pr/2) && k <= 30];
cp]
Before I show the algorithm, let us first generate some starting points that will be "relaxed" by Lloyd's algorithm:
BlockRandom[SeedRandom[1337, Method -> "MersenneTwister"];
points = {2 π #1, ArcCos[2 #2 - 1]} & @@@ RandomReal[1, {50, 2}]]
(* convert to Cartesian *)
sp = Function[{u, v}, {Cos[u] Sin[v], Sin[u] Sin[v], Cos[v]}] @@@ points;
The code that implements Lloyd's algorithm is now remarkably compact:
With[{maxit = 40, (* maximum iterations *)
tol = 0.002 (* distance tolerance *)},
fr = FixedPointList[Function[pts,
Block[{ch, polys, verts, vor},
ch = ConvexHullMesh[pts];
verts = MeshCoordinates[ch];
polys = First /@ MeshCells[ch, 2];
vor = Normalize[Cross[verts[[#2]] - verts[[#1]],
verts[[#3]] - verts[[#1]]]] & @@@ polys;
SphericalPolygonCentroid[vor[[#]]] & /@ ch["VertexFaceConnectivity"]]],
sp, maxit,
SameTest -> (Max[MapThread[vecang, {#1, #2}]] < tol &)]];
I used `FixedPointList[]` so that I can visualize the progress of the algorithm in what follows. One can just use `FixedPoint[]`, of course, if only the final result is wanted.
Now, we can visualize how the points move:
frames = Graphics3D[{{Opacity[.75], Sphere[]}, {Green, Sphere[#, 0.02]}}, Boxed -> False] & /@ fr;
ListAnimate[frames]
![progress of points being relaxed by the Lloyd algorithm][2]
---
One might instead want to see how the Voronoi cells themselves shift around as Lloyd's algorithm proceeds. Visualizing that will require a bit more work.
First, we need a way to render individual spherical polygons, corresponding to the cells of a spherical Voronoi diagram. In [this Mathematica Stack Exchange post](https://mathematica.stackexchange.com/a/154112), I gave routines for rendering a spherical polygon, which I reproduce here along with its auxiliary routines:
(* slerp for two points *)
slerp = Compile[{{q1, _Real, 1}, {q2, _Real, 1}, {f, _Real}},
Module[{n1 = Norm[q1], n2 = Norm[q2], omega, so},
omega = 2 ArcTan[Norm[q1 n2 + n1 q2], Norm[q1 n2 - n1 q2]];
If[Chop[so = Sin[omega]] == 0, q1, Sin[{1 - f, f} omega].{q1, q2}/so]]];
(* stripped down version of functions in
https://mathematica.stackexchange.com/a/10385 *)
sphericalLinearInterpolation[pts_?MatrixQ] := Module[{times},
times = Accumulate[Prepend[vecang @@@ Partition[pts, 2, 1, 1], 0]];
{Last[times], sphericalInterpolatingFunction[times, pts]}]
sphericalInterpolatingFunction[times_, vecs_][t_?NumericQ] :=
With[{k = GeometricFunctions`BinarySearch[times, t]},
slerp[vecs[[k]], vecs[[k + 1]], Rescale[t, times[[{k, k + 1}]], {0, 1}]]]
SphericalPolygon[pts_?MatrixQ, p_: 8] := SphericalPolygon[pts, {p, p}]
SphericalPolygon[pts_?MatrixQ, {p_, q_}] := Module[{ch, cp, en, pt, ql, sp, spl},
cp = SphericalPolygonCentroid[pts];
{en, sp} = sphericalLinearInterpolation[ArrayPad[pts, {{0, 1}}, "Periodic"]];
ch = Sin[π Range[p]/(2 p)]^2; (* rescaled Chebyshev points *)
spl = Most[First[Cases[ParametricPlot3D[sp[t], {t, 0, en}, PlotPoints -> q],
Line[l_] :> l, ∞]]];
ql = Length[spl];
pt = Prepend[Apply[Join, Outer[Normalize[#1.{cp, #2}] &,
Transpose[{Append[Reverse[Most[ch]], 0], ch}],
spl, 1]], cp];
GraphicsComplex[pt, {EdgeForm[],
Polygon[PadLeft[Partition[Range[ql] + 1, 2, 1], {Automatic, 3}, 1]
~Join~
Flatten[Apply[Join[Reverse[#1], #2] &,
Partition[Partition[Range[p ql] + 1, ql],
{2, 2}, {1, 1},
{{1, 1}, {-1, 1}}],
{2}], 1]]}, VertexNormals -> pt]]
Here is a routine for generating the spherical Voronoi diagram itself (cf. the Lloyd implementation given above):
sphericalVoronoi[pts_?MatrixQ] := Module[{ch, polys, verts, vor},
ch = ConvexHullMesh[pts];
verts = MeshCoordinates[ch];
polys = First /@ MeshCells[ch, 2];
vor = Normalize /@ (Cross[verts[[#2]] - verts[[#1]],
verts[[#3]] - verts[[#1]]] & @@@ polys);
{vor, ch["VertexFaceConnectivity"]}]
The following code will then generate the cartoon at the beginning of this post:
frames = Function[pts,
Graphics3D[{MapIndexed[{ColorData[99] @@ #2, SphericalPolygon[#1, 12]} &,
(Function[idx, #1[[idx]]] /@ #2) & @@ sphericalVoronoi[pts]],
{Green, Sphere[pts, 0.02]}},
Boxed -> False, Lighting -> "Neutral"]] /@ fr;
ListAnimate[frames]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=sphlloydb.gif&userId=520181
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=sphlloyda.gif&userId=520181J. M.2018-03-14T08:40:08ZArrowHead not at the end of a tube? (Mathematica V11.3)
http://community.wolfram.com/groups/-/m/t/1302365
With the 11.3 version the combination Arrow Tube give unexpected results : the arrow head is not positionned at the end of the tube as expected from documentation :
http://reference.wolfram.com/language/ref/Arrow.html
3rd example of the basics
Code example :
Graphics3D[{Red, Arrowheads[0.1],
Arrow[Tube[{{1, 1, -1}, {2, 2, 0}, {3, 3, -1}, {4, 4, 0}}, 0.05]]}]Dominique Massiot2018-03-14T17:17:07ZSolve for 4 constants in system of 4 ODE's with B.V.'s known?
http://community.wolfram.com/groups/-/m/t/1299152
Hi,
I am trying to solve for constants U, A, Ch, and Bo in the following system of 4 ODE's with boundary values known. How do I go about this?
Best,
StephenStephen Roys2018-03-10T04:59:24ZGet a list of defined functions or variables of a particular notebook?
http://community.wolfram.com/groups/-/m/t/1301880
Dear friends,
I have a very big program written in MATHEMATICA and it is so difficult to check if I defined some functions in the same lable. How can I find the repeated name for more than one definition?
I am looking forward to receiving your help
With my best regards.Ahmad Alali2018-03-14T11:10:20ZThoughts on a Python interface, and why ExternalEvaluate is just not enough
http://community.wolfram.com/groups/-/m/t/1185247
`ExternalEvaluate`, introduced in M11.2, is a nice initiative. It enables limited communication with multiple languages, including Python, and appears to be designed to be relatively easily extensible (see ``ExternalEvaluate`AddHeuristic`` if you want to investigate, though I wouldn't invest in this until it becomes documented).
**My great fear, however, is that with `ExternalEvaluate` Wolfram will consider the question of a Python interface settled.**
This would be a big mistake. A *general* framework, like `ExternalEvaluate`, that aims to work with *any* language and relies on passing code (contained in a string) to an evaluator and getting JSON back, will never be fast enough or flexible enough for *practical scientific computing*.
Consider a task as simple as computing the inverse of a $100\times100$ Mathematica matrix using Python (using [`numpy.linalg.inv`](https://docs.scipy.org/doc/numpy/reference/generated/numpy.linalg.inv.html)).
I challenge people to implement this with `ExternalEvaluate`. It's not possible to do it *in a practically useful way*. The matrix has to be sent *as code*, and piecing together code from strings just can't replace structured communication. The result will need to be received as something encodable to JSON. This has terrible performance due to multiple conversions, and even risks losing numerical precision.
Just sending and receiving a tiny list of 10000 integers takes half a second (!)
In[6]:= ExternalEvaluate[py, "range(10000)"]; // AbsoluteTiming
Out[6]= {0.52292, Null}
Since I am primarily interested in scientific and numerical computing (as I believe most M users are), I simply won't use `ExternalEvaluate` much, as it's not suitable for this purpose. What if we need to do a [mesh transformation](https://mathematica.stackexchange.com/q/155484/12) that Mathematica can't currently handle, but there's a Python package for it? It's exactly the kind of problem I am looking to apply Python for. I have in fact done mesh transformations using MATLAB toolboxes directly from within Mathematica, using [MATLink][1], while doing the rest of the processing in Mathematica. But I couldn't do this with ExternalEvaluate/Python in a reasonable way.
In 2017, any scientific computing system *needs* to have a Python interface to be taken seriously. [MATLAB has one][2], and it *is* practically usable for numerical/scientific problems.
----
## A Python interface
I envision a Python interface which works like this:
- The MathLink/WSTP API is exposed to Python, and serves as the basis of the system. MathLink is good at transferring large numerical arrays efficiently.
- Fundamental data types (lists, dictionaries, bignums, etc.) as well as datatypes critical for numerical computing (numpy arrays) can be transferred *efficiently* and *bidirectionally*. Numpy arrays in particular must translate to/from packed arrays in Mathematica with the lowest possible overhead.
- Python functions can be set up to be called from within Mathematica, with automatic argument translation and return type translation. E.g.,
PyFun["myfun"][ (* myfun is a function defined in Python *)
{1,2,3} (* a list *),
PyNum[{1,2,3}] (* cast to numpy array, since the interpretation of {1,2,3} is ambiguous *),
PySet[{1,2,3}] (* cast to a set *)
]
- The system should be user-extensible to add translations for new datatypes, e.g. a Python class that is needed frequently for some application.
- The primary mode of operation should be that Python is run as a slave (subprocess) of Mathematica. But there should be a second mode of operation where both Mathematica and Python are being used interactively, and they are able to send/receive structured data to/from each other on demand.
- As a bonus: Python can also call back to Mathematica, so e.g. we can use a numerical optimizer available in Python to find the minimum of a function defined in Mathematica
- An interface whose primary purpose is to call Mathematica from Python is a different topic, but can be built on the same data translation framework described above.
The development of such an interface should be driven by real use cases. Ideally, Wolfram should talk to users who use Mathematica for more than fun and games, and do scientific computing as part of their daily work, with multiple tools (not just M). Start with a number of realistic problems, and make sure the interface can help in solving them. As a non-trivial test case for the datatype-extension framework, make sure people can set up auto-translation for [SymPy objects][3], or a [Pandas dataframe][4], or a [networkx graph][5]. Run `FindMinimum` on a Python function and make sure it performs well. (In a practical scenario this could be a function implementing a physics simulation rather than a simple formula.) As a performance stress test, run `Plot3D` (which triggers a very high number of evaluations) on a Python function. Performance and usability problems will be exposed by such testing early, and then the interface can be *designed* in such a way as to make these problems at least solvable (if not immediately solved in the first version). I do not believe that they are solvable with the `ExternalEvaluate` design.
Of course, this is not the only possible design for an interface. J/Link works differently: it has handles to Java-side objects. But it also has a different goal. Based on my experience with MATLink and RLink, I believe that *for practical scientific/numerical computing*, the right approach is what I outlined above, and that the performance of data structre translation is critical.
----
## ExternalEvaluate
Don't get me wrong, I do think that the `ExternalEvaluate` framework is a very useful initiative, and it has its place. I am saying this because I looked at its source code and it appears to be easily extensible. R has zeromq and JSON capabilities, and it looks like one could set it up to work with `ExternalEvaluate` in a day or so. So does Perl, anyone want to give it a try? `ExternalEvaluate` is great because it is simple to use and works (or can be made to work) with just about any interpreted language that speaks JSON and zeromq. But it is also, in essence, a quick and dirty hack (that's extensible in a quick and dirty way), and won't be able to scale to the types of problems I mentioned above.
----
## MathLink/WSTP
Let me finally say a few words about why MathLink/WSTP are critical for Mathematica, and what should be improved about them.
I believe that any serious interface should be built on top of MathLink. Since Mathematica already has a good interface capable of inter-process communication, that is designed to work well with Mathematica, and designed to handle numerical and symbolic data efficiently, use it!!
Two things are missing:
- Better documentation and example programs, so more people will learn MathLink
- If the MathLink library (not Mathematica!) were open source, people would be able to use it to link to libraries [which are licensed under the GPL][6]. Even a separate open source implementation that only supports shared memory passing would be sufficient—no need to publish the currently used code in full. Many scientific libraries are licensed under the GPL, often without their authors even realizing that they are practically preventing them from being used from closed source systems like Mathematica (due to the need to link to the MathLink libraries). To be precise, GPL licensed code *can* be linked with Mathematica, but the result cannot be shared with anyone. I have personally requested the author of a certain library to grant an exception for linking to Mathematica, and they did not grant it. Even worse, I am not sure they understood the issue. The authors of other libraries *cannot* grant such a permission because they themselves are using yet other GPL's libraries.
[MathLink already has a more permissive license than Mathematica.][7] Why not go all the way and publish an open source implementation?
I am hoping that Wolfram will fix these two problems, and encourage people to create MathLink-based interfaces to other systems. (However, I also hope that Wolfram will create a high-quality Python link themselves instead of relying on the community.)
I have talked about the potential of Mathematica as a glue-language at some Wolfram events in France, and I believe that the capability to interface external libraries/systems easily is critical for Mathematica's future, and so is a healthy third-party package ecosystem.
[1]: http://matlink.org/
[2]: https://www.mathworks.com/help/matlab/matlab-engine-for-python.html
[3]: http://www.sympy.org/
[4]: http://pandas.pydata.org/
[5]: https://networkx.github.io/
[6]: https://en.wikipedia.org/wiki/Copyleft
[7]: https://www.wolfram.com/legal/agreements/mathlink.htmlSzabolcs Horvát2017-09-15T12:33:04ZMathematica books for economists?
http://community.wolfram.com/groups/-/m/t/1302120
Mathematica for microeconomics by John Robert Stinespring, is a good one but its latest version is from 2002.
Can you give any recommendation for mathematica reference for economics with recent publication?
Nice day :)Jihun Park2018-03-14T02:24:25ZMathematica 11.3's new DeBruijnSequence: adding new dimensions
http://community.wolfram.com/groups/-/m/t/1301267
Introduction
----------
The new version of Mathematica (11.3) introduces a whole range of interesting new functionality. Some functions like [FindTextualAnswer][1] and [FindEquationalProof][2] quite clearly open up new possibilities and provide tools of enormous power. But MMA 11.3 also introduces a huge range of other functionality that might go a bit unnoticed but also is highly interesting. Here I show the example of [DeBruijnSequence][3] and [DeBruijnGraph][4] which are interesting not only for safe busters.
Suppose we have a lock like this one:
![enter image description here][5]
Suppose we have to enter a 4 digit code. There are $10^4=10000$ combinations, starting at 0000, 0001, ..., 9999. Each has 4 digits so if I want to test all combinations I will need 40000 keystrokes.
Let's suppose that the key lock is stupid, and only remembers the last for digits you entered. So if you entered 207689, it would have tested the combinations 2076, 0768, and 7689. So I only needed to type in 6 keystrokes instead of 12. We want to ask the following question:
> What is the shortest sequence of digits (keystrokes) that will contain
> all possible combination of 4 digits as subsequences?
The answer is given by the DeBruijnSequence, named after the Dutch mathematician [Nicolaas Govert (Dick) de Bruijn][6] (9 July 1918 – 17 February 2012).
Entity["Person", "NicolaasGovertDeBruijn::3s54p"][{"Image", "BirthDate", "DeathDate"}]
![enter image description here][7]
As my explanation of the problem is not good, I recommend [this video][8] where someone explains the whole thing much better than me.
A simpler problem
----------
Let's make the whole problem a bit simpler. Suppose I only have two digits 1 and 2 and I want to find all possible combinations of 2.
Tuples[{1, 2}, 2]
(*{{1, 1}, {1, 2}, {2, 1}, {2, 2}}*)
So there are 4 tuples of length 2, which require me to type in 8 keystrokes. Let's see if we can do better if the lock remembers only the last for digits entered. The sequence
1, 1, 2, 2,1
solves this problem. If I partition it and always shift by one I get:
Partition[{1, 1, 2, 2, 1}, 2, 1]
(*{{1, 1}, {1, 2}, {2, 2}, {2, 1}}*)
All combinations of subsequences. It turns out that the sequence 1,1,2,2,1 is a DeBruijnSequence:
DeBruijnSequence[{1, 2}, 2]
(*{1, 1, 2, 2}*)
Note that I have to read the sequence cyclically, i.e. when I reach the end I have to keep typing (length of required sequences)-1 digits from the beginning. In this case the length the subsequences is 2 so I need to add the first digit to the end:
1,1,2,2,1
How can we find such a sequence? Well, one way is to write down all the tuples of two digits:
Tuples[{1, 2}, 2]
(*{{1, 1}, {1, 2}, {2, 1}, {2, 2}}*)
We then look for "overlapping sequences". So for example takes the first element of the tuple list {1,1}, delete its first entry {1} and then take all list that you can construct by adding one digit to the end: {1,1} and {1,2}. This gives two links in a graph {1,1}->{1,1} and {1,1}->{1,2}. We then proceed like that for all other tuples, i.e. we link them to those tuples that can be generated by deleting the first entry and adding any of the available digits:
DeleteCases[Flatten[Outer[If[Drop[#1, 1] == Drop[#2, -1], #1 -> #2] &, tuples, tuples, 1], 1], Null]
(*{{1, 1} -> {1, 1}, {1, 1} -> {1, 2}, {1, 2} -> {2, 1}, {1, 2} -> {2, 2}, {2, 1} -> {1, 1}, {2, 1} -> {1, 2}, {2, 2} -> {2, 1}, {2, 2} -> {2, 2}}*)
The respective graph looks like this:
g = Graph[DeleteCases[Flatten[Outer[If[Drop[#1, 1] == Drop[#2, -1], #1 -> #2] &, tuples, tuples, 1], 1], Null], PlotTheme -> "Scientific"]
![enter image description here][9]
Next we need to find a HamiltonianPath, i.e. a path that visits every note exactly once:
hamiltonpath = FindHamiltonianPath[g]
(*{{1, 1}, {1, 2}, {2, 2}, {2, 1}}*)
The rule to construct the DeBruijnSequence is then easy. We use the first entry of the path, i.e. {1,1} and then add one by one the second elements of all tuples in the list:
sequence = Join[hamiltonpath[[1]], hamiltonpath[[2 ;;, 2]]]
(*{1, 1, 2, 2, 1}*)
Note that the DeBruijnSequence that Mathematica gives is one shorter, i.e. cyclic, ours just reconstructed sequence is not!
The Wolfram Language also has a function that directly constructs the Graph:
DeBruijnGraph[2, 2, PlotTheme -> "Scientific"]
![enter image description here][10]
This graph looks different from the one we constructed above, but this is just its layout. In fact the graphs are isomorphic:
IsomorphicGraphQ[DeBruijnGraph[2, 2], g]
evaluates to "True".
A slightly more complicated example
----------
Ok. Let's do one more example. We are looking for sequences of length 2 on an alphabet of three digits, 1,2, and 3.
tuples = Tuples[{1, 2, 3}, 2];
g = Graph[DeleteCases[Flatten[Outer[If[Drop[#1, 1] == Drop[#2, -1], #2 -> #1] &, tuples, tuples, 1], 1], Null], PlotTheme -> "Scientific"]
![enter image description here][11]
which turns out to be isomorphic to
DeBruijnGraph[3, 2, PlotTheme -> "Scientific"]
![enter image description here][12]
so that
IsomorphicGraphQ[DeBruijnGraph[3, 2], g]
gives "True".
Solution to our problem
----------
We are not ready to solve our key lock problem. We are looking for the DeBruijnSequence for string length 4 and on the 10 digits 0,1,2,...,9.
DeBruijnSequence[10, 4]
![enter image description here][13]
The sequence is
DeBruijnSequence[10, 4] // Length
10000 long, but it's cyclic so we have to add the first three digits to the end to have all combinations. This means that 10003 keystrokes are enough, which has just saved us nearly 30000 keystrokes!!!! This is fantastic if you want to bust a safe.
For those interested: [here is the explanation by a professional][14].
Note, that this is quite useful for [DNA sequencing][15], too.
Extending the DeBruijnSequence to more dimensions
----------
Of course, a mathematician always asks whether we can generalise this. Let's try to generate a two dimensional DeBruijn sequence, i.e. a torus instead of a cycle like before (remember that the sequence that the Wolfram Langauge generates has to be considered to be cyclic!). Again you can find the main idea on [this website][16].
It turns out that there is, of course, maths for this: [Toroidal tilings from de Bruijn-Good cyclic sequences][17]. The algorithm is a bit technical, but at the end we obtain:
deBruijn2D[symbols_, l_, w_] :=
Module[{column1, shifts, solution},
column1 = DeBruijnSequence[symbols , l];
shifts = DeBruijnSequence[symbols^l, w - 1];
solution = Transpose[FoldList[RotateLeft, column1, shifts][[;; -2]]];
If[EvenQ[symbols] && w == 2, Join[#, {#[[1]]}] &@Transpose[Join[Transpose[solution], {RotateLeft[Transpose[solution][[1]], 1/2 symbols^l]}]],
Join[#, {#[[1]]}] &@Transpose[Join[Transpose[solution], {Transpose[solution][[1]]}]]]]
The input slots are:
- symbols : number of different symbols (will be represented as digits starting at zero.
- length: length of the sequences; similar to the one dimensional case ("of length 4").
- width: similar to length but for the second direction; refer to paper.
In fact if length_ is m, width_ is n and we have an alphabet of c numbers, then we obtain an array of size: $c^m \times c^{m(n-1)}$. So here is the DeBruijn tiling in two dimensions, on two digits where the length and width are both 2.
deBruijn2D[2, 2, 2] // MatrixForm
![enter image description here][18]
Here is a more colourful representation:
ArrayPlot[deBruijn2D[2, 2, 2] /. {0 -> Red, 1 -> Green}]
![enter image description here][19]
This is actually quite useful. Every 2 by 2 square is unique in the plane and all combinations occur. This means that if I know the colours of the tiles in one 2 by 2 square I know where I am on the plane!!!!
More symbols/larger systems
----------
Let's look at a system with 4 symbols and 2 by 2 square tiles.
solution=deBruijn2D[4, 2, 2]
Here is a nice representation of that (in which I have "added" a column/row to take care of the cyclicity):
Grid[Partition[Grid /@ Flatten[Partition[solution /. {0 -> White, 1 -> Green, 2 -> Blue, 3 -> Red}, {2, 2}, 1], 1], 16], Frame -> All]
![enter image description here][20]
Modulo bugs in my code, each of these 2-by-2 squares should be "unique". There should be $4^4=256$ different 2-by-2 tiles:
Length[Flatten[Partition[solution2, {2, 2}, 1], 1] // DeleteDuplicates]
gives 256, which is a good sign. Here is another representation without the black grid (which is also non-cyclic):
ImageAssemble[(Graphics[{#, Rectangle[]}] & /@ #) & /@ (solution/. {0 -> White, 1 -> Green, 2 -> Blue, 3 -> Red})]
![enter image description here][21]
Of course, everything actually lives on a torus:
imgtiles = ImageAssemble[(Graphics[{#, Rectangle[]}] & /@ #) & /@ (solution[[;; -2]][[All, ;; -2]] /. {0 -> White, 1 -> Green, 2 -> Blue, 3 -> Red})];
img = ImageResize[imgtiles, 775];
imgmatrix = Join[ImageData[img], ImageData[img]];
frames = Table[
ParametricPlot3D[{Cos[u] (3 + Cos[v]), Sin[u] (3 + Cos[v]), Sin[v]}, {u, 0, 2 \[Pi]}, {v, 0, 2 \[Pi]},
TextureCoordinateFunction -> ({ #4, #5} &), PlotStyle -> Directive[Specularity[White, 50], Texture[Image[imgmatrix[[g ;; g + 774, All, All]]]]],
Axes -> False, Lighting -> "Neutral", Mesh -> None, Boxed -> False, ImageSize -> 900], {g, 1, 775, 7}];
Do[Export["~/Desktop/DeBruijnTorus/frame" <> ToString[1000 + i] <> ".jpg", frames[[i]]], {i, 1, Length[frames]}]
![enter image description here][22]
Automatic graphics
----------
We can create another function for the visualisation:
deBruijnPlot[matrix_] := Module[{}, (MatrixPlot[# /. (Rule @@@ Transpose[{#, RandomColor[Length[#]]}] &@
DeleteDuplicates[Sort[Flatten[#]]])]) &@matrix ]
So we get:
deBruijnPlot[deBruijn2D[4, 2, 2]]
![enter image description here][23]
Conclusion
----------
DeBruijnSequences are very intriguing mathematical objects with many applications. Here is for example a [card trick based on the DeBruijnSequence][24]. They can help to sequence DNA and to know where you are on a plane if all you have is very local information.
The functions that I introduced in this post are not optimised at all. They are relatively slow, and you will have to respect certain rules for length and width. Also the size of the matrices increases very fast as the number of symbols, length and width increase. Some slightly larger systems than the ones shown in the post can be computed, however, and their patterns are intriguing:
deBruijnPlot[deBruijn2D[8, 3, 2]]
![enter image description here][25]
They are obviously a consequence of the algorithm that I have used.
It is also quite possible to extend the entire procedure to more than 2 dimensions, but that is for another day....
Cheers,
Marco
[1]: https://reference.wolfram.com/language/ref/FindTextualAnswer.html
[2]: http://reference.wolfram.com/language/ref/FindEquationalProof.html
[3]: https://reference.wolfram.com/language/ref/DeBruijnSequence.html
[4]: https://reference.wolfram.com/language/ref/DeBruijnGraph.html
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2018-03-1222.12.22.png&userId=48754
[6]: https://en.wikipedia.org/wiki/Nicolaas_Govert_de_Bruijn
[7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2018-03-1222.24.21.png&userId=48754
[8]: https://www.youtube.com/watch?v=85-PsYvWprA
[9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2018-03-1222.40.55.png&userId=48754
[10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2018-03-1222.45.52.png&userId=48754
[11]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2018-03-1222.48.29.png&userId=48754
[12]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2018-03-1222.49.06.png&userId=48754
[13]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2018-03-1222.58.32.png&userId=48754
[14]: https://www.youtube.com/watch?v=iPLQgXUiU14&vl=en-GB
[15]: http://www.datagenetics.com/blog/october22013/index.html
[16]: http://www.datagenetics.com/blog/october22013/index.html
[17]: https://www.sciencedirect.com/science/article/pii/0012365X88900957
[18]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2018-03-1223.14.28.png&userId=48754
[19]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2018-03-1223.16.32.png&userId=48754
[20]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2018-03-1223.21.52.png&userId=48754
[21]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2018-03-1223.25.54.png&userId=48754
[22]: http://community.wolfram.com//c/portal/getImageAttachment?filename=4943animated.gif&userId=48754
[23]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2018-03-1223.28.12.png&userId=48754
[24]: https://www.youtube.com/watch?v=EWG6e-yBL94
[25]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2018-03-1300.05.27.png&userId=48754Marco Thiel2018-03-13T00:07:14Z[✓] Compare these to matrix operations?
http://community.wolfram.com/groups/-/m/t/1301384
Consider the following code:
Inverse[{{1,-1},{0,1}}]*{{3,1},{0,2}}^2*{{1,-1},{0,1}}
{{1,1},{0,1}}*{{3,1},{0,2}}^2*{{1,-1},{0,1}}
hello i'm a little bit curious, why the two sentences above give me two different answers .. ? ( notice: Inverse[{{1,-1},{0,1}}] = {{1,1},{0,1}} )
ThanksYujia Huang2018-03-13T08:32:02ZAvoid "Get::noopen : Cannot open CloudObjectLoader`. " message?
http://community.wolfram.com/groups/-/m/t/1301932
Hi,
I was working with a notebook using Mathematica 11.0.1 earlier in the day. Then later on I moved the notebook to my other machine with Mathematica 11.2 and as I executed the first `Parallelize` command I received this:
Get::noopen : Cannot open CloudObjectLoader`.
The `Parallelize` command was this:
In[25]:= Clear[x, y, z];
impoints = Parallelize[Table[
Flatten[Table[{x, y, zz[[i, 2]]}, {x,
mHi3ret[[3, i, 1, 1, 1]], mHi3ret[[3, i, 1, 2, 1]] ,
dd*cosalpha[[i]]}, {y, -0.0075, 0.0075, dd}], 1], {i, 1,
Length[mHi3ret[[3]] ]}] ]; // AbsoluteTiming
(kernel 1) Get::noopen : "Cannot open "CloudObjectLoader`"."
(kernel 2) Get::noopen : "Cannot open "CloudObjectLoader`"."
(kernel 3) Get::noopen : "Cannot open "CloudObjectLoader`"."
(kernel 4) Get::noopen : "Cannot open "CloudObjectLoader`"."
Out[26]= {253.181, Null}
Should I worry?
On my lesser machine with Mathematica 11.0.1 it took 227 seconds to execute it, on my big machine with Mathematica 11.2 it took 253 seconds.
Should I worry more?
Thanks ahead,
JánosJanos Lobb2018-03-14T03:23:16ZAvoid memory usage to be inexplicably high?
http://community.wolfram.com/groups/-/m/t/1302135
Hello.
I have written a code in Mathematica which creates as a result an array with 19280 arrays, each with 4 elements. The first three being numbers and the fourth being another array with 914 elements. It works, and the final array is stored in a .dat file 206.8 MB in size. The program says the maximum memory used should be approximately 3.2GB (using the command MaxMemoryUsed[]). However, when running the program, the used memory in the system goes up approximately 15GB.
Also, after the program has finished and the notebook is closed, this memory usage remains. It is only after quitting the Kernel manually that the memory usage goes back to normal.
The $HistoryLength is set to zero. The file is created by reading and writing it in the following Do loop:
Do[
datos = Evalvecmin[\[Mu]120, \[Mu]23i, \[Mu]23f, \[Mu]23step];
tmp = << "datos_Na2M25par_sepfino5.dat";
eminvecminq = Union[tmp, datos];
eminvecminq >> "datos_Na2M25par_sepfino5.dat" , {\[Mu]120, \[Mu]12i, \[Mu]12f, \[Mu]12step}]
And it’s in this step that the memory usage starts increasing way more than it should.
Why is the memory usage going up so much? Thank you, Juan JoséJuan José Basagoiti2018-03-14T02:58:24ZCreate a Dynamic Forms - TemplateSlot as specified in documentation?
http://community.wolfram.com/groups/-/m/t/1301188
Hi,
I am new to Wolfram language. I am trying some examples in tutorial/AdvancedWebFormCreation. The example given under Dynamic Forms section is not working as explained. Here is the code:
CloudDeploy[
FormFunction[{"state" -> "USState",
"county" ->
TemplateSlot["state"][
EntityProperty["AdministrativeDivision", "Subdivisions"]]},
Identity]]
Could anybody please help?
Thanks & Regards,
MuraliMurali Vadavalli2018-03-13T11:40:41ZFor Pi Day: Volume=3.141 -- The Canonical Tetragonal Antiwedge Hexahedron
http://community.wolfram.com/groups/-/m/t/1301599
The weirdest of the seven hexahedra, the tetragonal antiwedge, is a self-dual polyhedron that has a volume of 3.141 in its canonical form. Here it is shown with its dual.
![The antiwedge][1]
Here's code for it.
verts={
{Root[-1+14 #1^2+25 #1^4-8 #1^6+#1^8&,1],1,Root[-1-14 #1^2+25 #1^4+8 #1^6+#1^8&,2]},{Root[-1+14 #1^2+25 #1^4-8 #1^6+#1^8&,2],1,-Root[-1-14 #1^2+25 #1^4+8 #1^6+#1^8&,2]},{-Root[-1+10 #1^2-31 #1^4+80 #1^6+#1^8&,2],-Root[1-8 #1-2 #1^2-8 #1^3+#1^4&,1],-Root[-1+6 #1^2-15 #1^4+8 #1^6+#1^8&,2]},{Root[-1+10 #1^2-31 #1^4+80 #1^6+#1^8&,2],-Root[1-8 #1-2 #1^2-8 #1^3+#1^4&,1],Root[-1+6 #1^2-15 #1^4+8 #1^6+#1^8&,2]},{Root[-1-2 #1^2+5 #1^4-4 #1^6+#1^8&,1],-1,Root[-1+2 #1^2+5 #1^4+4 #1^6+#1^8&,2]}, {Root[-1-2 #1^2+5 #1^4-4 #1^6+#1^8&,2],-1,-Root[-1+2 #1^2+5 #1^4+4 #1^6+#1^8&,2]}};
dualverts = {-1,-1,1}#&/@verts;
faces={{1,2,6,4},{1,5,3,2},{1,4,5},{2,3,6},{3,5,6},{4,6,5}};
Graphics3D[{Opacity[.6],EdgeForm[{Black, Thick}],
Polygon[verts[[#]]]&/@faces,Polygon[dualverts[[#]]]&/@faces,
Table[Style[Text[n,verts[[n]]],20],{n,1,6}],Red,Table[Style[Text[n,dualverts[[n]]],20],{n,1,6}]},
ImageSize-> {600,400}, ViewAngle-> Pi/12,ViewPoint-> {0,0,3},Boxed-> False, SphericalRegion-> True]
Volume[ConvexHullMesh[verts]]
In the canonical form, all faces are planar and all edges are tangent to the unit sphere. Combined with the dual, all edges are perpendicular with an intersection at distance 1 from the origin.
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=antiwedge.jpg&userId=21530Ed Pegg2018-03-13T23:52:57ZSolve a set of N coupled algebraic equations with "Solve"?
http://community.wolfram.com/groups/-/m/t/1301143
Hello everyone. I'm attempting to solve a set of N coupled algebraic equations using "Solve". I've successfully done it for a small value of N (2~3 coupled equations, for example), simply by typing the equations as: Solve[{eq1},{eq2},{eq3},{x1,x2,x3}]; however, it's just impracticable when N is high. That being said, I tried to define an array with all my variables: v = Array[t,n] = {t[1],t[2],...,t[n]} and, with a loop structure, I tried - with no success - to solve 3 equations.
In attachment is what I've done so far.
Thank you for you attention.Daniel Grun2018-03-13T00:51:29ZConway's structures
http://community.wolfram.com/groups/-/m/t/1301097
Recently I noticed here a thread about gliders:
http://community.wolfram.com/groups/-/m/t/1120326
I must say that I have virtually almost no idea about "cellular autmatons" ("automata"?), but it reminded me about a book I have read quite a time ago (1979?).
**Manfred Eigen, Ruthild Winkler: "Das Spiel, Naturgesetze steuern den> Zufall" ( ISBN 3-492-02331-2)**
Manfred Eigen is a Nobel-Prize -Winner of 1967 in Chemistry ( for his work about very fast chemical reactions).
In this book several biochemical models are mentioned, which, as it seems, can well be described by cellular automata.
It is mentioned, that a lot of patterns with remarkable behaviour are described by Martin Gardner in "Mathematical Games" , Scientific American, Oct. 1970 and Feb. 1971 (citations given in the aforementioned book).
As I said I am a newby about cellular automata, and so I decided to write a procedure (in Mma 7) which is able to display a "gun", that is a device which emits periodically a glider, and an "eater" , which destroys the arriving glider. See the notebook attached.
First an oscillator and a glider are constructed and displayed, then the gun and eater, and finally both together.
I haven't looked at the behaviour of the system when the the patterns are shifted, but that could be easily done because I have provided a code which allows for translations.
Have a look at it, any comments are welcome.Hans Dolhaine2018-03-13T00:19:34ZTry to beat these MRB constant records!
http://community.wolfram.com/groups/-/m/t/366628
POSTED BY: Marvin Ray Burns .
I think this important point got buried near the end.
When it comes to mine and a few more educated people's passion to calculate many digits and the dislike possessed by a few more educated people; it is all a matter telling us that the human mind is multi faceted in giving passion, to person a, for one task and to person b for another task!
The MRB constant is defined below. See http://mathworld.wolfram.com/MRBConstant.html
> ![enter image description here][1]
Here are some record computations. If you know of any others let me know..
1. On or about Dec 31, 1998 I computed 1 digit of the (additive inverse of the) MRB constant with my TI-92's, by adding 1-sqrt(2)+3^(1/3)-4^(1/4) as far as I could. That first digit by the way is just 0.
2. On Jan 11, 1999 I computed 3 digits of the MRB constant with the Inverse Symbolic Calculator.
3. In Jan of 1999 I computed 4 correct digits of the MRB constant using Mathcad 3.1 on a 50 MHz 80486 IBM 486 personal computer operating on Windows 95.
4. Shortly afterwards I computed 9 correct digits of the MRB constant using Mathcad 7 professional on the Pentium II mentioned below.
5. On Jan 23, 1999 I computed 500 digits of the MRB constant with the online tool called Sigma.
6. In September of 1999, I computed the first 5,000 digits of the MRB Constant on a 350 MHz Pentium II with 64 Mb of ram using the simple PARI commands \p 5000;sumalt(n=1,((-1)^n*(n^(1/n)-1))), after allocating enough memory.
7. On June 10-11, 2003 over a period, of 10 hours, on a 450mh P3 with an available 512mb RAM: I computed 6,995 accurate digits of the MRB constant.
8. Using a Sony Vaio P4 2.66 GHz laptop computer with 960 MB of available RAM, on 2:04 PM 3/25/2004, I finished computing 8000 digits of the MRB constant.
9. On March 01, 2006 with a 3GH PD with 2GBRAM available, I computed the first 11,000 digits of the MRB Constant.
10. On Nov 24, 2006 I computed 40, 000 digits of the MRB Constant in 33hours and 26min via my own program in written in Mathematica 5.2. The computation was run on a 32-bit Windows 3GH PD desktop computer using 3.25 GB of Ram.
11. Finishing on July 29, 2007 at 11:57 PM EST, I computed 60,000 digits of MRB Constant. Computed in 50.51 hours on a 2.6 GH AMD Athlon with 64 bit Windows XP. Max memory used was 4.0 GB of RAM.
12. Finishing on Aug 3 , 2007 at 12:40 AM EST, I computed 65,000 digits of MRB Constant. Computed in only 50.50 hours on a 2.66GH Core2Duo using 64 bit Windows XP. Max memory used was 5.0 GB of RAM.
13. Finishing on Aug 12, 2007 at 8:00 PM EST, I computed 100,000 digits of MRB Constant. They were computed in 170 hours on a 2.66GH Core2Duo using 64 bit Windows XP. Max memory used was 11.3 GB of RAM. Median (typical) daily record of memory used was 8.5 GB of RAM.
14. Finishing on Sep 23, 2007 at 11:00 AM EST, I computed 150,000 digits of MRB Constant. They were computed in 330 hours on a 2.66GH Core2Duo using 64 bit Windows XP. Max memory used was 22 GB of RAM. Median (typical) daily record of memory used was 17 GB of RAM.
15. Finishing on March 16, 2008 at 3:00 PM EST, I computed 200,000 digits of MRB Constant using Mathematica 5.2. They were computed in 845 hours on a 2.66GH Core2Duo using 64 bit Windows XP. Max memory used was 47 GB of RAM. Median (typical) daily record of memory used was 28 GB of RAM.
16. Washed away by Hurricane Ike -- on September 13, 2008 sometime between 2:00PM - 8:00PM EST an almost complete computation of 300,000 digits of the MRB Constant was destroyed. Computed for a long 4015. Hours (23.899 weeks or 1.4454*10^7 seconds) on a 2.66GH Core2Duo using 64 bit Windows XP. Max memory used was 91 GB of RAM. The Mathematica 6.0 code used follows:
Block[{$MaxExtraPrecision = 300000 + 8, a, b = -1, c = -1 - d,
d = (3 + Sqrt[8])^n, n = 131 Ceiling[300000/100], s = 0}, a[0] = 1;
d = (d + 1/d)/2; For[m = 1, m < n, a[m] = (1 + m)^(1/(1 + m)); m++];
For[k = 0, k < n, c = b - c;
b = b (k + n) (k - n)/((k + 1/2) (k + 1)); s = s + c*a[k]; k++];
N[1/2 - s/d, 300000]]
17. On September 18, 2008 a computation of 225,000 digits of MRB Constant was started with a 2.66GH Core2Duo using 64 bit Windows XP. It was completed in 1072 hours. Memory usage is recorded in the attachment pt 225000.xls, near the bottom of this post. .
18. 250,000 digits was attempted but failed to be completed to a serious internal error which restarted the machine. The error occurred sometime on December 24, 2008 between 9:00 AM and 9:00 PM. The computation began on November 16, 2008 at 10:03 PM EST. Like the 300,000 digit computation this one was almost complete when it failed. The Max memory used was 60.5 GB.
19. On Jan 29, 2009, 1:26:19 pm (UTC-0500) EST, I finished computing 250,000 digits of the MRB constant. with a multiple step Mathematica command running on a dedicated 64bit XP using 4Gb DDR2 Ram on board and 36 GB virtual. The computation took only 333.102 hours. The digits are at http://marvinrayburns.com/250KMRB.txt . The computation is completely documented in the attached 250000.pd at bottom of this post.
20. On Sun 28 Mar 2010 21:44:50 (UTC-0500) EST, I started a computation of 300000 digits of the MRB constant using an i7 with 8.0 GB of DDR3 Ram on board.; But it failed due to hardware problems.
21. I computed 299,998 Digits of the MRB constant. The computation began Fri 13 Aug 2010 10:16:20 pm EDT and ended 2.23199*10^6 seconds later |
Wednesday, September 8, 2010. I used Mathematica 6.0 for Microsoft
Windows (64-bit) (June 19, 2007) That is an average of 7.44 seconds per digit.. I used my Dell Studio XPS 8100 i7 860 @ 2.80 GH 2.80 GH
with 8GB physical DDR3 RAM. Windows 7 reserved an additional 48.929
GB virtual Ram.
22. I computed exactly 300,000 digits to the right of the decimal point
of the MRB constant from Sat 8 Oct 2011 23:50:40 to Sat 5 Nov 2011
19:53:42 (2.405*10^6 seconds later). This run was 0.5766 seconds per digit slower than the
299,998 digit computation even though it used 16GB physical DDR3 RAM on the same machine. The working precision and accuracy goal
combination were maximized for exactly 300,000 digits, and the result was automatically saved as a file instead of just being displayed on the front end. Windows reserved a total of 63 GB of working memory of which at 52 GB were recorded being used. The 300,000 digits came from the Mathematica 7.0 command
Quit; DateString[]
digits = 300000; str = OpenWrite[]; SetOptions[str,
PageWidth -> 1000]; time = SessionTime[]; Write[str,
NSum[(-1)^n*(n^(1/n) - 1), {n, \[Infinity]},
WorkingPrecision -> digits + 3, AccuracyGoal -> digits,
Method -> "AlternatingSigns"]]; timeused =
SessionTime[] - time; here = Close[str]
DateString[]
23. 314159 digits of the constant took 3 tries do to hardware failure. Finishing on September 18, 2012 I computed 314159 digits, taking 59 GB of RAM. The digits are came from the Mathematica 8.0.4 code
DateString[]
NSum[(-1)^n*(n^(1/n) - 1), {n, \[Infinity]},
WorkingPrecision -> 314169, Method -> "AlternatingSigns"] // Timing
DateString[]
Where I have 10 digits to round off. (The command NSum[(-1)^n*(n^(1/n) - 1), {n, \[Infinity]},
WorkingPrecision -> big number, Method -> "AlternatingSigns"] tends to give about 3 digits of error to the right.)
**The following records are due to the work of Richard Crandall found [here][2]. **
24. Sam Noble of Apple computed 1,000,000 digits of the MRB constant in 18 days 9 hours 11 minutes 34.253417 seconds
25. Finishing on Dec 11, 2012 Ricard Crandall, an Apple scientist, computed 1,048,576 digits
in a lighting fast 76.4 hours. That's on a 2.93 Ghz 8-core Nehalem
26. I computed a little over 1,200,000 digits of the MRB constant in 11
days, 21 hours, 17 minutes, and 41 seconds,( finishing on on March 31 2013). I used a six core Intel(R) Core(TM) i7-3930K CPU @ 3.20 GHz 3.20 GHz.
27. On May 17, 2013 I finished a 2,000,000 or more digit computation of the MRB constant, using only around 10GB of RAM. It took 37 days 5 hours 6 minutes 47.1870579 seconds. I used a six core Intel(R) Core(TM) i7-3930K CPU @ 3.20 GHz 3.20 GHz.
28. Finally, I would like to announce a new unofficial world record computation of the MRB constant that was finished on Sun 21 Sep 2014 18:35:06. It took 1 month 27 days 2 hours 45 minutes 15 seconds. I computed 3,014,991 digits of the MRB constant with Mathematica 10.0. I Used my new version of Richard Crandall's code, below, optimized for my platform and large computations. I also used a six core Intel(R) Core(TM) i7-3930K CPU @ 3.20 GHz 3.20 GHz with 64 GB of RAM of which only 16 GB was used. Can you beat it (in more number of digits, less memory used, or less time taken)? This confirms that my previous "2,000,000 or more digit computation" was actually accurate to 2,009,993 digits. (They were used as MRBtest2M.)
(**Fastest (at MRB's end) as of 25 Jul 2014*.*)
DateString[]
prec = 3000000;
(**Number of required decimals.*.*)ClearSystemCache[];
T0 = SessionTime[];
expM[pre_] :=
Module[{a, d, s, k, bb, c, n, end, iprec, xvals, x, pc, cores = 12,
tsize = 2^7, chunksize, start = 1, ll, ctab,
pr = Floor[1.005 pre]}, chunksize = cores*tsize;
n = Floor[1.32 pr];
end = Ceiling[n/chunksize];
Print["Iterations required: ", n];
Print["end ", end];
Print[end*chunksize]; d = ChebyshevT[n, 3];
{b, c, s} = {SetPrecision[-1, 1.1*n], -d, 0};
iprec = Ceiling[pr/27];
Do[xvals = Flatten[ParallelTable[Table[ll = start + j*tsize + l;
x = N[E^(Log[ll]/(ll)), iprec];
pc = iprec;
While[pc < pr, pc = Min[3 pc, pr];
x = SetPrecision[x, pc];
y = x^ll - ll;
x = x (1 - 2 y/((ll + 1) y + 2 ll ll));];(**N[Exp[Log[ll]/ll], pr]**)x, {l, 0, tsize - 1}], {j, 0, cores - 1},
Method -> "EvaluationsPerKernel" -> 4]];
ctab = ParallelTable[Table[c = b - c;
ll = start + l - 2;
b *= 2 (ll + n) (ll - n)/((ll + 1) (2 ll + 1));
c, {l, chunksize}], Method -> "EvaluationsPerKernel" -> 2];
s += ctab.(xvals - 1);
start += chunksize;
Print["done iter ", k*chunksize, " ", SessionTime[] - T0];, {k, 0,
end - 1}];
N[-s/d, pr]];
t2 = Timing[MRBtest2 = expM[prec];]; DateString[]
Print[MRBtest2]
MRBtest2 - MRBtest2M
t2 From the computation was {1.961004112059*10^6, Null}.
Here are a couple of graphs of my record computations in max digits/ year:
![enter image description here][3]![enter image description here][4]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=68115.JPG&userId=366611
[2]: http://www.marvinrayburns.com/UniversalTOC25.pdf
[3]: /c/portal/getImageAttachment?filename=7559mrbrecord1.JPG&userId=366611
[4]: /c/portal/getImageAttachment?filename=mrbrecord3.JPG&userId=366611Marvin Ray Burns2014-10-09T18:08:49ZUsing Basic JSON REST Services in Mathematica
http://community.wolfram.com/groups/-/m/t/1262929
I recently had a job interview where I was given the following problem and I decided to tackle it with Mathematica vs. Groovy; it seemed very simple to accomplish using Mathematica: *(Hopefully they take kindly to it)*
- There’s a “fake” REST service available for testing at:
http://jsonplaceholder.typicode.com/
- Write some code in the Groovy programming language that uses the
“posts” API published at http://jsonplaceholder.typicode.com/posts,
which reports back some fake blog posts including a userid, post id,
title, and body.
- Retrieve the records from the API and generate a report that lists only the users who wrote posts where the post title starts with the
letter “s” along with the number of such posts for each of those
users.
- Use the user's name in the report, not the numerical user ID.
- Return to us the report that's generated, along with the (working)
code that generated it.
First, let's import our posts from the website as RawJSON format and generate a Dataset from it which is much more convenient to work with:
posts = Import["http://jsonplaceholder.typicode.com/posts", "RawJSON"];
postsDataSet = Dataset[posts]
![enter image description here][1]
Next, let us filter out all of the posts whose bodies of text start with the string character "s":
filterPostsDataSet = postsDataSet[Select[StringTake[#title, 1] == "s" &]]
![enter image description here][2]
We are left with 9 entries and all we need to do is keep the userId values associated with these:
userIDs = filterPostsDataSet[All, "userId"]
![enter image description here][3]
Now we need to retrieve the user's information attached to these Id values; although not specifically stated I assumed these could be found at http://jsonplaceholder.typicode.com/users. Thus, we simply import these values and, like before, wrap them in a Dataset.
users = Import["http://jsonplaceholder.typicode.com/users", "RawJSON"];
usersDataSet = Dataset[users]
![enter image description here][4]
Although I feel there is a more elegant way - I am going to make a list of just the users names from this Dataset to work with using the following:
userResults =
Table[usersDataSet[Select[#id == userIDs[[i]] &]][[1]]["name"], {i, 1, Length[userIDs]}]
Additionally, I want to keep a list of the *unique* user names since some might be duplicated in the previous list:
uniqueUsers = DeleteDuplicates[userResults]
Finally, I will create a final list which is essentially my required report, which will be a list of pairs. Each pair will contain the unique user name as well as the count of how many times that unique user name appeared in the original list. I put this in TableForm just for aesthetic value. This can then be exported to the desired format later on if necessary.
uniqueUserPosts = Table[{uniqueUsers[[i]], Count[userResults, uniqueUsers[[i]]]}, {i, 1, Length[uniqueUsers]}] // TableForm
![enter image description here][5]
In conclusion, I think that in the future using Mathematica in working with REST API's could and should be allowed if not encouraged as a proper scripting languages in many commercial and industrial settings. So - what do you guys think?? Is this better or worse than what could be done in Groovy or other scripting languages? Also, I feel that I could condense and optimize my code in areas and would love to hear feedback on that.
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Result1.png&userId=856782
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=7292Result2.png&userId=856782
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=1220Result3.png&userId=856782
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Result4.png&userId=856782
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=5573Result5.png&userId=856782William Duhe2018-01-10T05:24:46ZEvaluate a global expression within functions?
http://community.wolfram.com/groups/-/m/t/1301225
*Some hours after my original post, I edit that post: I'm sorry, but my code is nonsense. Of course I am interested in the value of exp WITHIN my functions and not after the functions being called. I will come back with a corrected version*.
----------
I have some global symbolic expression exp=a*x and want to substitute a within a function f[a_] by the parameter a. See the code below.
The first three cases #1,#2,#3 are on the global level and work as expected. The following cases are within functions and I do not understand why they don't work as I expect. I'm afraid I have some basic misunderstandings with things like Evaluate, Hold, etc. and even Module.
#4 is a simple function without Module. It does not substitute the parameter a within exp. **Why**?
But this can be cured through Evaluate as in #5.
The cases #6, #7, #7S use functions defined as modules and do never work. Not without and not with Evaluate. **Why**?
Case #7S is different from all others since it uses a symbolic parameter a=myA instead of a number. This does not work either.
Maybe I should try things like Replace, Eliminate, PolynomialReduce?
If[True,
ClearAll["Global`*"];
exp = a*x; Print["#1: Global exp: ", exp, "\n\tok"];
a = 3; Print["#2: a=3 substituted: ", exp, "\n\tok"];
a =.; Print["#3: a reset: ", exp, "\n\tok"];
f4[a_] := exp;
Print["#4: a=3 substituted within a function: " f4[3],
"\n\tNOK! Should give 3*x"];
f5[a_] := Evaluate[exp];
Print["#5: a=3 substituted within a function with Evaluate: ", f5[3],
"\n\tok"];
f6[a_] := Module[{}, exp];
Print["#6: a=3 substituted within a function-Module: ", f6[3],
"\n\tNOK! Should give 3*x"];
f7[a_] := Module[{}, Evaluate[exp]];
Print["#7: a=3 substituted within a function-Module with Evaluate: ",
f7[3], "\n\tNOK! Should give 3*x"];
Print["#7S: a=myA substituted within a function-Module with \
Evaluate: ", f7[myA], "\n\tNOK! Should give myA*x"];
]
#1: Global exp: a x
ok
#2: a=3 substituted: 3 x
ok
#3: a reset: a x
ok
#4: a=3 substituted within a function: a x
NOK! Should give 3*x
#5: a=3 substituted within a function with Evaluate: 3 x
ok
#6: a=3 substituted within a function-Module: a x
NOK! Should give 3*x
#7: a=3 substituted within a function-Module with Evaluate: a x
NOK! Should give 3*x
#7S: a=myA substituted within a function-Module with Evaluate: a x
NOK! Should give myA*xWerner Geiger2018-03-12T20:43:08ZCalculate a double integrate over an implicit region using W|A?
http://community.wolfram.com/groups/-/m/t/1301619
Hello! How do I double integrate over an implicit region, like an elipsis, using the wolframAlpha?Thiago Benine2018-03-13T11:56:29Z