Community RSS Feed
http://community.wolfram.com
RSS Feed for Wolfram Community showing any discussions in tag Wolfram Scienceshowthread.php?threadid=78 sorted by activeUse Solve with a condition of a limit x is much less than D?
http://community.wolfram.com/groups/-/m/t/1106375
Greetings,
I am working on a very complicated equation that needs to be solved. To simplify the function I use a limit in which x is much less than D or ( x<<D). I cannot find much less/greater condition in Mathematica. I need to solve that equation symbolically and I know that I should get four solutions. By taking a limit manually I got something like A*x^4-B*x^2+C=0. Then using solve I was able to get four solution, but with coefficients that were very long. (In manual calculations, I was able to get shorter coefficients)
How do I solve equation with much less condition?
Just for the sake of example let say I want to solve
f(x)= sqrt( D^2 - ( x - z )^2 ) + x * cos(a) + x + z
after limit
f(x)= sqrt( D^2 - ( z )^2 ) + x * cos(a) + x + z
Is there a command in Mathematica to selectively simplify/factor/expand some terms instead all terms in equations?Adam Szewczyk2017-05-25T01:56:46ZCalculus - time factor problem - 29th May 2017
http://community.wolfram.com/groups/-/m/t/1109875
Hi All,
I would be grateful for some advice / help on how to solve this Calculus - time factor problem.
**My Goal here** - I am trying to find the TIME factor within the 1st derivative that will yield the same results as the original data shown below.
I was able to find the derivative with D[ f, t]
And tried to extract Coefficients from original function f[t]
And then apply the coefficients to the form - a t^2+b t +c & then use the correct coefficients in this form within the derivative to find each value in the dataset at each time {1,2,3,4,etc}
I am not sure this is even the correct approach.
Please could someone review & advise how I should do this.
Many thanks for your help & attention.
Best regards,
Lea...
Given the the following data set:-
data = {{1, 4.008668526800082`}, {2, 13.840674130266803`}, {3,
29.80944537853352`}, {4, 51.91498227160025`}, {5, 80.15728480946696`}, {6,
114.53635299213369`}, {7, 155.0521868196004`}, {8,
201.70478629186715`}, {9, 254.49415140893387`}, {10,
313.4202821708005`}, {11, 378.48317857746724`}, {12,
449.682840628934`}, {13, 527.0192683252008`}, {14,
610.4924616662674`}, {15, 700.1024206521342`}, {16, 795.849145282801`}};
which yields the following function f(t) & plots line & data points :-
f[time_] := 0.3134285681335234` + 0.6268571362666725` time + 3.` time^2
functionf = 0.3134285681335234` + 0.6268571362666725` time + 3.` time^2;
Show[ListPlot[data, PlotStyle -> Red], ListLinePlot[data]]
derivativeOfF = D[f[time], time]
CoefficientList[functionf /. {x -> a t^2 + b t + c}, t]
I don't know what to do after this point to find the accurate time factor. Many thanks for you help.Lea Rebanks2017-05-29T09:28:32ZI need help to get rid of extra disks? please
http://community.wolfram.com/groups/-/m/t/1110388
Hi
I'm making this presentation, which is showing thee Archimedes hat theorem, and i want to show the disks of same area as the hollow red annulus and i want to show only one disk at a time as i move my manipulate button.
I'm attaching the file, i want to show only one disk from table 'c' at a time but i'm not able to please help me out. Regards
also if you can make the sizes correct, i''d really appreciate that.
RegardsMuhammad Afzal2017-05-30T06:11:32Z[✓] Deploy a Manipulate to the cloud?
http://community.wolfram.com/groups/-/m/t/1099605
I have tried to deploy a Manipulate to the cloud.
In a Manipulate it is common, and useful, to give sliders the option Appearance->"Labeled". To indicate the current value as set by the slider.
But in the cloud representation the sliders current value is just given as an empty field. Example below.
**Desktop:**
![enter image description here][1]
**Cloud:**
![enter image description here][2]
Does anyone know a fix?
[The cloud link][3]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=01.InDesktop.png&userId=93385
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=02.InCloud.png&userId=93385
[3]: %5C!%5C%28%20TagBox%5B%20ButtonBox%5B%20PaneSelectorBox%5B%7B%20%20%20%20%20%20False-%3E%22%5C%3C%5C%22https://www.wolframcloud.com/objects/a3433957-bb2a-%5C%204730-8a34-ad15d68a5668%5C%22%5C%3E%22,%20True-%3E%20StyleBox%5B%22%5C%3C%5C%22https://www.wolframcloud.com/objects/a3433957-bb2a-4730-%5C%208a34-ad15d68a5668%5C%22%5C%3E%22,%20%22HyperlinkActive%22%5D%7D,%20Dynamic%5B%20CurrentValue%5B%22MouseOver%22%5D%5D,%20BaseStyle-%3E%7B%22Hyperlink%22%7D,%20FrameMargins-%3E0,%20ImageSize-%3EAutomatic%5D,%20BaseStyle-%3E%22Hyperlink%22,%20ButtonData-%3E%7B%20URL%5B%22https://www.wolframcloud.com/objects/a3433957-bb2a-4730-8a34-%5C%20ad15d68a5668%22%5D,%20None%7D,%20ButtonNote-%3E%22https://www.wolframcloud.com/objects/a3433957-bb2a-4730-%5C%208a34-ad15d68a5668%22%5D,%20Annotation%5B#,%20%20%20%20%20%20%22https://www.wolframcloud.com/objects/a3433957-bb2a-4730-8a34-%5C%20ad15d68a5668%22,%20%22Hyperlink%22%5D&%20%5D%5C%29
EDIT: When I click the link above nothing seems to happen. But the link works (most of the time) when clicked from outside the community. (the Manipulate was deployed with Permissions->"Public"). Heres the link in "cleartext":
https://www.wolframcloud.com/objects/a3433957-bb2a-4730-8a34-ad15d68a5668Hans Milton2017-05-20T19:50:57ZPlotting probability distribution
http://community.wolfram.com/groups/-/m/t/1109198
Hi All. I have an issue with plotting. The following data shows the probability distribution of a random variable X (here 25/81, 30/81 etc are the probabilities):
data={{1,25⁄81},{2,30⁄81},{4,19⁄81},{8,6⁄81},{16,1⁄81}}
I would like to plot a bar-chart like in the image below. However, using for example, Histogram[WeightedData @@ Transpose[data], Length[data]] command I get a plot which is different. I would like the one where the bars are spaced like in the image below. I appreciate your help. ![enter image description here][1]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Untitled.jpg&userId=1078977Alex Token2017-05-27T11:18:41Z[✓] Separate out the real and imaginary part and export data?
http://community.wolfram.com/groups/-/m/t/1091350
I have an Mathematica code which goes like this:
ClearAll["Global`*"]
first = 1 + 17000000/k^2 + 5000000/k^2 + 868670/k^2;
second = 14000/w^2 + (5000000 w^2)/(k^2*(w^2 - 1));
third = 600/(w - 0.01)^2 + (400000 (w - 0.01)^2)/(k^2*0.125 ((w - 0.01)^2 - 0.25));
(*First way*)
hello = Table[{k, NSolve[first - second - third == 0, w]}, {k, 0.01,1, 0.01}]
(*Second way*)
eqn = NSolve[first - second - third == 0, w];
hello = Table[{k, eqn}, {k, 0.01, 1, 0.01}]
(*Third way*)
rt := (r = Solve[ first - second - third == 0, w];
s = Evaluate[w /. r];
Return[s])
Table[{k, rt}, {k, 0.01, 1, 0.01}]
I have some question in this regard:
1. From an analytical point of view you can see that for a single value of k, 8 different omegas are posibble. For k=0.01, first way, second way and third way are giving 8 omegas. But at some places, for e.g 0.7, first way gives you 4 roots, on the other hand second way and third way gives 8 roots. I have to tell you that 4 roots which are given by first way are still included in second and third way. Why/ What is this happening?
2. I want to export this to a dat file, with first colum with k, next column with real value of first w, next with imaginary of first w, next with real of second omega, etc... How can I do that? Simple export is not helping me.
By the by, I am using Mathematica 9.
Thanks in advanceSreeraj T2017-05-12T00:26:35ZMathematica 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:58ZImprovement on the magic number 0x5f3759df
http://community.wolfram.com/groups/-/m/t/1108896
One of the well-known algorithm of doing the inverse square root:
$$\frac{1}{\sqrt{x}}$$
is the so-called "fast inverse square root" algorithm, see [wikipedia][1]. This code gives a very good approximation of this function, possibly good enough for lighting in video-games. Even now, with modern CPUs, with many new instructions, this is still quite a bit faster than the actual inverse square root. The most surprising thing about this code is the appearance of a magic constant (note that this is C code, including the original comments)
float Q_rsqrt( float number )
{
long i;
float x2, y;
const float threehalfs = 1.5F;
x2 = number * 0.5F;
y = number;
i = * ( long * ) &y; // evil floating point bit level hacking
i = 0x5f3759df - ( i >> 1 ); // what the f*ck?
y = * ( float * ) &i;
y = y * ( threehalfs - ( x2 * y * y ) ); // 1st iteration
return y;
}
As you can see, the input is a float (a 32 bit floating point number), which is cast in to a long integer, the bits are shifted, and the result subtracted from a magic constant, this number is then re-interpreted again as a float.
To understand why this works is actually quite a long story, but realise that floats are stored as 32 bits as follows:
SEEEEEEEEMMMMMMMMMMMMMMMMMMMMMMM
where S= sign, E = exponent, and M = Mantissa. So once you interpret this as a long, and start shifted bits, you can get very unpredictable behavior. The question that I'm after is: can this constant be improved?
Let's create a library function in c and link it back in to Mathematica, such that we can try different magic constants and different values x:
Needs["CCompilerDriver`"]
src="
#include \"WolframLibrary.h\"
DLLEXPORT mint WolframLibrary_getVersion(){
return WolframLibraryVersion;
}
DLLEXPORT int WolframLibrary_initialize( WolframLibraryData libData) {return 0;}
DLLEXPORT void WolframLibrary_uninitialize( WolframLibraryData libData) {return;}
DLLEXPORT int constantzero(WolframLibraryData libData, mint Argc, MArgument *Args, MArgument Res){
MArgument_setInteger(Res, 0);
return LIBRARY_NO_ERROR;
}
DLLEXPORT int fastinvsqrt(WolframLibraryData libData, mint Argc, MArgument *Args, MArgument Res) {
double in = MArgument_getReal(Args[0]);
int magic = MArgument_getInteger(Args[1]);
float x = in;
float halfx = 0.5f * x;
int i = *(int*)&x;
i = magic - (i >> 1);
x = *(float*)&i;
x = x*(1.5f-(halfx*x*x));
double I1;
I1 = x;
MArgument_setReal(Res, I1);
return LIBRARY_NO_ERROR;
}";
Quiet@LibraryFunctionUnload[fastinvsqrt]
fastinvsqrtlib=CreateLibrary[src,"fastinvsqrt"]
fastinvsqrt=LibraryFunctionLoad[fastinvsqrtlib, "fastinvsqrt",{Real,Integer},Real]
magicconst=16^^5f3759df
Plot[{1/Sqrt[x],fastinvsqrt[x,magicconst]},{x,0.1,5},PlotRange->{0,2}]
LogLogPlot[{1/Sqrt[x]-fastinvsqrt[x,magicconst],1/Sqrt[x]},{x,0.01,100000},PlotRange->{All,{10^-6,10}},Frame->True,PlotRangePadding->None,PlotPoints->1200,MaxRecursion->3]
![enter image description here][2]
The match is indeed great! and we can see that the error (second plot, in blue) is of the order 0.1% of the result for the original magic constant!
Let's introduce the relative error:
ClearAll[relativeerror]
relativeerror[x_Real, magic_Integer] := (1/Sqrt[x] - fastinvsqrt[x, magic])/(1/Sqrt[x])
and plot it:
LogLogPlot[relativeerror[x, magicconst], {x, 0.01, 100000},
Frame -> True, PlotRangePadding -> None, PlotRange -> {10^-5, 1},
PlotPoints -> 1200, MaxRecursion -> 3]
![enter image description here][3]
This plot is periodic because of the way floating point numbers are defined/implemented, we can zoom in on one of the parts:
LogLinearPlot[relativeerror[x, magicconst], {x, 1, 4}, Frame -> True,
PlotRangePadding -> None, PlotRange -> All, PlotPoints -> 1200,
MaxRecursion -> 3]
![enter image description here][4]
We can plot slight deviations from the magic constant to see the new relative errors:
LogLinearPlot[{relativeerror[x, magicconst],
relativeerror[x, magicconst - 20000],
relativeerror[x, magicconst + 20000]}, {x, 1, 4}, Frame -> True,
PlotRangePadding -> None, PlotRange -> All, PlotPoints -> 1200,
MaxRecursion -> 3, PlotLegends -> {"0", "-20000", "+20000"}]
![enter image description here][5]
If the constant increases, the center peaks go up, but the far-right and far-left peak go down.
Let's try a bunch of magic-constants, and check the maximum (relative) error we find. I do this by sampling many point and looking for the maximum error I find in those points:
Dynamic[d]
data = Table[{d, Max[Table[With[{x = 2^s}, ((1/Sqrt[x] - fastinvsqrt[x, d + magicconst])/(1/Sqrt[x]))], {s, 0, 2, 0.00001}]]}, {d, -100000, 100000,
1000}];
data // ListLogPlot
TakeSmallestBy[data, Last, 1]
![enter image description here][6]
{{0, 0.00175225}}
If there is a better constant, it sure is close to the original constant. Let's zoom in a bit:
Dynamic[d]
data = Table[{d, Max[Table[With[{x = 2^s}, ((1/Sqrt[x] - fastinvsqrt[x, d + magicconst])/(1/Sqrt[x]))], {s, 0, 2, 0.00001}]]}, {d, -1000, 1000, 10}];
data // ListLogPlot
TakeSmallestBy[data, Last, 1]
![enter image description here][7]
{{160, 0.00175121}}
We can zoom in even further:
Dynamic[d]
data=Table[{d,Max[Table[With[{x=2^s},((1/Sqrt[x]-fastinvsqrt[x,d+magicconst])/(1/Sqrt[x]))],{s,0,2,0.0000001}]]},{d,160,170,1}];
data//ListLogPlot
TakeSmallestBy[data,Last,1]
![enter image description here][8]
{{166, 0.00175129}}
magicconstant + 166 seems to have a slightly better worst-case performance. This corresponds to the follow new magic constant:
BaseForm[magicconst + 166, 16]
or in C (in hex):
0x5f375a85
We could also use the built-in FindMaximum:
ClearAll[FindMaxima]
FindMaxima[d_Integer]:=Module[{x},
Max[Table[First@FindMaximum[((1/Sqrt[x]-fastinvsqrt[x,d+magicconst])/(1/Sqrt[x])),{x,x0,1,4},MaxIterations->5000,WorkingPrecision->50],{x0,1.0,4.0,0.03}]]
]
Now using this function and look around our probable minimum:
Dynamic[d]
data=Quiet@Table[{d,FindMaxima[d]},{d,150,175,1}];
data//ListLogPlot
TakeSmallestBy[data,Last,1]
![enter image description here][9]
Which also find 166. So that seems to be in agreement. Another [paper][10] found 0x5f375a86 which 16^^5f375a86 - magicconst = 167. So perhaps he/me is wrong with rounding somehow…
## Average error ##
So far, we've been looking at maximum error possible, but what about minimising the average error? Since we're using floating point numbers that can range over many many decades I would like to minimize the following integral of the error:
Integrate[relativeerror[2^s]^2,{s,0,2}]
Note that I do not sample the domain x 1 to 4 linearly. Again we can run for large deviations from the magic constant:
Dynamic[d]
data=Table[{d,Total[Table[With[{x=2^s},((1/Sqrt[x]-fastinvsqrt[x,d+magicconst])/(1/Sqrt[x]))^2],{s,0,2,0.00001}]]},{d,-250000,250000,10000}];
data//ListLogPlot
TakeSmallestBy[data,Last,1]
![enter image description here][11]
Let's zoom in a bit more:
Dynamic[d]
data=Table[{d,Total[Table[With[{x=2^s},((1/Sqrt[x]-fastinvsqrt[x,d+magicconst])/(1/Sqrt[x]))^2],{s,0,2,0.00001}]]},{d,-96000,-94000,20}];
data//ListLogPlot
TakeSmallestBy[data,Last,1]
![enter image description here][12]
And zooming a bit more and using a smaller 'integration' steps:
Dynamic[d]
data=Table[{d,Total[Table[With[{x=2^s},((1/Sqrt[x]-fastinvsqrt[x,d+magicconst])/(1/Sqrt[x]))^2],{s,0,2,0.00000005}]]},{d,-94900,-94800,1}];
data[[All,2]]=Rescale[data[[All,2]]];
ListPlot[data,PlotRange->All]
TakeSmallestBy[data,Last,1]
![enter image description here][13]
The lowest value happens at magicconstant - 94863:
LogLogPlot[{relativeerror[x,magicconst],relativeerror[x,magicconst-94863]},{x,0.01,100000},Frame->True,PlotRangePadding->None,PlotRange->{10^-5,1},PlotPoints->1200,MaxRecursion->3]
LogLinearPlot[{relativeerror[x,magicconst]^2,relativeerror[x,magicconst-94863]^2},{x,1,4},Frame->True,PlotRangePadding->None,PlotRange->All,PlotPoints->1200,MaxRecursion->3]
![enter image description here][14]
Here (in orange) the average (square) relative error is better as compared to the original constant.
Hope you enjoyed this little exploration of using C code inside Mathematica and to optimize low-level algorithms interactively using Mathematica's library functionality and plotting functionality. The original code includes a single Newton iteration to further hone in to the correct answer, the plots I've showed are for a single iteration. Other people have optimized the constant for not a single iteration or two iterations… So there are different constants out there. And, since the values are always under-estimated, the Newton iteration can also be modified to account for this.
[1]: https://en.wikipedia.org/wiki/Fast_inverse_square_root
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-05-27at01.36.58.png&userId=73716
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-05-27at01.40.10.png&userId=73716
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-05-27at01.41.11.png&userId=73716
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-05-27at01.43.40.png&userId=73716
[6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-05-27at01.49.01.png&userId=73716
[7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-05-27at01.47.42.png&userId=73716
[8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-05-27at01.50.33.png&userId=73716
[9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-05-27at01.54.12.png&userId=73716
[10]: https://cs.uwaterloo.ca/~m32rober/rsqrt.pdf
[11]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-05-27at02.04.47.png&userId=73716
[12]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-05-27at02.05.39.png&userId=73716
[13]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-05-27at02.07.26.png&userId=73716
[14]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-05-27at02.13.55.png&userId=73716Sander Huisman2017-05-27T00:25:47ZWhat's wrong with the replacement rule?
http://community.wolfram.com/groups/-/m/t/1109486
I calculated W X Y Z by solving 4 equations
The result are 4 substitution rules.
estratti = {16, 19, 35, 53, 23};
m = 19;
a = Extract[estratti, 1];
b = Extract[estratti, 2];
c = Extract[estratti, 3];
d = Extract[estratti, 4];
e = Extract[estratti, 5];
Solve[a*m + w == b, {w}, Modulus -> 90]
Solve[b*m + x == c, {x}, Modulus -> 90]
Solve[c*m + y == d, {y}, Modulus -> 90]
Solve[d*m + z == e, {z}, Modulus -> 90]
Reduce[{a + w*m + g == 0, b*m + g == 0}, {g}, Modulus -> 90]
Reduce[{a*m + w + x*m + h == 0, b + x*m + h == 0}, {h},
Modulus -> 90]
Reduce[{a*m + w + x*m + i == 0, c*m + i == 0}, {i}, Modulus -> 90]
Reduce[{b + x*m + j == 0, c*m + j == 0}, {j}, Modulus -> 90]
In the last 4 equations I want to replace the values of W X Y Z with the previous results.
I tried:
• FLATTEN to remove the double parenthesis {{}}
• assigning a NAME, then PART to extract from: NAME = {{w-> 75}} the rule {w-> 75}
• use the PART obtained as replacement /. NAME [[1]], but I always get C [1] in the solutions.
I want to get only the INTEGER value of G H I, without x = C [1]
Manually replacing the letters with their respective numeric values all works.
Thank you.pisa livorno2017-05-27T20:05:20ZWhere can i download more gems (notebooks) like this one?
http://community.wolfram.com/groups/-/m/t/1110314
I managed to find a couple of notebooks such as this
http://library.wolfram.com/infocenter/Conferences/6540/ (Tricks from the master - Michael Trott)
and
http://library.wolfram.com/infocenter/Conferences/377/ (talks about unevaluated expressions)
I wish to know if people know links to more notebooks like these that focus on the core programming language. Please feel free to add more links below on Notebooks in the archive that specifically talk about the core language
Perhaps this can also prove beneficial to the community as well.Ali Hashmi2017-05-29T10:11:12ZHow can I simplify the logarithm of a sum: Log[ a+b]?
http://community.wolfram.com/groups/-/m/t/1109283
Dear Wolfram team and community:
How can I rearrange the logarithm of a sum: Log[a+b]
Is the following formula (found on wikipedia) true or false? :
**Log[a+b] = Log[a] + Log[1 + b/a]**
If is true, how can I do it in *Mathematica*?Alberto Silva Ariano2017-05-28T03:33:40ZSet up a package with Needs[]?
http://community.wolfram.com/groups/-/m/t/1108337
By steps Insert/FilePath, I got a file path:
"D:\\Mathematica\\Mathematica Programer II\\MATHPROG\\LOGICPROGRAMMING.M",
but
Needs["D:\\Mathematica\\Mathematica Programer \
II\\MATHPROG`LOGICPROGRAMMING.m`"]
Mathematica always says
Needs::cxt: Invalid context specified at position 1 in
Needs[D:\Mathematica\Mathematica Programer II\MATHPROG`LOGICPROGRAMMING.m` ].
A context must consist of valid symbol names separated `
In fact I put `, What's wrong?Yinsheng Zhang2017-05-26T03:00:05ZChaos bifurcation of double pendulums calculation with OOP
http://community.wolfram.com/groups/-/m/t/1109273
This sample program is developed to show the power of [Mathematica OOP][1] as shown in other my OOP projects.
It is well known that the double pendulum motion becomes a chaos with time development. Also, in the time development of a pendulum, we can observe another kind of chaos caused by the initial condition. A very small fluctuation of the initial condition affect the time development deeply. In this program case, angle perturbation less than 10^-12 can have an effect on the time development.
To observe this phenomenon this program traces simultaneously a several tens of double pendulums each has random initial angle difference. The pendulums are represented by the instance constructed from the OOP Lagrange equation of motion class. The Mathematica OOP can represent these number of double pendulums motion in time development with a simple and an effective way.
![50 pendulums in time development][2]
Setup for global parameters and OOP class
{g = 9.8, m = 1, r1 = 1, r2 = 0.5, time = 50};
case[nam_] :=
Module[{\[Theta]1, \[Theta]2, ans, T1, T2, V1, V2, t, L, lkeq,
initcond},
initialize[nam[th1_, th2_]] ^:= (
(* Lagrangian setup *)
T1 = 1/2 m*r1^2*\[Theta]1'[t]^2;
V1 = -m*g*r1*Cos[\[Theta]1[t]];
T2 =
1/2 m*(r1^2*\[Theta]1'[t]^2 + r2^2*\[Theta]2'[t]^2 +
2 r1*r2*\[Theta]1'[t]*\[Theta]2'[t]*r1*r2*
Cos[\[Theta]1[t] - \[Theta]2[t]]);
V2 = -m*g*(r1*Cos[\[Theta]1[t]] + r2*Cos[\[Theta]2[t]]);
L = T1 + T2 - (V1 + V2);
(* Lagrange equation of motion *)
lkeq = {D[D[L, \[Theta]1'[t]], t] - D[L, \[Theta]1[t]] == 0,
D[D[L, \[Theta]2'[t]], t] - D[L, \[Theta]2[t]] == 0};
initcond = {
\[Theta]1[0] == th1,
\[Theta]2[0] == th2,
\[Theta]1'[0] == 0,
\[Theta]2'[0] == 0};
(* Numerical solve of equation *)
ans = NDSolve[{lkeq, initcond}, {\[Theta]1, \[Theta]2}, {t, 0,
time}, MaxSteps -> Infinity, PrecisionGoal -> \[Infinity]][[
1]];
);
pendulum[nam[tr_]] ^:= (
(* Pendulum graphics return *)
Graphics[{Line[{{0,
0}, {r1*Sin[\[Theta]1[tr]], -r1*Cos[\[Theta]1[tr]]} /.
ans}], Line[{{r1*Sin[\[Theta]1[tr]], -r1*
Cos[\[Theta]1[tr]]}, {(r1*Sin[\[Theta]1[tr]] +
r2*Sin[\[Theta]2[tr]]), (-r1*Cos[\[Theta]1[tr]] -
r2*Cos[\[Theta]2[tr]])}} /. ans]},
PlotRange -> {{-1.8, 1.8}, {-1.8, 1.8}}]
)
];
Setup initial conditions and construct instances, and display of results
{pendulums = 50, angle1 = 4 Pi/3, angle2 = 4 Pi/3, butterfly = 10^-12};
objectList = Table[Unique[], {pendulums}];
Map[case[#] &, objectList];
Map[initialize[#[angle1, angle2 + butterfly*RandomReal[{-1, 1}]]] &,
objectList];
Animate[Show[
Map[pendulum[#[tr]] &, objectList]
], {tr, 0, time}, AnimationRepetitions -> 1, AnimationRate -> 1]
Enjoy a sudden divergence.
[1]: http://community.wolfram.com/groups/-/m/t/897081?p_p_auth=tO31eCls
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=2302d-pendulum.jpg&userId=897049Hirokazu Kobayashi2017-05-28T01:05:18ZI am having trouble creating a button
http://community.wolfram.com/groups/-/m/t/1109631
Hello,
I am inexperienced with Mathematica, currently trying to use it as a tool for balancing a game. I want to create a button (with attached action) and for this purpose I looked up the function button and copied the examples into a notebook only to have nothing happen. Well, the cell brackets become bold, I am assuming it means it's processing the entry. It remains as such without any output. I have tried copy pasting various examples with none working.
I copied the following line from the online help/documentation on the function "Button"
**Button["Click Here", Print[10!]]**
and got no output (button or otherwise)
appreciate your help,
thank you
Akhilesh BhartiaAkhilesh Bhartia2017-05-27T13:03:46ZWhy does GeoGraphics[] redraw the DeGaulle image over Corsica?
http://community.wolfram.com/groups/-/m/t/1109431
I am trying a simple example from the GeoGraphics tutorial. I can see that Cosica is listed as part of the land mass of France:
GeoGraphics@Polygon[France]
However I would not expect this overlay app to redraw the image over the dis-contiguous polygon (i.e. Corsica). Is there a simple explanation? Is this a known problem?
The simple commands are:
dg0=EntityValue[Charles de Gaulle
, "Image"]
GeoGraphics[{GeoStyling[{"Image", dg0}],
Polygon[Entity["Country", "France"]]}]
Thanks in advance.Aeyoss Antelope2017-05-27T14:56:56ZHow can I import a bunch of .csv files automatically?
http://community.wolfram.com/groups/-/m/t/1109240
Hey guys,
I'm currently evualting the experimental results from a digital oscilloscope. This is the code I'm using:
SetDirectory[NotebookDirectory[]];
raw = Import["src/T0005.csv"];
plotData=Select[raw[[17;;]],Length[#]==5&];
time=plotData[[All,1]];
ch1 = plotData[[All,2]];
dataset1=Thread[{time,ch1}];
ListPlot[dataset1,PlotRange->All,AxesLabel->{HoldForm[Zeit in s],HoldForm[Spannung in V]},PlotLabel->HoldForm[Schwingung einer gezupften Saite],LabelStyle->{FontFamily->"Calibri",12,GrayLevel[0]}]
Now the Problem is that I have a lot of csv files and basically all I have to do is to make a plot of all the datasets. So currently I have about 20 files, which all contain the same code, apart from importing another .csv file (T0001.csv, T0002.csv,...). So I thought that there has to be a more elegant way to do the same Operation for a bunch of datasets. Maybe a For-Loop with the couting Parameter in the filename (T000i.csv).
How would you guys solve this Problem?Tobias Mitterdorfer2017-05-27T14:10:25ZHelp making a plot like in the attachment
http://community.wolfram.com/groups/-/m/t/1109373
Hi,
can somebody help me to build a plot like the one I attach in the figure?
Mmaria piarulli2017-05-27T05:08:59Z[✓] Use Plot Labels for Parametric curves?
http://community.wolfram.com/groups/-/m/t/1108310
Below is a code snippet to plot a handful of curves with some plot labels. For some reason only the first label is used and not the other four. What am I missing here? I've successfully used PlotLabels for parametric curves before but they seem to fail me here. Got any ideas??:
lmt=10
qq[zets_]=1/Sqrt[1+zets^2]^3
zets[rr_,eps_,eta_]=eps (1-rr^2) (1+eta (1+rr^2))
demcurves=Array[qq[zets[rr,2 #/lmt,0]]&,lmt/2]
Plot[demcurves,{rr,0,1}]
demlabels = Map[ToString,Array[qqzz[N[2/lmt]#]&,lmt/2]]
Plot[demcurves,{rr,0,1},PlotLabels -> Placed[demlabels,Left]]Anthony DeGance2017-05-25T17:19:36ZCDF for creating textbook notes
http://community.wolfram.com/groups/-/m/t/1109137
I purchased the license for Mathematica 11 and got it installed this week, So far I'm having a great learning experience with it. One of the most highlights of purchasing Mathematica was CDF documentation . I would like to create notes on textbooks by using the exact same feature as shown on this website: [Link][1].
Is this a template created by Mathematica, how do I go about creating a CDF such as this for a textbook I am learning.
[1]: http://www.wolfram.com/cdf/uses-examples/textbooks.htmlAbhilash Sukumari2017-05-26T19:18:21Z[✓] Modify OX labels output format?
http://community.wolfram.com/groups/-/m/t/1108667
Hello!
I want to plot a simple function, but on the OX axis, the output labels are by default 1,2,3, etc.
I want to have them in the format **x/2**.
Instead of 1,2,3, I want 2/2, 4/2, 6/2. Is this possible? But only on the OX axis.
Thank you in advance!Robert Poenaru2017-05-26T09:12:30Z[✓] Erase something drawn using the graphics tools?
http://community.wolfram.com/groups/-/m/t/1108418
I am using the "Drawing Tools" in the Graphics option. How do you **erase** something you have
drawn? How do you **delete** from a drawing in progress?jim farned2017-05-25T17:33:21Z[✓] Get dynamic image with different color for each option?
http://community.wolfram.com/groups/-/m/t/1108742
Consider the following code:
f = {1, x, x^2, x^3}
Panel[Column[{Row[{CheckboxBar[
Dynamic[list1], # -> f[[#]] & /@ Range[4]], Dynamic[list1]}],
Dynamic[Plot[f[[list1]], {x, 0, 1.5},
PlotStyle -> {Red, Blue, Green, Black}, ImageSize -> 500,
AxesStyle -> Thick]]}]]
I want to get a Dynamic image that show differrent functions according to user selection in Checkbox.
However, now I get a fine Dynamic image except that all the curves are in the same color.
I wanna know How to set the color of each option?Wu Falchion2017-05-26T07:13:37Z[✓] Plot disks of radius r=1-f[x]?
http://community.wolfram.com/groups/-/m/t/1108617
Hi i'm trying to plot disks of radius =(1-f[x]), so that it makes a sphere, as we know that the volume of a cylinder having height=2 radius - the volume of the cone having radius r, is always equal to the volume of a sphere having radius r. but i want to show that using disks.Muhammad Afzal2017-05-26T06:59:19ZPrint a Wolfram|Alpha result correctly?
http://community.wolfram.com/groups/-/m/t/1105739
I am new to WolframAlpha and this might be a very basic question - however: when I am trying to print any result from WolframAlpha, the output appears to be scrambled, it looks like printed twice, and the "second" text seems to contain the question and something like **1&rawformassumption="ClashPrefs" -> {"Math"}.**
I added a scanned page, to make it clear. I tried to deinstall my addblocker, but this does not seem to help.
The results are looking fine on the screen, No such problem with Mathematica.
If there is an obvious solution, please?
Best Regards
Joachim
!["scrambled" output][1]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=printout.png&userId=1105725Joachim von Zahn2017-05-24T10:45:19Z[GIF] Back and Forth (Möbius transformations of the circle)
http://community.wolfram.com/groups/-/m/t/1108324
![Möbius transformations of the circle][1]
**Back and Forth**
One fact I've known for a while but never really dived into is that Möbius transformations of the circle can be realized by inverse stereographic projecting to the sphere (here I'm thinking of the circle as the equator of the sphere, so inverse stereographic projection is just the identity in this case), rotating the sphere in space (say, around the south pole), and then stereographically projecting from the new "north pole" back to the circle. The animation shows what happens when you do this to 15 equally-spaced points on the circle, where the sphere is being rotated by an angle of $\pi/3$ around the axis $(\cos \psi, \sin \psi, 0)$ anchored at $(0,0,-1)$, and we let $\psi$ vary from 0 to $2\pi$.
Here's the code. First, some helper functions to tell me the center and pole of the rotated sphere:
RotatedCenter[θ_, axis_] := RotationTransform[θ, axis, {0, 0, -1}][{0, 0, 0}];
RotatedPole[θ_, axis_] := RotatedCenter[θ, axis] + {0, 0, 1};
And then a function which performs stereographic projection from any point $q$ to the plane $z=0$:
StereoPointToPlane[p_, q_] := 1/(p[[3]] - q[[3]]) {q[[1]] p[[3]] - p[[1]] q[[3]], q[[2]] p[[3]] - p[[2]] q[[3]]};
Finally, the big `Manipulate` for the animation:
DynamicModule[{axis, θ = π/3., n = 15, viewpoint = {0, 0, 2},
cols = RGBColor /@ {"#FF9F1C", "#2EC4B6", "#E71D36", "#011627"}},
Manipulate[
axis = {Cos[ψ], Sin[ψ], 0};
Graphics3D[{Sphere[
Append[StereoPointToPlane[
RotationTransform[θ, axis, {0, 0, -1}][Append[#, 0]],
RotatedPole[θ, axis]], 0], .075] & /@
CirclePoints[n]},
PlotRange -> 1.2, ViewPoint -> viewpoint, Boxed -> False,
Lighting ->
Append[Table[{"Point", cols[[i]],
Append[2 CirclePoints[3][[i]], 0]}, {i, 1, 3}], {"Ambient", cols[[-1]], viewpoint}],
Background -> cols[[-1]], ImageSize -> 540],
{ψ, 0, 2 π}]
]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=mobius12.gif&userId=610054Clayton Shonkwiler2017-05-25T19:34:31ZDefine a NN function that multiply matrices within a tensor?
http://community.wolfram.com/groups/-/m/t/1104811
I'm wondering how to define a net function that will multiply matrices inside a tensor. For example, if $s$ and $t$ are tensors with shapes $\{a,b,c\}$ and $\{a,c,d\}$ respectively, for each $i\leq a$ the subtensors in $s$ and $t$ with first index $i$ form matrices of dimensions $b\times c$ and $c\times d$ respectively. Multiplying corresponding matrices in $s$ and $t$ would produce a new tensor with shape $\{a,b,d\}$.
Is there currently a way to do this in Mathematica using nn layers? DotLayer and ThreadingLayer have depth limitations that seem to prevent it.Andrew Dabrowski2017-05-23T19:26:30ZChange default color of selected items in ListPicker
http://community.wolfram.com/groups/-/m/t/1107716
As the title already says, my question is
> Is there a way to change the highlighting color of the items that are marked/selected inside `ListPicker`?
One can somewhat influence the appearance by setting the background of selected items dynamically, but this is no real solution since the default highlighting is still overlayed
```
ListPicker[Dynamic[x], {1 -> a, 2 -> b, 3 -> c, 4 -> d},
Background -> {Dynamic[First[x]] -> Red}
]
```
As you can see, the color is not red but a mixture of red and the highlighting blue:
![Mathematica graphics](http://i.stack.imgur.com/Cwst7.png)
I have already debugged how a `ListPicker` is converted into its box-form but the highlighting color cannot be influenced. I grep'ed through all style definitions but couldn't find something that looked promising. Additionally, I looked at the implementation of ``Experimental`RowSelector`` which seems to be a predecessor of `ListPicker` but there, the whole dynamic behavior is explicitly given and colors can be changed easily.
My last hope was that we can use `Appearance` for this as it is stated in the documentation that
> When an object can be in several different states, the setting for Appearance can be given in the form {"con1"->app1,"cond2"->app2,...}.
but if this is possible at all and how to use it is not clear.
Has someone an idea that does not include hacking around and coming up with my own solution? Maybe someone from WRI could comment on this.Patrick Scheibe2017-05-25T14:54:06ZCheck PopupMenu answer
http://community.wolfram.com/groups/-/m/t/1107295
I use this function to generate a graphic and a PopupMenu:
Labeled[listar1 = {PopupMenu[Dynamic[r1], {"Sen","Cos","Tan"}]};
Plot[Sin[x],{x, -2 Pi, 2 Pi}, PlotStyle->Red,PlotRange->{-4,4},ImageSize->Large],
Column[Flatten[{Text["Which function?"],listar1}]],Right];
After a user has answer the question, how can I check the value of the PopupMenu and display a green/red rectangular or a phrase to indicate him that he is right/wrong?alessandro thesmall2017-05-25T09:36:12ZFind tutorial on use of Module[]?
http://community.wolfram.com/groups/-/m/t/1105500
Hi,
I'm a newb and wondered if there is anywhere i can get a good tutorial on use of Module, or whether anyone would tell me what using Module [ {}. ...] (ie with with empty list of local variables) achieves. I have RTFM and could not find an example with explanation anywhere.
Thanks
DaveDavid Sanderson2017-05-24T13:58:15Z[✓] Combine these plots in a single Manipulate?
http://community.wolfram.com/groups/-/m/t/1106852
How can i combine these plots in a single manipulate. I'll be very much thankful of your help please.
Clear[x, t, n];
h[x_] := x;
a = 0;
b = 1;
startpos[k_] := a + (k - 1) 0.01;
a1 = Plot[{1, -1, t, -t}, {t, 0, 1}, AspectRatio -> 1];
Manipulate[
b = Graphics[
Table[{Red, Opacity[0.5], Disk[{x, 0}, {0.01, 1}], Green,
EdgeForm[Black], Disk[{x, 0}, {0.01, h[x]}]}, {x, 0, r, 0.1}]];
aa = Table[
Graphics3D[{{Opacity[2/5], Sphere[{1, 0, 0}, 1]}, {Opacity[1/5],
Cylinder[{{i, 0, 0}, {i + 0.02, 0, 0}}, i]}},
Boxed -> False], {i, 0, r, 0.1}];
Show[a1, b, aa], {r, 0, 1}]Muhammad Afzal2017-05-25T06:41:33Z[✓] Does NumberPadding work in NumberForm?
http://community.wolfram.com/groups/-/m/t/1105146
Dear Community,
I would like to produce output of a two-digit number like 7.2 as 7.200, a three-digit number like 27.2 as 27.20, and a four-digit number like 127.2 as 127.2. I tried
NumberForm[7.2, 4, NumberPadding -> {"", "0"}]
but it produced verbatim 7.2, not 7.200. Even though the following would produce what I want for 27.2
NumberForm[27.2, {4, 2}, NumberPadding -> {"", "0"}]
it wouldn't produce what I want for 7.2 or 127.2.
Any suggestion for this petty question is much appreciated!Chi-Hsiang Wang2017-05-23T23:56:00ZArrange input fields buttons at different desired position in TabView?
http://community.wolfram.com/groups/-/m/t/1106582
I tried to align **input fields** and ***buttons*** using *position* and *alignment* syntax but I think i am making mistake somewhere or using wrong syntax.my *buttons* are always appearing in top left corner whereas i want to keep it at center bottom . Also, if you could suggest how to contol size of output boundaries that would be great help. Thanks ![Here i am attaching screenshot][1]
`ClearAll[x, y, a];
TabView[{input1[ InputField[Dynamic[x], Alignment -> {Top}]]
input2[InputField[Dynamic[y]]]
Button["add", a=x+y]
Button["Sub/multi",
a=x-y;b=xy],
Dynamic@
If[a > 50, InputField["damaged", String],
InputField["Healthy", String]]
output1[InputField[Dynamic[a]]]
output2[InputField[Dynamic[b]]]
, Button["Reverse",
nb1 = NotebookOpen["E:\\iiscnew\\PROJECT\\reverse.nb"];
SelectionMove[nb1, All, Notebook]
SelectionEvaluate[nb1]
NotebookClose[nb1]]
output3[InputField[Dynamic[w]]]
output4[InputField[Dynamic[v]]]}]`
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot%285%29.png&userId=1084474Dileep Kumar2017-05-25T07:43:08ZAdjust the distance between the axis label and the axis in 3D plot?
http://community.wolfram.com/groups/-/m/t/1106239
How to adjust the distance between the axis label and the axis itself in 3D plot.
I want to add more space because when I rotate it, the label overlap with the tick numbers or even the axis.
Thanks.
ListPlot3D[tablogDCS, AxesLabel -> {" ki (a.u.) ", " E (eV) ", " DCS "},
PlotRange -> {{0.708, 0.83}, Full, Full}, LabelStyle -> 15,
TicksStyle -> 15, ImageSize -> Large, ColorFunction -> "Rainbow"]Ghady Almufleh2017-05-24T17:19:13ZMake efficient the computation of an integral with NIntegrate?
http://community.wolfram.com/groups/-/m/t/1102909
Hi,
I need to compute the integral shown in the attached figure but I keep obtaining the same error "NIntegrate::slwcon : Numerical integration converging too slowly; suspect one of the following: singularity, value of the integration is 0, highly oscillatory integrand, or WorkingPrecision too small.". I have played a lot with the WorkingPrecision, the AccurayGoal, the PrecisionGoal, but I can not obtain the solution of the integral. Please, could someone help me? Any tip/suggestion that I should follow.
ThanksAna Doblas2017-05-22T23:34:52ZGraph Editor with OOP
http://community.wolfram.com/groups/-/m/t/1100917
GraphEdit[] is a useful and the only one tool for graph editing which was introduced in ver.10, however, when you want create a new and a complex graph, you will find that is sometimes tedious job caused of the slow response of it.
Like GraphEdit, Mathematica event handling system is very useful and strong, but, the number of targets, such as the locators, become large, handling the target becomes more complex and that situation appears as slow program response. This situation is one of the limits of the Mathematica programming style.
[Object-Oriented-Programming(OOP)][1] in Mathematica is a pathway to make an easy handling method for large number of targets that, in terms of OOP, instances what are existing simultaneously in Mathematica name space.
My project objective is to show that OOP style can solve this limitation. In my sample Graph Editor, each target (vertex) and allows(edges) are represented as instances produced form nested class of OOP. Also, this project shows that the OOP is familiar to the Event handler in Mathematica programming.
This GraphEditor program can
- make named vertex and arrows connecting with other vertices
- move objects on the board
- delete vertices and arrows
- save and load the graph
- and convert to a Mathematica graph.
You can view [a sample movie][2] here.
[1]: http://community.wolfram.com/groups/-/m/t/897081?p_p_auth=MM13qcBI
[2]: https://s3-ap-northeast-1.amazonaws.com/kobayashikorio/math_slides/graph.mp4Hirokazu Kobayashi2017-05-22T12:41:36ZInterpolatingFunction appears to be "Listable"?
http://community.wolfram.com/groups/-/m/t/1105784
Dear all,
consider an ``InterpolatingFunction`` depending on more than on variable:
ClearAll["Global`*"]
data = RandomReal[{-1, 1}, {10, 10}];
func = ListInterpolation[data, {{0, 1}, {0, 1}}];
A regular function call would then be:
func[x, y]
(* Out: InterpolatingFunction[{{0.`,1.`},{0.`,1.`}},"<>"][x,y] *)
But if I try a ``List`` as argument (I definitely expected no further evaluation!), I get:
func[{x, y}]
(* Out: {InterpolatingFunction[{{0.`,1.`},{0.`,1.`}},"<>"][x], InterpolatingFunction[{{0.`,1.`},{0.`,1.`}},"<>"][y]} *)
so, ``InterpolatingFunction`` seems to have the attribute ``Listable``, which one does not find when calling
Attributes[InterpolatingFunction]
(* Out: {Protected,ReadProtected} *)
Can anybody give me a hint on where I am missing the point? (On a somewhat larger piece of code it took me quite a while tracking that effect down ...)
Best regards -- HenrikHenrik Schachner2017-05-24T13:23:45ZMonitor importing process of a CSV file with ProgressIndicator or alike?
http://community.wolfram.com/groups/-/m/t/1099739
Dear all,
I would like to track the importing process of a CSV file. The file is pretty large and it takes hours to load it into Mathematica. To evaluate at which state the uploading process is, I would like to use a Progress Bar or equivalent. Therefore I read at StackOverflow that there is a possibility to track the calculation process of an operation using `Monitor` or `ProcessIndicator`. Unfortunately, I have not been able to adapt the code or find the other code which makes this possible. Therefore I am wondering if someone already used this kind of solution to track an importing forces of a CSV file into Mathematica?
I would be very happy if someone could help me, thank you in advance!
Best regards
AlexAlexander Hempfing2017-05-21T16:50:02ZDisplay dynamic data?
http://community.wolfram.com/groups/-/m/t/1102243
Hi
So i tried to display data dynamically but it dosent work.
When i put **Dynamic[data, UpdateInterval -> 2]** where my data is **FinancialData["NASDAQ:AAPL"]**,when i press shift i can see the current value of the data but it dosent update it with the dynamic function. What am i doing wrong ?
Same when i put
Dynamic[DateListPlot[data, Joined -> True],
SynchronousUpdating -> False]
,if i press shift i receive a message saying
DateListPlot::ldata: 1.1231` is not a valid dataset or list of datasets.
I hope soemone can help me.Thanksalex grover2017-05-22T16:22:18ZSporadic convergence failure: “SingularValueDecomposition::cflsvd”
http://community.wolfram.com/groups/-/m/t/1065721
<b>Update 1</b> Per a request from Daniel Lichtblau at Wolfram Research, a minimal example has been uploaded to Google Drive as a pure-ASCII no-format `"m"`-file named [`"oneMatrixThatFailsSVD_2017.m"`][1]. The file is rather large (about 7.7 MBytes) because it encodes a convergence-failing `320x320` complex matrix as an integer byte-array of dimension `320x320x16`. This bit-perfect encoding "trick" is necessary because SVD convergence-failure seemingly is exquisitely sensitive to the least-significant bits of IEEE complex numbers (which are of course precisely the bits to which no well-conditioned SVD algorithm should be sensitive).
---
<b>Update 2</b> A comment has been added to the end of the above-mentioned text file [`"oneMatrixThatFailsSVD_2017.m"`][1] that provides the following (exact) pipe for flipping the least-significant-bit of complex matrices:
<code>
Flatten// (* complex square matrix -> complex list *)
ExportString[#,"Complex128"]&// (* complex list -> byte string *)
ExportString[#,"Base64"]&// (* byte string -> Base64 string *)
ByteArray[#]&//Normal// (* Base64 string -> integer list *)
Partition[#,16]&// (* integer list -> {...} *)
Partition[#,#//Length//Sqrt]&// (* {...} -> integer array *)
Map[(
{#[[1]]//If[#//EvenQ,#+1,#-1]&} ~ Join ~ (* flip LSB of real part *)
#[[2;;8]] ~ Join ~
{#[[9]]//If[#//EvenQ,#+1,#-1]&} ~ Join ~ (* flip LSB of imag part *)
#[[10;;16]]
)&,#,{2}]&//
Flatten// (* integer array -> integer list *)
ExportString[#,"Byte"]&// (* integer list -> byte string *)
ImportString[#,"Complex128"]&// (* byte string -> complex list *)
Partition[#,#//Length//Sqrt]&; (* complex list -> complex matrix *)
</code>
It turns out that flipping the least-significant bits of a convergence-failing input matrix <i>does</i> reproducibly eliminate the `"SingularValueDecomposition::cflsvd:"` message (which is behavior that no well-conditioned SVD algorithm should exhibit).
Hopefully this fine-grained, exactly reproducible control of the `"cflsvd"` SVD bug will make fixing it much easier in 2017 than back in 2005, when Mathematica tools like `ByteArray[__]` and `ExportString[_,"Complex128"]` were less-developed, such that the bug was more challenging to exhibit reproducibly and diagnose reliably.
----
<b>The bug in a nutshell:</b>&nbsp; for single-precision complex matrices, Mathematica's SingularValueDecomposition[] sporadically fails to converge.
The associated Mathematica-generated error message is:
SingularValueDecomposition::cflsvd: Machine-precision algorithm
failed to converge. Arbitrary-precision algorithm is called,
which is slower but more accurate.
This is a followup to a long-standing Mathematica bug report (specifically Wolfram Research bug report [TS 28968], submitted way back in 2005).
[This tarball][2] provides (in a folder named `"SVDfailures_2017"`) 25 examples of matrices whose convergence fails under Mathematica 10.2.0 for Mac OS X x86. The same tarball provides (in a folder named "`SVDfailures_2005`") matrices that fail under various versions of Mathematica dating back to 2005 (these files were provided with bug report [TS 28968]). The tarball is rather large (more than 100 MBytes) because it consists mostly of numerical matrices created with `"DumpSave[__]"`).
A principal difference between the 2005 failures and the 2017 failures is that (at least some of) the matrices that failed outright back in 2005, now generate the (undocumented?) convergence-failure message `"SingularValueDecomposition::cflsvd"`
To anticipate some questions:
- The arbitrary-precision evaluation does yield a correct decomposition, at the expense of a runtime that is 500-1000X longer.
- The matrices that fail of convergence are (seemingly) unremarkable in respect to numerical condition and rank.
- There is no reason (known to me at least) why SVDs of $\mathcal{O}(1)$-entry single-precision matrices should ever "fail to converge", and there is no linear algebra software other than Mathematica's (known to me) that exhibits a similar convergence failure.
My questions are:
- Does `"SingularValueDecomposition::cflsvd"` convergence-failure occur more generally, i.e., on systems other than Mathematica 10.2.0 for Mac OS X?
- What's the best way to report this bug (if it is a reproducible bug)?
[1]: https://drive.google.com/open?id=0ByYbFbzq4CGyZ3hobWZKb0U1TXM
[2]: https://drive.google.com/open?id=0ByYbFbzq4CGyNHBnMTRNeEMwTDAJohn Sidles2017-04-19T01:44:14Z[TMJ] Polynomial $L^2$ Approximation
http://community.wolfram.com/groups/-/m/t/1105974
New *THE MATHEMATICA JOURNAL* article:
----------
Polynomial $L^2$ Approximation
--------------------------------------------------------------------
**Relating Orthonormal Polynomials, Gram—Schmidt Orthonormalization, QR Factorization, Normal Equations and Vandermonde and Hilbert Matrices**
*by GOTTLOB GIENGER*
----------
ABSTRACT: This didactic synthesis compares three solution methods for polynomial $L^2$ approximation and systematically presents their common characteristics and their close interrelations:
1. Classical Gram–Schmidt orthonormalization and Fourier approximation in $L^2(a,b)$
2. Linear least-squares solution via QR factorization on an equally
spaced grid in $[a,b]$
3. Linear least-squares solution via the normal equations method in $L^2(a,b)$
and on an equally spaced grid in $[a,b]$
The first two methods are linear least-squares systems with Vandermonde matrices $V$ ; the normal equations contain matrices of Hilbert type $H=V^TV$ . The solutions on equally spaced grids in $[a,b]$ converge to the solutions in $L^2(a,b)$. All solution characteristics and their relations are illustrated by symbolic or numeric examples and graphs.
- [Read full text][1]
- [Submit an article][2]
----------
![enter image description here][3]
[1]: http://www.mathematica-journal.com/2017/05/polynomial-l2-approximation/
[2]: http://www.mathematica-journal.com/submit-article/
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Gienger_Output_20.gif&userId=20103Moderation Team2017-05-24T16:34:28ZParallel Mathematica Environment on the RaspberryPi using OOP
http://community.wolfram.com/groups/-/m/t/1057588
My project, Parallel Mathematica Environment on the RaspberryPi using OOP, is a sample application of **Object Oriented Programming for the Mathematica** cluster computing, implemented with a Mac and three RaspberryPi Zero connected with a USB hub and three USB cables.
Basic idea is to deploy a constructed instance image to calculating servers (RaspberryPi) and send messages to the instance. [OOP on the Mathematica is already developed and shown][1] in this community, and further detail is shown on [slidesshare][2] titled of "OOP for Mathematica."
![enter image description here][3]
----------
Preparing for RaspberryPi Zero is as follows using SSH connection from a Mac,
- naming each Zero as raspberypi,raspberrypi1,raspberrypi2,...
- set the server program "init" to each RaspberryPi, init is,
$ cat init
While[True,
Run[“nc -l 8000>input”];
temp=ReleaseHold[<<input];
temp >>output;
Run[“nc your-mac-hostname.local 8002<output”]
]
where, socket numbers must be identical.
- Run Mathematica manually, and wait the booting Mathematica up.
$ wolfram <init&
Checking each RaspberryPi is useful as,
$ nc -l 8002 >output|nc raspberrypi.local 8000 <<EOF
> 10!
> EOF
$ cat output
3628800
----------
Cluster controller program on a Mac is,
- set directory
SetDirectory[NotebookDirectory[]];
- setup socket communication process
com1="nc -l 8002 >output1 |nc raspberrypi.local 8000 <input1";
com2="nc -l 9002 >output2 |nc raspberrypi1.local 9000 <input2";
com3="nc -l 9502 >output3 |nc raspberrypi2.local 9500 <input3";
- set object property
obj={
<|"name"->node1,"comm"->com1,"in"->"input1","out"->"output1","p"->{2000,3500}|>,
<|"name"->node2,"comm"->com2,"in"->"input2","out"->"output2","p"->{3501,4000}|>,
<|"name"->node3,"comm"->com3,"in"->"input3","out"->"output3","p"->{4000,4500}|>};
- define calculation server class, where is a sample Mersenne prime number calculation
new[nam_]:=Module[{ps,pe},
mersenneQ[n_]:=PrimeQ[2^n-1];
setv[nam[{s_,e_}]]^:={ps,pe}={s,e};
calc[nam]^:=Select[Range[ps,pe],mersenneQ]
];
- construct instances
Map[new[#name]&,obj];
- deploy instances to calculation servers
Map[Save[#in,#name]&,obj];
Map[Run[#comm]&,obj];
- send message to each instance
Map[Put[Hold@setv[#name[#p]],#in]&,obj];
Map[Run[#comm]&,obj];
- start calculation
Map[Put[Hold@calc[#name],#in]&,obj];
proc=Map[StartProcess[{$SystemShell,"-c",#comm}]&,obj]
- wait for the process termination (mannualy in this sample code)
Map[ProcessStatus[#]&,proc]
{Finished,Finished,Finished}
- gather the results
Map[FilePrint[#out]&,obj];
{2203, 2281, 3217}
{}
{4253, 4423}
[1]: http://community.wolfram.com/groups/-/m/t/897081?p_p_auth=o5qxZhNR
[2]: https://www.slideshare.net/kobayashikorio/oop-for-mathematica
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=2017-04-10.jpg&userId=897049Hirokazu Kobayashi2017-04-10T01:15:22Z[✓] Select specific values from Solve function?
http://community.wolfram.com/groups/-/m/t/1105931
Hello guys!
I want to solve a 4th order equation, and to find its solutions.
This procedure is straightforward but, after this, I want to select only the last 2 roots, and to store them as variables, say w1 and w2.
sol1 = Solve[equ[t, x, j1] == 0, {t}, Reals];
{{t -> -0.241908}, {t -> -0.173627}, {t -> 0.173627}, {t -> 0.241908}}
If I write
w1 = sol1[[3]];
w2 = sol1[[4]];
Print[w1, w2]
I get this thing
{t->0.173627}{t->0.241908}
But I want only the numerical values, without those useless arrows and letters.
HOW CAN I FIX THIS?
Thank you in advance!Robert Poenaru2017-05-24T13:44:10ZTransfer an artistic style to an image
http://community.wolfram.com/groups/-/m/t/1093926
# Introduction
Back in [Wolfram Summer School 2016][1] I worked on the project "Image Transformation with Neural Networks: Real-Time Style Transfer and Super-Resolution", which got later [published on Wolfram Community][2]. At the time I had to use the MXNetLink package, but now all the needed functionality is built-in, so here is a top-level implementation of artistic style transfer with Wolfram Language. This is a slightly simplified version of the original method, as it uses a single VGG layer to extract the style features, but a full implementation is of course possible with minor modifications to the code. You can also find this example in the docs:
[NetTrain][3] >> Applications >> Computer Vision >> Style Transfer
# Code
Create a new image with the content of a given image and in the style of another given image. This implementation follows the method described in Gatys et al., *A Neural Algorithm of Artistic Style*. An example content and style image:
![enter image description here][4]
To create the image which is a mix of both of these images, start by obtaining a pre-trained image classification network:
vggNet = NetModel["VGG-16 Trained on ImageNet Competition Data"];
Take a subnet that will be used as a feature extractor for the style and content images:
featureNet = Take[vggNet, {1, "relu4_1"}]
![enter image description here][5]
There are three loss functions used. The first loss ensures that the "content" is similar in the synthesized image and the content image:
contentLoss = NetGraph[{MeanSquaredLossLayer[]}, {1 -> NetPort["LossContent"]}]
![enter image description here][6]
The second loss ensures that the "style" is similar in the synthesized image and the style image. Style similarity is defined as the mean-squared difference between the Gram matrices of the input and target:
gramMatrix = NetGraph[{FlattenLayer[-1], TransposeLayer[1 -> 2], DotLayer[]}, {1 -> 3, 1 -> 2 -> 3}];
styleLoss = NetGraph[{gramMatrix, gramMatrix, MeanSquaredLossLayer[]},
{NetPort["Input"] -> 1, NetPort["Target"] -> 2, {1, 2} -> 3, 3 -> NetPort["LossStyle"]}]
![enter image description here][7]
The third loss ensures that the magnitude of intensity changes across adjacent pixels in the synthesized image is small. This helps the synthesized image look more natural:
l2Loss = NetGraph[{ThreadingLayer[(#1 - #2)^2 &], SummationLayer[]}, {{NetPort["Input"], NetPort["Target"]} -> 1 -> 2}];
tvLoss = NetGraph[<|
"dx1" -> PaddingLayer[{{0, 0}, {1, 0}, {0, 0}}, "Padding" -> "Fixed" ],
"dx2" -> PaddingLayer[{{0, 0}, {0, 1}, {0, 0}}, "Padding" -> "Fixed"],
"dy1" -> PaddingLayer[{{0, 0}, {0, 0}, {1, 0}}, "Padding" -> "Fixed" ],
"dy2" -> PaddingLayer[{{0, 0}, {0, 0}, {0, 1}}, "Padding" -> "Fixed"],
"lossx" -> l2Loss, "lossy" -> l2Loss, "tot" -> TotalLayer[]|>,
{{"dx1", "dx2"} -> "lossx", {"dy1", "dy2"} -> "lossy",
{"lossx", "lossy"} -> "tot" -> NetPort["LossTV"]}]
![enter image description here][8]
Define a function that creates the final training net for any content and style image. This function also creates a random initial image:
createTransferNet[net_, content_Image, styleFeatSize_] := Module[{dims = Prepend[3]@Reverse@ImageDimensions[content]},
NetGraph[<|
"Image" -> ConstantArrayLayer["Array" -> RandomReal[{-0.1, 0.1}, dims]],
"imageFeat" -> NetReplacePart[net, "Input" -> dims],
"content" -> contentLoss,
"style" -> styleLoss,
"tv" -> tvLoss|>,
{"Image" -> "imageFeat",
{"imageFeat", NetPort["ContentFeature"]} -> "content",
{"imageFeat", NetPort["StyleFeature"]} -> "style",
"Image" -> "tv"},
"StyleFeature" -> styleFeatSize ] ]
Define a [NetDecoder][9] for visualizing the predicted image:
meanIm = NetExtract[featureNet, "Input"][["MeanImage"]]
> {0.48502, 0.457957, 0.407604}
decoder = NetDecoder[{"Image", "MeanImage" -> meanIm}]
![enter image description here][10]
The training data consists of features extracted from the content and style images. Define a feature extraction function:
extractFeatures[img_] := NetReplacePart[featureNet, "Input" ->NetEncoder[{"Image", ImageDimensions[img],
"MeanImage" ->meanIm}]][img];
Create a training set consisting of a single example of a content and style feature:
trainingdata = <|
"ContentFeature" -> {extractFeatures[contentImg]},
"StyleFeature" -> {extractFeatures[styleImg]}
|>
Create the training net whose input dimensions correspond to the content and style image dimensions:
net = createTransferNet[featureNet, contentImg,
Dimensions@First@trainingdata["StyleFeature"]];
When training, the three losses are weighted differently to set the relative importance of the content and style. These values might need to be changed with different content and style images. Create a loss specification that defines the final loss as a combination of the three losses:
perPixel = 1/(3*Apply[Times, ImageDimensions[contentImg]]);
lossSpec = {"LossContent" -> Scaled[6.*10^-5],
"LossStyle" -> Scaled[0.5*10^-14],
"LossTV" -> Scaled[20.*perPixel]};
Optimize the image using [NetTrain][11]. [LearningRateMultipliers][12] are used to freeze all parameters in the net except for the [ConstantArrayLayer][13]. The training is best done on a GPU, as it will take up to an hour to get good results with CPU training. The training can be stopped at any time via Evaluation -> Abort Evaluation:
trainedNet = NetTrain[net,
trainingdata, lossSpec,
LearningRateMultipliers -> {"Image" -> 1, _ -> None},
TrainingProgressReporting ->
Function[decoder[#Weights[{"Image", "Array"}]]],
MaxTrainingRounds -> 300, BatchSize -> 1,
Method -> {"ADAM", "InitialLearningRate" -> 0.05},
TargetDevice -> "GPU"
]
![enter image description here][14]
Extract the final image from the [ConstantArrayLayer][15] of the trained net:
decoder[NetExtract[trainedNet, {"Image", "Array"}]]
![enter image description here][16]
[1]: https://education.wolfram.com/summer/school/alumni/2016/salvarezza/
[2]: http://community.wolfram.com/groups/-/m/t/885941
[3]: http://reference.wolfram.com/language/ref/NetTrain.html
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=I_432.png&userId=95400
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=O_179.png&userId=95400
[6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=O_180.png&userId=95400
[7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=O_181.png&userId=95400
[8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=O_182.png&userId=95400
[9]: http://reference.wolfram.com/language/ref/NetDecoder.html
[10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=O_184.png&userId=95400
[11]: http://reference.wolfram.com/language/ref/NetTrain.html
[12]: http://reference.wolfram.com/language/ref/LearningRateMultipliers.html
[13]: http://reference.wolfram.com/language/ref/ConstantArrayLayer.html
[14]: http://community.wolfram.com//c/portal/getImageAttachment?filename=O_185.png&userId=95400
[15]: http://reference.wolfram.com/language/ref/ConstantArrayLayer.html
[16]: http://community.wolfram.com//c/portal/getImageAttachment?filename=I_466.png&userId=95400Matteo Salvarezza2017-05-15T10:33:59ZSetup Workbench with Eclipse Neon3, current Java IDE, distribution?
http://community.wolfram.com/groups/-/m/t/1105418
Hi,
I am trying to setup Workbench with Eclipse Neon3, current Java IDE, distribution. It runs into the cerfificate (as expected), but after clicking OK does not finish the setup - at least after restart there is no sign of it.
![enter image description here][1]
![enter image description here][2]
any ideas anyone?
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Unbenannt.JPG&userId=196304
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=9228Unbenannt.JPG&userId=196304Erik Itter2017-05-24T10:29:12Z[GIF] Tangents (Tangent lines to a Bessel function)
http://community.wolfram.com/groups/-/m/t/1105345
![Tangent lines to a Bessel function][1]
**Tangents**
This shows 900 tangent lines to the Bessel function $J_4$. The Bessel function itself is not explicitly shown at all, but, as in [_Bessel_][2], the graph of the function emerges quite clearly from the approximations.
One note: the GIF is made up out of 1801 frames, which seems to make the Javascript on the post preview page very unhappy, and the original file output by Mathematica was 275 MB(!). Using [gifsicle][3] to reduce the color palette and only record diffs between consecutive frames, I was able to get this down to 2.9 MB, or about 100 times smaller (and thereby actually reasonable to post online).
Here's the code, which makes use of one simple function that returns the tangent line to a function at a given point:
TangentLine[f_, x_] := InfiniteLine[{x, f[x]}, {1, f'[x]}];
DynamicModule[{f, b = N[BesselJZero[4, 6]], n = 450,
cols = RGBColor /@ {"#FF5200", "#003355"}},
f[x_] := BesselJ[4, x];
Manipulate[
Graphics[
{Opacity[.1], cols[[1]],
Table[TangentLine[f, x], {x, Max[-b, s - 2 b], Min[s, b], b/n}]},
PlotRange -> {{-b, b}, {-2, 2}}, AspectRatio -> 2/3,
ImageSize -> 540, Background -> cols[[-1]]],
{s, -b, 3 b}]
]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=lines9c.gif&userId=610054
[2]: http://community.wolfram.com/groups/-/m/t/1052218
[3]: http://lcdf.org/gifsicle/Clayton Shonkwiler2017-05-24T05:00:14ZAvoid parse error uploading to Wolfram Demonstration Project?
http://community.wolfram.com/groups/-/m/t/1105206
I'm trying to make my (first) Wolfram Demonstration Project but when I upload I get "Parse Error" and no other information. Had two fail in exactly the same way: "parse error" (the 2nd made specifically to try something "more typical"). Wolfram doesn't leave an email on the site of how to Contact them.
From the Mathematica 11 main frame/canvas menu I used "New->Demonstration". I used the website upload area, choose the file, and uploaded it. (at first i tried uploading as CDF, which also didn't work)
One is this easiy so I can't understand the error unless "Raster is not allowed"
Manipulate[Show[{rast1,rast2,...}[[x]]],{x,1,10}]
(I used Raster because the "real deal" is not allowed, i.e. would need compilation of a single C source file. But it is so simple I can't see how there would be a "parse error")
The other one is still a small matter: it makes a Package called Resistor`. It has just a very low key Module that has output of a MatrixForm number table and a color graphic (obviously depends on manipulation choices). I can't think of rule it might break.
I need help in either finding out which email at wolfram to use for Contact or better yet what causes "Parse error" or "more information about the upload failure. Any of the three is good. I don't want to call WR's main number for a demo because I assume that's "not part of Mathematica and a separate site". But maybe I should use contact features on the main WR site?John Hendrickson2017-05-23T22:06:38Z[✓] Control animations with FinishDynamic[]?
http://community.wolfram.com/groups/-/m/t/1103601
Here is a simple example of visualizing a 2d random walk. It is constructed to illustrate my question about FinishDynamic[]
I am also attempting set up controls for an interactive animation. I'd like a dynamic to update and use "stop" and "go" buttons.
Here are two functions that are used in the animation of a simple random walk:
Add a random step to a list of random steps:
updateRandomWalk[list_] :=
Append[list, Last[list] + RandomReal[{-0.5, 0.5}, {2}]]
Visualize the sequence of steps:
displayWalker[list_] := {Line[list], Disk[Last[list]]}
For example:
walkers = ConstantArray[{{0, 0}}, 100];
Do[walkers = updateRandomWalk /@ walkers;, {2000}];
Graphics[displayWalker /@ walkers, PlotRange -> 50 {{-1, 1}, {-1, 1}}]
Attempt to create an animation with a stop and go button. Notice that the FinishDynamic is being ignored--and that the animation stops even if the stop button is not activated.
DynamicModule[{walkers = ConstantArray[{{0, 0}}, 50], animate = False},
Column[
{
Row[{
Button["Go",
animate = True;
While[animate, walkers = updateRandomWalk /@ walkers;
FinishDynamic[];]
],
Button["Stop",
animate = False,
Method -> "Preemptive"
]
}
],
Dynamic[
Graphics[displayWalker /@ walkers,
PlotRange -> 50 {{-1, 1}, {-1, 1}}]
]
}
]
]
Thanks. Mathematica 11.1 on MacOs 10.12.4 (Sierra).W. Craig Carter2017-05-23T12:05:22ZDiffusion localised on the map of France
http://community.wolfram.com/groups/-/m/t/853228
I have this program to simulate diffusion on the map of France
ClearAll["Global`*"]
Needs["NDSolve`FEM`"]
carto = DiscretizeGraphics[CountryData["France", {"Polygon", "Mercator"}]]
![enter image description here][1]
bmesh = ToBoundaryMesh[carto, "MaxBoundaryCellMeasure" -> 25, AccuracyGoal -> 1];
mesh = ToElementMesh[bmesh, MaxCellMeasure -> 5, "MaxBoundaryCellMeasure" -> 25];
mesh["Wireframe"]
![enter image description here][2]
op = -Laplacian[u[x, y], {x, y}] - 20;
usol = NDSolveValue[{op == 1, DirichletCondition[u[x, y] == 0, True]},u, {x, y} \[Element] mesh];
Plot3D[usol[x, y], {x, y} \[Element] mesh, PlotTheme -> "Detailed",
ColorFunction -> "Rainbow", PlotPoints -> 50]
![enter image description here][3]
Show[ContourPlot[usol[x, y], {x, y} \[Element] mesh, ColorFunction -> "Temperature"], bmesh["Wireframe"]]
![enter image description here][4]
I obtained an image of the diffusion.
**But I want that the diffusion process is centered upon Paris. Do you have a solution ?**
Thanks! ~ André Dauphiné
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=sdf43rf3q4dfatggfd.svg&userId=11733
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=SADFYIUTR645YRTHFGD.svg&userId=11733
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=dfg435utyjhfgdDAfsa.png&userId=11733
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=sadf4wq5435430fd.png&userId=11733André Dauphiné2016-05-09T07:49:49ZGet FinancialData price history?
http://community.wolfram.com/groups/-/m/t/1097940
Since 16 may 2017, why am I not able to get the price history of US stock market tickers? Please see output below! Has anything changed?
In[9]:= FinancialData["GE", {{2017, 1, 3}, {2017, 5, 15}}]
Out[9]= Missing["NotAvailable"]
In[10]:= FinancialData["IBM", {{2017, 1, 3}, {2017, 5, 15}}]
Out[10]= Missing["NotAvailable"]sridev ramaswamy2017-05-18T12:09:48ZGenerating Name Generators
http://community.wolfram.com/groups/-/m/t/1103338
After reading the umpteenth online article describing how someone trained a neural net to make up band names, or write bizarre recipes, or generate Pokemon, I asked whether any of the ML functionality in the Wolfram Language could easily do this sort of thing. I was told to look at SequencePredict — and it turns out, with next to no knowledge of machine learning, and using some documentation examples as a springboard, I could get pretty decent results with *very* minimal code...
First, a short function to de-camelcase words, since in practice I noticed that the output strings would often be multiple words mashed together:
decamel[str_] :=
StringTrim[
StringJoin[
StringSplit[
str, {RegularExpression["([a-z])([A-Z])"] -> "$1 $2",
RegularExpression["([0-9])([A-Z])"] -> "$1 $2",
RegularExpression["([a-z])([0-9])"] -> "$1 $2"}]]]
Next, a function to produce a list of predictions of varying lengths, with the option of de-camelcasing output strings if needed:
predictionList[func_, num_, min_, max_, decam_: True] :=
If[decam == True,
decamel /@
Table[func["", "RandomNextElement" -> RandomInteger[{min, max}]], num],
Table[func["", "RandomNextElement" -> RandomInteger[{min, max}]], num]]
And then the code to actually produce SequencePredictorFunctions, working from a) the name of a built-in Wolfram Language entity type, b) a list of Entities, or c) a list of names (strings).
nameGenerator[domain_String, extractor_: "SegmentedWords"] :=
Block[{rand},
rand = CommonName[DeleteMissing[RandomEntity[domain, 500]]];
SequencePredict[rand, FeatureExtractor -> extractor]]
nameGenerator[entOrString_List, extractor_: "SegmentedWords"] :=
Block[{names},
With[{heads = DeleteDuplicates[Head /@ entOrString]},
Which[heads === {Entity},
names = CommonName[DeleteMissing[entOrString]];
SequencePredict[names, FeatureExtractor -> extractor],
heads === {String},
names = StringTrim /@ DeleteMissing[entOrString];
SequencePredict[names, FeatureExtractor -> extractor]]]]
And then...
In[50]:= bandSP =
nameGenerator[
EntityClass["MusicAct",
"Country" -> Entity["Country", "UnitedStates"]] // EntityList];
In[59]:= predictionList[bandSP, 10, 2, 6]
Out[59]= {"Spears Lou Miley", "Show Danity", "K\[Hyphen]Ci Morgan \
Reese Jobe", "Misty Orleans Dance Plug", "Widespread Whitey Eddy", \
"Yankovic G", "Nash Gyra", "", "Robert", "Spree Samantha Gene"}
Or aircraft...
In[72]:= planeSP = nameGenerator["Aircraft"];
In[73]:= predictionList[planeSP, 10, 3, 7]
Out[73]= {"Student R XP", "Miles Whitworth", "XP-F27 Raytheon", \
"Mitsubishi", "Robin -", "Ambrosini Eye C-XP", "Tupolev Chelidon", "-- \
Ju", "Apuzzo Ro.22 Savoia", ".VI -12"}
Or people...
In[60]:= frSP =
nameGenerator[
EntityClass["Person",
"BirthPlace" ->
Entity["City", {"Paris", "IleDeFrance", "France"}]] //
EntityList];
In[62]:= predictionList[frSP, 10, 3, 4]
Out[62]= {"Langelaan Armand", "Pascal George Jean\[Hyphen]Baptiste", \
"Enfant", "Vreeland Melissa M", "Hugh Kamara", "de Dux Barencey \
Joseph", "Paul Dufay", "Léon Roland", "Schiffman \
Saint\[Hyphen]Hilaire Alize", "Perec Louis"}
In[61]:= jpSP =
nameGenerator[
EntityClass["Person",
"BirthPlace" -> Entity["City", {"Tokyo", "Tokyo", "Japan"}]] //
EntityList];
In[63]:= predictionList[jpSP, 10, 3, 4]
Out[63]= {"Yohji Ikeda", "Fukuda", "Yasuda", "Shioda", "Sicheng \
Yukawa Kibayashi", ".Mitsuru", "Eri Mokomichi", "Michiko Hijiri Mc \
Donough Mizumaki", "Ikuo Kenji Oyama", "Shirahama Juhn"}
Or Pokemon names:
In[64]:= pokeSP =
nameGenerator[
StringDelete[EntityValue["Pokemon", "Name"],
RegularExpression[" \\(.+\\)"]], "SegmentedCharacters"];
In[67]:= Capitalize /@ predictionList[pokeSP, 10, 5, 10]
Out[67]= {"Arper", "Chummotark", "Chimedeowa", "Lex CT", "Enundude", \
"Tikip", "Uckitit", "Eirteaz", "Batenomogo", "Maryuffull"}
Suggestions for improvement are welcome...Alan Joyce2017-05-23T13:41:17Z