Community RSS Feed
https://community.wolfram.com
RSS Feed for Wolfram Community showing any discussions in tag Wolfram Scienceshowthread.php?threadid=956 sorted by activeTry to beat these MRB constant records!
https://community.wolfram.com/groups/-/m/t/366628
Map:
- First we have these record number of digits of the MRB constant
computations.
- Then we have some hints for anyone serious about breaking my record.
- Next, we have speed records.
- Then we have a program Richard Crandall wrote to check his code for computing record number of digits.
- Then there is a conversation about whether Mathematica uses the same algorithm for computing MRB by a couple of different methods.
- Then, for a few replies, we compute the MRB constant from Crandall's
eta derivative formulas and see records there.
- Then there are three replies about "NEW RECORD ATTEMPTS OF 4,000,000 DIGITS!" and the computation is now complete!!!!!.
- Finally, we see where I am on a 5,000,000 digits calculation.
POSTED BY: Marvin Ray Burns.
**MKB constant calculations,**
![enter image description here][1] ,
**have been moved to their own discussion at**
[Calculating the digits of the MKB constant][2].
I think the following important point got buried near the end.
When it comes to mine and a few other people's passion to calculate many digits of constants and the dislike possessed by a few more people, it is all a matter telling us that minds work differently!
The MRB constant is defined below. See http://mathworld.wolfram.com/MRBConstant.html.
$$\text{MRB}=\sum _{n=1}^{\infty } (-1)^n \left(n^{1/n}-1\right).$$
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 and then by using the sum feature to compute $\sum _{n=1}^{1000 } (-1)^n \left(n^{1/n}\right).$ 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[]
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 (probably processor time). That's on a 2.93 Ghz 8-core Nehalem. **It took until the use of DDR4 to compute nearly that many digits in an absolute time that quick!!: In Aug of 2018 I computed 1,004,993 digits of the MRB constant in 53.5 hours with 10 processor cores! Search this post for "53.5" for documentation. Sept 21, 2018, I just now computed 1,004,993 digits of the MRB constant in 50.37 hours of absolute time (35.4 hours processor time) with 18 processor cores!** Search this post for "50.37 hours" for documentation.**
26. Previously, 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 my six core Intel(R) Core(TM) i7-3930K CPU @ 3.20 GHz 3.20 GHz.
28. A previous world record computation of the MRB constant was finished on Sun 21 Sep 2014 18:35:06. It took 1 month 27 days 2 hours 45 minutes 15 seconds.The processor time from the 3,000,000+ digit computation was 22 days. I computed the 3,014,991 digits of the MRB constant with Mathematica 10.0. I Used my new version of Richard Crandall's code in the attached 3M.nb, 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 to check the first several digits of this computation. See attached 3M.nb for the full code and digits.
29. Finished on Wed 16 Jan 2019 19:55:20, I computed over 4 million digits of the MRB constant.
It took 4 years of continuous tries. This successful run took 65.13 days computation time, with a processor time of 25.17 days, on a 3.7 GH overclocked up to 4.7 GH on all cores Intel 6 core computer with 3000 MHz RAM. According to this computation, the previous record, 3,000,000+ digit computation, was accurate to 3,014,871 decimals, as this computation used my own algorithm for computing n^(1/n) as found at chapter 3 in the paper at
https://www.sciencedirect.com/science/article/pii/0898122189900242
and the 3 million+ computation used Crandall's algorithm. Both algorithms outperform Newton's method per calculation and iteration.
See attached [notebook][3].
M R Burns' algorithm:
x = SetPrecision[x, pr];
y = x^n; z = (n - y)/y;
t = 2 n - 1; t2 = t^2;
x =
x*(1 + SetPrecision[4.5, pr] (n - 1)/t2 + (n + 1) z/(2 n t) -
SetPrecision[13.5, pr] n (n - 1) 1/(3 n t2 + t^3 z));
(*N[Exp[Log[n]/n],pr]*)
Example:
ClearSystemCache[]; n = 123456789;
(*n is the n in n^(1/n)*)
x = N[n^(1/n),100];
(*x starts out as a relatively small precision approximation to n^(1/n)*)
pc = Precision[x]; pr = 10000000;
(*pr is the desired presicion of your n^(1/n)*)
Print[t0 = Timing[While[pc < pr, pc = Min[4 pc, pr];
x = SetPrecision[x, pc];
y = x^n; z = (n - y)/y;
t = 2 n - 1; t2 = t^2;
x = x*(1 + SetPrecision[4.5, pc] (n - 1)/t2 + (n + 1) z/(2 n t)
- SetPrecision[13.5, pc] n (n - 1)/(3 n t2 + t^3 z))];
(*You get a much faster version of N[n^(1/n),pr]*)
N[n - x^n, 10]](*The error*)];
ClearSystemCache[]; n = 123456789; Print[t1 = Timing[N[n - N[n^(1/n), pr]^n, 10]]]
Gives
{25.5469,0.*10^-9999984}
{101.359,0.*10^-9999984}
R Crandall's algorithm:
While[pc < pr, pc = Min[3 pc, pr];
x = SetPrecision[x, pc];
y = x^n - n;
x = x (1 - 2 y/((n + 1) y + 2 n n));];
(*N[Exp[Log[n]/ n],pr]*)
Example:
ClearSystemCache[]; n = 123456789;
(*n is the n in n^(1/n)*)
x = N[n^(1/n)];
(*x starts out as a machine precision approximation to n^(1/n)*)
pc = Precision[x]; pr = 10000000;
(*pr is the desired presicion of your n^(1/n)*)
Print[t0 = Timing[While[pc < pr, pc = Min[3 pc, pr];
x = SetPrecision[x, pc];
y = x^n - n;
x = x (1 - 2 y/((n + 1) y + 2 n n));];
(*N[Exp[Log[n]/n],pr]*)
N[n - x^n, 10]](* The error*)]; Print[
t1 = Timing[N[n - N[n^(1/n), pr]^n, 10]]]
Gives
{32.1406,0.*10^-9999984}
{104.516,0.*10^-9999984}
More information available upon request.
Here is my mini cluster of the fastest 3 computers mentioned below:
The one to the left is my custom built extreme edition 6 core and later with a 8 core Xeon processor.
The one in the center is my fast little 4 core Asus with 2400 MHz RAM.
Then the one on the right is my fastest -- a Digital Storm 6 core overclocked to 4.7 GHz on all cores and with 3000 MHz RAM.
![enter image description here][4]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=5860Capturemkb.JPG&userId=366611
[2]: http://community.wolfram.com/groups/-/m/t/1323951?p_p_auth=W3TxvEwH
[3]: https://community.wolfram.com/groups?p_auth=zWk1Qjoj&p_p_auth=r1gPncLu&p_p_id=19&p_p_lifecycle=1&p_p_state=exclusive&p_p_mode=view&p_p_col_id=column-1&p_p_col_count=6&_19_struts_action=/message_boards/get_message_attachment&_19_messageId=1593151&_19_attachment=4%20million%2011%202018.nb
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ezgif.com-video-to-gif.gif&userId=366611Marvin Ray Burns2014-10-09T18:08:49ZThe Chaos Game - part II
https://community.wolfram.com/groups/-/m/t/1039030
![enter image description here][1]
A couple of weeks ago I posted my first [The Chaos Game post][2]. This will be a continuation on that, exploring some new ideas. Please make sure to read [the previous one first][3]. And once you're finished with this post, read the continuation [part III][4].
## Colors ##
The first thing I wanted to try after my previous post was coloring. Let's color each of the points based on the point it jumps towards to:
ClearAll[sequence]
sequence[n_,m_]:=RandomChoice[Range[n],m]
Table[
circlepoints=N@CirclePoints[n];
seq=sequence[n,50000];
pts=Rest[FoldList[(#1+circlepoints[[#2]])/2&,RandomChoice[circlepoints],seq]];
plotdata=Transpose[{pts,seq}];
plotdata=SortBy[GatherBy[plotdata,Last],#[[1,2]]&];
plotdata=plotdata[[All,All,1]];
colors=ColorData[97]/@Range[n];
Rasterize[Graphics[{PointSize[0.001],Riffle[colors,Point/@plotdata],FaceForm[],EdgeForm[Black],RegularPolygon[n],PointSize[0.01],Riffle[colors,Point/@circlepoints]},ImageSize->{400,400},PlotRange->1.1],"Image",ImageSize->{400,400},RasterSize->{400,400}]
,
{n,3,8}
] // Partition[#,3]& // ImageAssemble
![enter image description here][5]
This explains why the regular triangle and the square have such an unique behavior; it does not 'blend'. To be more precise: the triangle only excludes spaces, and the square exactly covers the plane again. For higher order regular polygons you see that there is overlap and that creates high and low density regions creating a bunch of patterns.
For the case of restricted jumping, like we did last time, we can also do the coloring, here the modified code:
ClearAll[CreateSequence,CreateSequenceImage]
CreateSequence[n_,steps_,choices_]:=Mod[Accumulate[RandomChoice[choices,steps-1]~Prepend~1],n,1]
CreateSequenceImage[n_,m_,choices_]:=Module[{seq,circlepoints,pts,plotdata,colors},
seq=CreateSequence[n,m,choices];
circlepoints=N@CirclePoints[n];
pts=Rest@FoldList[(#1+circlepoints[[#2]])/2&,First[circlepoints],seq];
plotdata=Transpose[{pts,seq}];
plotdata=SortBy[GatherBy[plotdata,Last],#[[1,2]]&];
plotdata=plotdata[[All,All,1]];
colors=ColorData[97]/@Range[n];
Rasterize[Graphics[{FaceForm[],EdgeForm[Black],RegularPolygon[n],PointSize[0.001],Riffle[colors,Point/@plotdata],PointSize[0.03],Riffle[colors,Point/@circlepoints]},ImageSize->300,PlotRange->1.1],"Image",RasterSize->{300,300}]
]
Let's have a look at all the possible jumping-subsets for hexagons:
Grid[Join @@@
Partition[{#, CreateSequenceImage[6, 10^4, #]} & /@
Subsets[Range[6], {1, \[Infinity]}], UpTo[4]], Frame -> All]
![enter image description here][6]
Some really nice patterns are now created!
## Fractional jumping ##
Up to now we have always jumped half-way, let's change that, and see what happens. I will introduce alpha the factor that we jump. Historically we always have set that to 0.5 (half-way). In my definition 0 means not moving, and 1 going all the way to the next point. The code can be easily modified:
ClearAll[sequence]
sequence[n_,m_]:=RandomChoice[Range[n],m]
FactorJump[n_,m_,\[Alpha]_]:=Module[{circlepoints,seq,pts,counts,img,bg},
circlepoints=N@CirclePoints[n];
seq=sequence[n,m];
pts=FoldList[(1-\[Alpha])#1+\[Alpha] circlepoints[[#2]]&,First[circlepoints],seq];
counts=Transpose@BinCounts[pts,{-1.1,1.1,0.005},{-1.1,1.1,0.005}];
counts=Reverse[counts];
img=Image[1-counts/Max[counts]];
bg=Graphics[Graphics[{FaceForm[],EdgeForm[Black],RegularPolygon[n],Text[NumberForm[\[Alpha],{\[Infinity],2}],{0,1.05}]},ImageSize->500,PlotRange->1.1]];
bg=Rasterize[bg,"Image",RasterSize->ImageDimensions[img],ImageSize->ImageDimensions[img]];
ImageMultiply[img,bg]
]
Note that I also included the plotting of the density of the points using **BinCounts**, which gives smooth images. Let's try it out with some new alpha:
FactorJump[3, 10^7, 0.3]
![enter image description here][7]
pretty nifty! Let's make a movie changing alpha gradually from 0 to 1:
n = 3;
imgs = Table[FactorJump[n, 3 10^5, \[Alpha]], {\[Alpha], 0, 1, 0.01}];
Export[ToString[n] <> "factor.gif", imgs, "DisplayDurations" -> 1/25.0]
![enter image description here][8]
Now for squares:
![enter image description here][9]
pentagons:
![enter image description here][10]
Of course we are not limited by our range 0 to 1, we can go beyond. (negative alpha means you run away, quickly going outside the screen, so that is not a good idea). Here for pentagons, and for alpha up to 1.8:
![enter image description here][11]
## Distance jumping ##
Rather than jumping a certain fraction, let's jump a specific distance in the direction of our point. Again we modify the code quite easily:
ClearAll[sequence,DistanceJump]
sequence[n_,m_]:=RandomChoice[Range[n],m]
DistanceJump[n_,m_,d_]:=Module[{circlepoints,seq,pts,counts,img,bg,reg,size},
circlepoints=N@CirclePoints[n];
seq=sequence[n,m];
pts=FoldList[#1+d Normalize[circlepoints[[#2]]-#1]&,First[circlepoints],seq];
size=3;
counts=Transpose@BinCounts[pts,{-size,size,size/250.0},{-size,size,size/250.0}];
counts=Reverse[counts];
reg=Quantile[Join@@counts,0.999];
img=Image[1- counts/reg];
bg=Graphics[Graphics[{FaceForm[],EdgeForm[Black],RegularPolygon[n],Text[NumberForm[d,{\[Infinity],2}],{0,-1.05}]},ImageSize->500,PlotRange->size]];
bg=Rasterize[bg,"Image",RasterSize->ImageDimensions[img],ImageSize->ImageDimensions[img]];
ImageMultiply[img,bg]
]
Let's try it out:
DistanceJump[5, 10^6, 0.5]
![enter image description here][12]
again we see patterns emerge; let's again make a movie varying the distance d:
j=0;
Dynamic[j]
n=3;
CloseKernels[];
LaunchKernels[4];
DistributeDefinitions[DistanceJump,n]
SetSharedVariable[j];
imgs=ParallelTable[j++;DistanceJump[n,10^6,d],{d,0.1,3,0.01}];
Export[ToString[n]<>"distance.gif",imgs,"DisplayDurations"->1/25.0]
![enter image description here][13]
and for a pentagon:
![enter image description here][14]
Really nice visualization with very complicated patterns emerging from the very simple equations! Hope you enjoyed this little exploration.
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=26415distance.gif&userId=73716
[2]: http://community.wolfram.com/groups/-/m/t/1025180
[3]: http://community.wolfram.com/groups/-/m/t/1025180
[4]: http://community.wolfram.com/groups/-/m/t/1047603
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=colored.png&userId=73716
[6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=6subsetcolored.png.png&userId=73716
[7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=factorjumptest1.png&userId=73716
[8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=13373factor.gif&userId=73716
[9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=93424factor.gif&userId=73716
[10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=102355factor.gif&userId=73716
[11]: http://community.wolfram.com//c/portal/getImageAttachment?filename=107365Largefactor.gif&userId=73716
[12]: http://community.wolfram.com//c/portal/getImageAttachment?filename=distancejumptest1.png&userId=73716
[13]: http://community.wolfram.com//c/portal/getImageAttachment?filename=68463distance.gif&userId=73716
[14]: http://community.wolfram.com//c/portal/getImageAttachment?filename=26415distance.gif&userId=73716Sander Huisman2017-03-24T23:06:24ZCreateWindows and FullScreen
https://community.wolfram.com/groups/-/m/t/1639802
I am trying to output a graphic from a function. The display on a second remote monitor at full screen. That means that I do not want to see the scroll, or the control menus in top.
The function states that it does equivalent to F12. But it does not output anything.
CreateWindow[
SphericalPlot3D[
1 + 2 Cos[2 \[Theta]], {\[Theta], 0, Pi}, {\[Phi], 0, 2 Pi}],
Background -> RGBColor[1, .9, .7], Window[2] -> FullScreenArea]Jose Calderon2019-03-25T04:15:07ZRepresentation of symmetric group
https://community.wolfram.com/groups/-/m/t/1637345
I can't seem to find any information/algorithms on generating matrix representations of the symmetric group. Can someone point me in the right direction?John Garrison2019-03-22T05:31:30ZPermute command on symmetric vs alternating groups
https://community.wolfram.com/groups/-/m/t/1637855
Why does this happen?
Permute[{0,0,0}, SymmetricGroup[3]]
{{0,0,0}}
Permute[{0,0,0}, AlternatingGroup[3]]
{{0,0,0}, {0,0,0}, {0,0,0}}Michael Jennings2019-03-22T20:09:50ZGet symbolic expressions for summing sequences?
https://community.wolfram.com/groups/-/m/t/1636014
Hello!
Let's say that I am having this sequence:
a(n) = 2*a(n-1) - a(n-2) + 2*a(n-3) + a(n-4) + a(n-5) - a(n-7) - a(n-8)
with a[1] == 1, a[2] == 1, a[3] == 1, a[4] == 2, a[5] == 6, a[6] == 14, a[7] == 28, a[8] == 56 as the base cases.
Now, I want to find the sum of a(1)^3 + a(2)^3 + .... + a(n)^3 SYMBOLICALLY, with respect to the first 8 base cases. There will be of course some cross terms ie. a(1)*a(2), etc, but it should be in terms of only the first 8 base cases.
I can use the RecurrenceTable and Total for finding numbers, but how can I do it symbolically and also simplify it to only the first 8 base cases?
Thank you very much in advance.Thanos Papas2019-03-19T15:37:21ZHow can I get full-range plotting with ParametricPlot?
https://community.wolfram.com/groups/-/m/t/1639076
A puzzle with ParametricPlot. The first plot masks part of the range, but nevertheless plots test points in the masked area. Can I get rid of the mask? The second plot shows no mask(s), but I don't know why it works. Can I get an informed comment? Thanks for your time,
Whiffee Bollenbach
d2 = ImplicitRegion[
0 <= x < \[Infinity] \[And] -\[Infinity] < y < \[Infinity], {x, y}];
p2 = ParametricPlot[
Through[{Re, Im}[(x + I y)^0.5]], {x, y} \[Element] d2,
PlotRange -> {{-1, 3.5}, {-3, 3}}, Frame -> True, ImageSize -> 200,
AspectRatio -> Automatic,
Epilog -> {{Blue, PointSize[0.025],
Point[{Re[(x + I y)^0.5] /. {x -> 0, y -> -10},
Im[(x + I y)^0.5] /. {x -> 0, y -> -10}}]}, {Red,
PointSize[0.025],
Point[{Re[(x + I y)^0.5] /. {x -> 0, y -> -1},
Im[(x + I y)^0.5] /. {x -> 0, y -> -1}}]}, {Black,
PointSize[0.025],
Point[{Re[(x + I y)^0.5] /. {x -> 0, y -> 1},
Im[(x + I y)^0.5] /. {x -> 0, y -> 1}}]}}];
p3 = ParametricPlot[
Through[{Re, Im}[x + (I y)^3.5]], {x, y} \[Element] d2,
PlotRange -> {{-1, 3.5}, {-3, 3}}, Frame -> True, ImageSize -> 200,
AspectRatio -> Automatic,
Epilog -> {{Blue, PointSize[0.025],
Point[{Re[(x + I y)^0.5] /. {x -> 0, y -> -10},
Im[(x + I y)^0.5] /. {x -> 0, y -> -10}}]}, {Red,
PointSize[0.025],
Point[{Re[(x + I y)^0.5] /. {x -> 0, y -> -1},
Im[(x + I y)^0.5] /. {x -> 0, y -> -1}}]}, {Black,
PointSize[0.025],
Point[{Re[(x + I y)^0.5] /. {x -> 0, y -> 1},
Im[(x + I y)^0.5] /. {x -> 0, y -> 1}}]}}];
Row[{p2, p3}]Whiffee Bollenbach2019-03-24T21:26:59Z[GIF] Symmetric Minimality (symmetric lattice trefoil knot)
https://community.wolfram.com/groups/-/m/t/1639178
![Symmetric lattice trefoil knot][1]
**Symmetric Minimality**
After I posted [_Minimal_][5] on [Mathstodon][2], [David Eppstein asked about][3] and then [found][4] a minimal lattice trefoil with 3-hedral symmetry.
Here are the (mean-centered) vertices:
symmetrictrefoil = # - Table[Mean[#], {Length[#]}] &[{{0, 0, 0},
{1, 0, 0}, {2, 0, 0}, {2, 0, 1}, {2, 1, 1}, {2, 2, 1}, {1, 2, 1},
{0, 2, 1}, {-1, 2, 1}, {-1, 2, 0}, {-1, 2, -1}, {-1, 1, -1},
{0, 1, -1}, {1, 1, -1}, {1, 1, 0}, {1, 1, 1}, {1, 1, 2},
{1, 2, 2}, {1, 3, 2}, {0, 3, 2}, {0, 3, 1}, {0, 3, 0}, {0, 2, 0}, {0, 1, 0}}];
The animation demonstrates the 3-fold symmetry which is lacking from the relatively asymmetric minimal trefoil from [_Minimal_][5] (which was just the one built into [KnotPlot][6]).
smootheststep[t_] := -20 t^7 + 70 t^6 - 84 t^5 + 35 t^4;
DynamicModule[{p = {-1, 0, 0}, q = Normalize[{0, 1, 1}], a, b, n, M, pl, θ,
cols = RGBColor /@ {"#404b69", "#f73859", "#283149"}},
Manipulate[
θ = 2 π/3 smootheststep[t];
{n, b} = RotationMatrix[θ, {-1, -1, 1}].# & /@ {p, q};
a = Cross[b, n];
M = {a, b};
pl = M.# & /@ symmetrictrefoil;
Graphics[{
Thickness[.0052], cols[[1]], Line[Append[#, First[#]] &[pl]],
cols[[2]], Disk[M.#, .05] & /@ Sort[symmetrictrefoil, n.#1 > n.#2 &]},
ImageSize -> 540, PlotRange -> {{-2.75, 2.75}, {-2.5, 3}},
Background -> cols[[-1]]],
{t, 0, 1}]
]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=lt20q.gif&userId=610054
[2]: https://mathstodon.xyz
[3]: https://mathstodon.xyz/@11011110/101768975543746276
[4]: https://mathstodon.xyz/@11011110/101770193254542093
[5]: https://community.wolfram.com/groups/-/m/t/1634541
[6]: https://knotplot.comClayton Shonkwiler2019-03-24T20:43:19ZMathematica speedup from 2019 iMac over late 2015 iMac?
https://community.wolfram.com/groups/-/m/t/1639163
My current computer, a late 2015 iMac 27” has a 4 GHz Core i7 processor, 32 GB RAM, 3 TB Fusion drive, and Radeon R9 M395X with 4 GB VRAM, Retina display.
What kind of speedup with Mathematica, if any, might I expect from a new, 2019, iMac 27” with the following configuration?
- 3.6 GHz Core i9 processor (8-core)
- 64GB RAM
- 3 TB Fusion drive
- Radeon Pro Vega 48 with 8GB HBM2 memory
Although this new CPU has Turbo Boost up to 5 GHz, I’m concerned that the “default” of only 3.6 GHZ, being below my current 4 GHz, might impede perfornance.
Presumably the graphics rendering will be faster, right?
Or do the additional cores make up for that difference? In fact, can Mathematica take advantage of those additional cores (without my explicitly coding for parallel kernels)?Murray Eisenberg2019-03-24T16:24:32ZWhy is system of equations (6 variables) yielding a non-nonsensical answer?
https://community.wolfram.com/groups/-/m/t/1638692
Hello,
I am new to Mathematica, and I just downloaded it tonight. I need to do a very specific procedure: calculate a complicated system of equations in 6 variables. I have tried for hours on end to do this, following the instructions as they are listed in Mathematica: "In a system of equations with multiple variables, you can solve for some or all of the variables by using a list in the second argument." I have done so, but my answer is given as one number, which makes no sense. My work is given below.
Solve[{44826600000*a+406601000000*b+
134691918588*c+656526*f+512206908*e+170700546*d-7642032.5==0,3757520000000*b
+406601000000*a+1233170000000*c+5925820*f+4678814294*e+
1544327542*d-69097900==0, 406601000000*c+134692000000*a+
1233170000000*b+1967580*f+1544327592*e+512206908*d -22936700==0,
170700546*a+1544327592*b+512206908*c+2550*f+1967580*e+656526*d-29327.5==0,
512206908*a+4678814150*b+1544327592*c+7634*f+5925818*e+1967580*d-87833==0,
10*f+656526*a+5925820*b+1967580*c+7634*e+2550*d-113.5==0},
{a,b,c,d,e,f}]
Answer: 4.06601 x 10^11.
What is this answer??? I should be getting a different value for a, b, c, d, e, and f, not a single number. Can someone please help me and tell me what exactly I am doing wrong?
Thanks!Quentin Moliterno2019-03-24T02:43:24ZIs GraphDistance (and other graph analysis functions) compiled in 32bits?
https://community.wolfram.com/groups/-/m/t/1637570
Hi.
I have a Windows 10 PC with 32GB RAM and currently use Mathematica 11.3
I tried to obtain the GraphDistance between two nodes in a 500,000 node 600,000 vertex graph and Mathematica crashed without warning (all the fonts went from blue or black to dark purple, like when you exit the kernel).
I thought that it was because my computer ran out of memory but I repeated the process with the Task Manager open and Mathematica never used more than 2GB RAM.
Is it possible that GraphDistance is compiled in 32bits and this is the reason it crashes once it reaches 2GB?
Related question: is there a way to obtain my GraphDistance in Mathematica for such a large network? It is kind of a trivial network in C++.
Thanks!
FernandoFernando Perez2019-03-22T16:01:52ZMathematica: Solving for expression
https://community.wolfram.com/groups/-/m/t/1638221
This may be a dumb question, but I often need to solve expressions for something other than a variable. As a trivial example, say we have a common-emitter amplifier:
Vout = Vsupply - (Vin - Vbe)((hfe + 1)/hfe) * RC/RE
And I want to solve it for the DC transfer function Vout/Vin. Can Mathematica do this, at all?
Now, I understand there is actually no solution here, but a small change makes it solvable (and still easy to reason around):
Vout = - (Vin - Vbe)((hfe + 1)/hfe)*RC/RE
Now, this simple example I can solve easily. But there are complex expression created in cascades of stages and ladders that get a bit more complex in hurry... But even being to solve the simple problems would be nice as a "calculator" function. I can calculate square roots and look up logarithms in tables myself also, but I sure prefer to work with a calculator.
Any ideas? Maybe I just missed something obvious?Jan Brittenson2019-03-23T05:18:07ZImport large data files for Machine Learning?
https://community.wolfram.com/groups/-/m/t/1599142
I want to run a machine learning task on my Win 10 PC, 16GB RAM, Mathematica 11.3.0, but I am facing the following problems: training set size 10GB CSV file, with 700,000,000 x 2 datasets. Mathematica simply stops during import via Import or ReadList function. My idea is to split the input file into several smaller files that could be imported and to load the smaller files in a batch to feed the Predict function or perhabs a neural network. Any idea how to make it happen? Do you have a better idea?
Many thanks in advance for support!Jürgen Kanz2019-01-26T11:41:17ZHow do I create a loop of these lines of code?
https://community.wolfram.com/groups/-/m/t/1637113
Hello Community,
I have a question about how to create a loop made with this code and expressions as follows:
dig = 100;
a = IntegerDigits[1234567890];
b = FromDigits[RandomSample[a]];
c = If[b > 10^9, b, FromDigits[RandomSample[a]]];
d = If[c > 10^9, c, FromDigits[RandomSample[a]]];
e = If[d > 10^9, d, FromDigits[RandomSample[a]]];
f = If[e > 10^9, e, FromDigits[RandomSample[a]]];
g = If[f > 10^9, f, FromDigits[RandomSample[a]]];
h = If[g > 10^9, g, FromDigits[RandomSample[a]]];
m = IntegerPart[h/9999999999*10^dig];
G = FromDigits[RandomSample[IntegerDigits[m]]];
aa = If[G > 10^(dig - 1), G,
FromDigits[RandomSample[IntegerDigits[m]]]];
bb = If[aa > 10^(dig - 1), aa,
FromDigits[RandomSample[IntegerDigits[m]]]];
cc = If[bb > 10^(dig - 1), bb,
FromDigits[RandomSample[IntegerDigits[m]]]];
dd = If[cc > 10^(dig - 1), cc,
FromDigits[RandomSample[IntegerDigits[m]]]];
ee = If[dd > 10^(dig - 1), dd,
FromDigits[RandomSample[IntegerDigits[m]]]];
ff = If[ee > 10^(dig - 1), ee,
FromDigits[RandomSample[IntegerDigits[m]]]];
gg = If[ff > 10^(dig - 1), ff,
FromDigits[RandomSample[IntegerDigits[m]]]];
P = If[gg > 10^(dig - 1), gg,
FromDigits[RandomSample[IntegerDigits[m]]]];
z = StringPartition[ToString[P], 2];
zz = StringCount[
z, {"11", "22", "33", "44", "55", "66", "77", "88", "99", "00"}];
s = StringPartition[StringDrop[ToString[P], 1], 2];
ss = StringCount[
s, {"11", "22", "33", "44", "55", "66", "77", "88", "99", "00"}];
k = N[2*(Count[zz, 1] + Count[ss, 1])/dig, 4]
V = If[k < 0.16, P, "xx"]
The question is this:
When the conditions in line *V* are satisfied for *k* the result of *P* must be shown (only with one result, the first that meets the condition) and when conditions are not satisfied, instead of *"xx"* I want the program to return to expressions from line *G* onwards until the condition in *V* is fulfilled. In a way every time I evaluate this entire code the condition will be fulfilled.
How do I do that? ... I tried everything I know but I do not understand how to do this ... can anyone give me an example that I can apply in this situation or even use my lines of code to solve this doubt of mine?
Thanks a lot for the help.Claudio Chaib2019-03-21T18:57:02ZPlotting two graphs together and doing manipulation
https://community.wolfram.com/groups/-/m/t/1637789
I need help in plotting two graphs together and doing some sort of manipulation.
I have a sequence:
A=ListPlot[List, PlotRange -> {{0, 201}, {-0.01, 0.01}}], where List=Table[a[n], {n, 200}] and a[n_]=(-1)^n/n^2
And I need two parallel lines which can be manipulated, so I have written sth like that, but I am not sure if it is correct:
B[z_] = Plot[{z,-z}, {x, 0, 200}, Filling -> {1 -> {2}}]
And I have written such a command to plot A and B and to be able to change values of 'z':
Manipulate[Show[A, B], {z, 0.000001, 0.02}]
But unfortunately, it doesn't work. It drew only a Listplot and skipped B.
Where did I make a mistake?Kamil Sokołowski2019-03-22T20:50:22ZSolve a system of Differential Equations with EigenSystem DSolve MatrixExp?
https://community.wolfram.com/groups/-/m/t/1632964
In calculating a system of differential equations, I used 3 different methods: EigenSystem, DSolve and MatrixExp. DSolve and MatrixExp porduced the same answers but a different answers than EigenSystem and I don't understand why (See Attached). In all three cases, I used a default value of {1,1} for the values of the arbitrary constants. It appears that DSolve and MatrixExp simply dropped the negative exponent.
I don't understand what I am overlooking.
Thanks,
Mitch SandlinMitchell Sandlin2019-03-15T16:41:44ZHow to export all variables of a notebook in a text file?
https://community.wolfram.com/groups/-/m/t/1637561
Hi, I would like to export all variables of a notebook in a text file, in two columns: name of variables and variable value. For instance,let's consider the notebook:
In[1]:= a = 20
b = 3
c = 10
Out[1]= 20
Out[2]= 3
Out[3]= 10
The file, let's name it "output.txt" should be as follows:
a = 20
b = 3
c = 10
Thank you in advance.Andrea Mastellone2019-03-22T15:21:57ZCalculate this integral with NIntegrate?
https://community.wolfram.com/groups/-/m/t/1635118
Hi,
This integral seems to have a singularity..
all constants are defined.
NIntegrate[Exp[-alpha*Sqrt[(R^2 - 2*x*R*Cos[theta] + (x)^2) + z^2]], {z, 10*-a,
10*(L - a)}, {theta, 0, 2 Pi}]
I get a NIntegrate::slwcon warning.Haress Nazary2019-03-18T14:54:19ZDivergent response of a LTI system
https://community.wolfram.com/groups/-/m/t/1637180
Good morning,
I have a mathematical question related to a particular transfer function.
Let's say I have an LC transfer function (if you don't know anything about electronics it doesn't matter, it's just mathematics):
1/(1 + s^2 L C) with L and C > 0.
It has two complex conjugate poles at j/Sqrt[LC]. This means that for the real frequency 1/Sqrt[LC] at input the system will respond with a divergent sinusoid at that frequency.
My question is: what type of system is this? In my opinion it is linear time invariant since I could apply the Laplace transformation on it. Still the fact that the output diverges buzzes me. How can this divergence be explained with a better insight?Ermanno Citraro2019-03-22T05:53:39ZRaspberryPi 3 Model B+ and I2C issue
https://community.wolfram.com/groups/-/m/t/1431827
Hello,
I have been struggling with SenseHAT and Mathematica. First Mathematica was not able to find SenseHAT at all even than I followed I2C setup guide but eventually after adding following line to /boot/config.txt I was able to make some progress:
dtparam=i2c0=on
After that there is two i2c buses in the system:
pi@raspberrypi:~ $ ls -l /dev/i2c-*
crw-rw---- 1 root i2c 89, 0 Aug 30 21:34 /dev/i2c-0
crw-rw---- 1 root i2c 89, 1 Aug 30 21:34 /dev/i2c-1
However Mathematica reports variety I2C errors:
pi@raspberrypi:~ $ wolfram
Wolfram Language 11.3.0 Engine for Linux ARM (32-bit)
Copyright 1988-2018 Wolfram Research, Inc.
In[1]:= sensehat = DeviceOpen["SenseHAT"]
Out[1]= DeviceObject[{SenseHAT, 1}]
In[2]:= DeviceRead[sensehat, "Temperature"]
DeviceWrite::unknownMRAAWriteError: An unknown error occured writing to the I2C bus.
DeviceWrite::unknownMRAAWriteError: An unknown error occured writing to the I2C bus.
DeviceWrite::unknownMRAAWriteError: An unknown error occured writing to the I2C bus.
General::stop: Further output of DeviceWrite::unknownMRAAWriteError
will be suppressed during this calculation.
Out[2]= 42.4979 degrees Celsius
when investigating further linux journal it seems that libmraa (presumably of Mathematica MRAALink) tries to use I2C-0 bus:
Aug 30 21:38:05 raspberrypi libmraa[1037]: libmraa version v1.6.1 initialised by user 'pi' with EUID 100
Aug 30 21:38:05 raspberrypi libmraa[1037]: libmraa initialised for platform 'Raspberry Pi Model B Rev 1'
Aug 30 21:38:05 raspberrypi libmraa[1037]: i2c_init: Selected bus 0
Aug 30 21:38:22 raspberrypi libmraa[1037]: i2c0: write: Access error: Remote I/O error
Aug 30 21:38:22 raspberrypi libmraa[1037]: i2c0: write: Access error: Remote I/O error
However as far as I can tell the SenseHAT is in i2c bus 1. So I removed "dtparam=i2c0=on" and after reboot added symbolic link for i2c-0 from i2c-1:
pi@raspberrypi:/ $ ls -la /dev/i2c-*
lrwxrwxrwx 1 root root 10 Aug 30 21:43 /dev/i2c-0 -> /dev/i2c-1
crw-rw---- 1 root i2c 89, 1 Aug 30 21:41 /dev/i2c-1
and tried again SenseHAT in Mathematica which seems to work now:
pi@raspberrypi:/ $ wolfram
Wolfram Language 11.3.0 Engine for Linux ARM (32-bit)
Copyright 1988-2018 Wolfram Research, Inc.
In[1]:= sensehat = DeviceOpen["SenseHAT"]
Out[1]= DeviceObject[{SenseHAT, 1}]
In[2]:= DeviceRead[sensehat, "Temperature"]
Out[2]= 38.9896 degrees Celsius
So for me it looks that Matkematica uses wrong I2C bus at least in this particular model:
pi@raspberrypi:/dev $ cat /proc/device-tree/model
Raspberry Pi 3 Model B Plus Rev 1.3
pi@raspberrypi:/ $ cat /etc/os-release
PRETTY_NAME="Raspbian GNU/Linux 9 (stretch)"
NAME="Raspbian GNU/Linux"
VERSION_ID="9"
VERSION="9 (stretch)"
ID=raspbian
ID_LIKE=debian
HOME_URL="http://www.raspbian.org/"
SUPPORT_URL="http://www.raspbian.org/RaspbianForums"
BUG_REPORT_URL="http://www.raspbian.org/RaspbianBugs"
I think this should be fixed to Mathematica.Teemu Ahola2018-08-30T18:49:14ZOpen links from cloud notebook in the same tab
https://community.wolfram.com/groups/-/m/t/1636977
[@Jan Poeschko][at0] gave a talk at WTC 2018 on [developing a blog in the Wolfram Cloud using notebooks][1]. In the presentation he's able to navigate between different pages (notebooks) without leaving the tab.
I've deployed his same code but every time I click a link it opens a new tab. Can someone tell me if this is a browser setting, Wolfram Cloud setting, or notebook/deployment expression?
Thanks,
Eric
[1]: https://youtu.be/m5dxZ6OKrC4
[at0]: https://community.wolfram.com/web/jpoeschkoEric Smith2019-03-21T19:14:20ZCoding challenge: Unfold a nested association
https://community.wolfram.com/groups/-/m/t/1636998
I'm embarrassed by my code because there has to be a better way to do it. Here's a hierarchical list of lab tests `Category` --> `Class` --> `Test` --> `Status`
<|"Asphaltene" -> <|"Flocculation Point Apparatus" -> <|"FPA" ->
"Not started"|>,
"Miscellaneous Asphaltenes" -> <|"Asphaltene Content (Heptane \
Insolubles)" -> "Not started"|>|>,
"General Characterization" -> <|"Chemical Stability" -> <|"Long Term \
HT Stability" -> "Not started",
"Long Term Low Temp Stability" -> "Not started"|>,
"Pour Point" -> <|"Pour Point" -> "Not started"|>|>|>
I want to turn it into this:
Asphaltene - Flocculation Point Apparatus - FPA
Asphaltene - Miscellaneous Asphaltenes - Asphaltene Content (Heptane Insolubles)
General Characterization - Chemical Stability - Long Term HT Stability
General Characterization - Chemical Stability - Long Term Low Temp Stability
General Characterization - Pour Point - Pour Point
There has to be a shortcut I'm not thinking of so consider this a fun coding challenge to write the shortest form of the following function:
(*A function to unfold an association*)
unfoldAssociation[association_] :=
KeyValueMap[With[{key = #1, val = #2},
If[
ListQ[val],
Function[v, <|key -> v|>] /@ val,
<|key -> val|>]
] &, association]
(*Map it at each level*)
unfold3LevelAssociation[association_]:=Block[{temp},
temp=Map[
unfoldAssociation,association,
{2}];
temp=Flatten/@Map[
unfoldAssociation,temp,
{1}];
temp=FixedPoint[Normal,unfoldAssociation[temp]/.Rule->List//Flatten]/.Rule->List;
Partition[Flatten[temp],4]
]
(*apply the unfold3layer function and do some formatting - drop the last column*)
unfold3LevelAssociation[lProjectList[[1]]["Test Statuses"]];
StringRiffle[#, " - "] & /@ %[[;; , ;; 3]] // TableForm
It works but it's ugly. What magic function does this in one line?Eric Smith2019-03-21T20:55:18ZAnalysing wikipedia articles per language & its native speakers population
https://community.wolfram.com/groups/-/m/t/1617437
![enter image description here][1]
Today (21st of February) is UNESCO International Mother Language Day and I decided to celebrate it by exploring a bit [LanguageData][2] function.
In particular, I will show how to create the top [BubbleChart][3] using two properties of LanguageData: "NativePopulation" and "WikipediaArticleCount". The goal behind using these properties is to explore the "fitness" of languages by measuring the ratio "number of wikipedia articles"/"number native speakers" which will be represented by the size and color of the bubbles.
This way I can easily illustrate how well-protected languages have a bigger internet presence (wikipedia articles counts per native speaker). And languages from poor countries like Tigrigna from Ethiopia and Eritrea (Africa) are underrepresented in wikipedia. Interestingly languages from small European countries like Sweden, Netherlands, Scotland, Catalonia, Basque Country,… are among the highest in terms of wikipedia activity.
For this purpose, I preselected languages that have at least some native speakers alive and some wikipedia articles. Here there is a list of such languages (Disclaimer: some languages fulfilling such conditions might be missing):
languages = {"Abkhaz", "Aceh", "Adyghe", "Afar", "Afrikaans", "Akan",
"AlbanianTosk", "Amharic", "Arabic", "ArabicEgyptianSpoken",
"Aragonese", "Armenian", "Assamese", "Asturian", "Atikamekw",
"Avar", "AzerbaijaniSouth", "Bamanankan", "Banjar", "Bashkir",
"Basque", "Bavarian", "Belarusan", "Beng", "Bengali",
"BicolanoCentral", "Bishnupriya", "Bislama", "Bosnian", "Breton",
"Bugis", "Bulgarian", "BuriatChina", "BuriatRussia", "Burmese",
"BwamuCwi", "CatalanValencianBalear", "Cebuano", "Chamorro",
"Chavacano", "Chechen", "Cherokee", "Cheyenne", "ChineseGan",
"ChineseHakka", "ChineseMandarin", "ChineseMinDong",
"ChineseMinNan", "ChineseWu", "ChineseYue", "Choctaw", "Chuvash",
"Corsican", "CrimeanTurkish", "Croatian", "Czech", "Danish",
"Dimli", "Dutch", "Dzongkha", "English", "Erzya", "Ewe",
"Extremaduran", "Faroese", "FarsiEastern", "Fijian", "Finnish",
"FrancoProvencal", "French", "FrisianEastern", "FrisianNorthern",
"Friulian", "Gagauz", "Galician", "Ganda", "Georgian", "German",
"GermanPennsylvania", "Gikuyu", "Gilaki", "Greek", "Gujarati",
"HaitianCreoleFrench", "Hausa", "Hawaiian", "Hebrew", "Hindi",
"HindustaniFijian", "Hungarian", "Icelandic", "Igbo", "Ilocano",
"Indonesian", "InuktitutGreenlandic", "IrishGaelic", "Italian",
"JamaicanCreoleEnglish", "Japanese", "Javanese", "Kabardian",
"Kabiye", "KalmykOirat", "Kannada", "KarachayBalkar", "Karakalpak",
"Kashmiri", "Kashubian", "Kazakh", "KhmerCentral", "Kirghiz",
"Kolsch", "KomiPermyak", "KonkaniGoanese", "Koongo", "Korean",
"KurdishCentral", "Kwanyama", "Ladino", "Lak", "Lao", "Lezgi",
"Ligurian", "Limburgisch", "Lingala", "Lithuanian", "Livvi",
"Lombard", "LuriNorthern", "Luxembourgeois", "Macedonian",
"Maithili", "Malayalam", "Maldivian", "Maltese", "Maori", "Marathi",
"MariEastern", "MariWestern", "Marshallese", "Mazanderani",
"Minangkabau", "Mingrelian", "MirandaDoDouro", "Moksha", "Muskogee",
"NahuatlCentral", "NapoletanoCalabrese", "Narom", "Nauruan",
"Navajo", "Ndonga", "Newar", "Nyanja", "OjibwaSevern", "Osetin",
"Pampangan", "Pangasinan", "PanjabiEastern", "PanjabiWestern",
"Papiamentu", "PashtoCentral", "Piemontese", "PitcairnNorfolk",
"Polish", "Pontic", "Portuguese", "Ravula", "Romanian",
"RomanianMacedo", "RomaniVlax", "Romansch", "Rundi", "Russian",
"Rusyn", "Rwanda", "SaamiNorth", "SaintLucianCreoleFrench",
"Samoan", "Sango", "Sanskrit", "Saterfriesisch", "SaxonLow",
"Schwyzerdutsch", "Scots", "ScottishGaelic", "Serbian", "Shona",
"Sicilian", "Sindhi", "Sinhala", "Slovak", "Slovenian", "Somali",
"SorbianLower", "SorbianUpper", "SothoNorthern", "SothoSouthern",
"Spanish", "Sranan", "Sunda", "Swahili", "Swati", "Swedish",
"Tagalog", "Tahitian", "Tajiki", "Tamil", "Tatar", "Telugu",
"Tetun", "Thai", "TibetanCentral", "Tigrigna", "TokPisin", "Tongan",
"Tsonga", "Tswana", "Tulu", "Tumbuka", "Turkish", "Turkmen",
"Tuvin", "Udmurt", "Ukrainian", "Urdu", "Uyghur", "Venda",
"Venetian", "Veps", "Vietnamese", "Vlaams", "Walloon", "WarayWaray",
"Welsh", "Wolof", "Xhosa", "Yakut", "YiddishEastern", "YiSichuan",
"Yoruba", "Zeeuws", "Zulu"};
Then, using LanguageData it's quite straightforward to get the native speakers population and the number of wikipedia articles. We can also easily compute the aforementioned ratio:
bubbles =
Map[Callout[{#[[2]], #[[3]], #[[3]]/#[[2]]}, #[[1]]] &,
LanguageData[
languages, {"Name", "NativePopulation", "WikipediaArticleCount"}]]
Finally we can plot the BubbleChart:
BubbleChart[ bubbles,
ScalingFunctions -> {"Log", "Log", Automatic},
ColorFunction -> Function[{x, y, z}, Hue[Log[1 + z]]],
ColorFunctionScaling -> False,
PlotLabel -> Style["Language Wikipedia Articles Per Native Speaker", Bold, 24],
FrameLabel -> {Style["Number Of Native Speakers", 20], Style["Number Of Wikipedia Articles", 20]},
PlotTheme -> "Detailed",
ImageSize -> 800]
(See Top BubbleChart)
It's really interesting to see that most of the biggest bubbles tend to be from languages spoken in developed countries but they don't have their own state yet; i.e. Basque, Scots, Catalan, Breton...
My mother tongue is [Catalan][4] and I'm quite happy to see that it's still quite healthy (at least according to its wikipedia activity).
PS: Two years ago [@Vitaliy Kaurov][at0] wrote a really nice post about the same celebration day. You can read it [here][5].
Happy International Mother Language Day!
[at0]: https://community.wolfram.com/web/vitaliyk
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=bubblechart_Languages.png&userId=95400
[2]: https://reference.wolfram.com/language/ref/LanguageData.html
[3]: https://reference.wolfram.com/language/ref/BubbleChart.html
[4]: https://en.wikipedia.org/wiki/Catalan_language
[5]: https://community.wolfram.com/groups/-/m/t/1019123Jofre Espigule2019-02-22T01:45:41ZSplineToLine function from David Park's "Presentations" add-on?
https://community.wolfram.com/groups/-/m/t/1636443
What is the definition of the function `SplineToLine` that was at one time included in David Park's *Presentations* add-on application?
The current version of that proprietary add-on, which I have, does not seem to include that function, although it has a commented-out reference to it...
DeclarePackage["PresentationsD`SplineDrawing`",{"DrawIndexedPoints","SplineToLine"}];
... but I find no `SplineDrawing` package. And the "Free Presentations" version of the add-on, which is more or less a "run-time" version of the full add-on and omits documentation, contains no reference whatsoever in its packages to `SplineToLine`.
Or, can you tell me whether the function was superceded by a similar function with a different name, or whether somehow `BSplineCurve` or another built-in *Mathematica* function does the same thing?
Note: The function is used in the paper "Visualizing complex functions with the Presentations application," by David Park and myself, which appears in *The Mathematica Journal* vol. 11 (2009). The function is used in the form, e.g.,
circuit1 = SplineToLine[{{0.342528, -0.32536}, {0.369328, 0.492018}, {0.020937,
1.3094}, {-0.809841, 1.2826}, {-1.60042,
0.43842}, {-2.2436, -0.633552}, {-2.4044, -1.47773}, {-2.458, \
-2.20131}, {-1.52002, -2.5497}, {-0.421251, -2.05391}, {0.181733, \
-1.08914}, {0.342528, -0.32536}}, Cubic, 40];
and that is in turn used within a graphic expression in the form:
Arrow[circuit1]
I note that in Park's package *DrawGraphics*, which was a predecessor to part of *Presentations*, the `SplineToLine` function was defined by:
SplineToLine[pts : {{_, _}, {_, _} ..}, mode_,
numpts_Integer?Positive] :=
Module[{sfun, n = Length[pts] - 1},
sfun = SplineFit[pts, mode];
Line[Table[sfun[t], {t, 0, n, n/(numpts - 1)}]]
]
But that used the function `SplineFit`, formerly supplied with Mathematica but no longer included. So a substitute for `SplineFit` would suffice here. (See also https://mathematica.stackexchange.com/questions/193681/how-reproduce-old-splinefit-function.)Murray Eisenberg2019-03-20T22:32:39ZSolve numerically a system of 5 ODEs using NDSolve?
https://community.wolfram.com/groups/-/m/t/1636689
Hello all!
I'm trying to solve numerically a system of 5 ODEs using `NDSolve[]`. The problem is that some of the solutions take negative values, which doesn't make sense from a physical point of view. Is there any way to force these functions to stay non-negative?
I've read about the command `WhenEvent[]`, but I don't know if it can be useful to fix this.
Thank you in advance for any help!
PD: This isn't my mathematical model, which is pretty large, but it might serve as an example:
\[Phi] = 0.08;
a = 0.7;
b = 0.8;
tmax = 200.0;
V0 = 1.0;
U0 = 1.0;
i = 1.0;
sol = NDSolve[{V[0] == V0, U[0] == U0,
V'[t] == V[t] - 1/3 V[t]^3 - U[t] + i,
U'[t] == \[Phi] (V[t] + a - b U[t])}, V[t], {t, 0, tmax},
DependentVariables -> {V[t], U[t]}, Method -> "Adams"];
Plot[V[t] /. sol, {t, 0, tmax}]David Aragonés2019-03-20T20:07:08ZWhy is Wolfram Absent from Forrester and Gartner's Data Science Reports?
https://community.wolfram.com/groups/-/m/t/1636461
Dear Community members,
the latest reports from Gartner and Forrester regarding data science and machine learning don't mention Wolfram in them but they both consider Mathworks.
Does anybody have any ideas why?Ruben Garcia Berasategui2019-03-21T09:24:18Z"Functional Dataflow" Wolfram Live Coding Session // Mar 19
https://community.wolfram.com/groups/-/m/t/1634956
For those interested in data science, please join us for a 1 hour Wolfram Live Coding Session Tuesday Mar 19 2019 at 4pm ET on Zoom (https://wolfram.zoom.us/j/4659236576) . Please see the Linkedin post:
[https://www.linkedin.com/pulse/functional-dataflow-wolfram-live-coding-session-mar-19-calvitti-phd][1]
Abstract
This live coding session will focus on functional methods and patterns to write compact but flexible pipes for data science using real-world examples. The Wolfram Language is ideal to data science due to its functional orientation, large-scale symbolic processing and pattern matching abilities. Many of these features have no direct counterpart in object-oriented languages like Python. Consequently WL workflow is more programmer efficient: line-count ratios of 5:1 and often much more, are common relative to equivalent Python (inclusive of its extensive libraries). Functional programming lets you do more with less code and is more convenient and safer to refactor. After a brief tour of the forthcoming book Functional Dataflow, the focus will be on data transformation, aka "data wrangling" - recognized to be a highly time-consuming aspect of workflow - rather than on math or statistical methods. Exposition will be adapted from Excursion chapters in FD. Key skills described include composing operator pipes, combining tabular, hierarchical, temporal and graphical datasets, exploring queries on data slices then scaling up to the whole dataset, creating insightful visualizations, and writing flexible utility (eg one-liner operator) libraries for reuse in future projects.
Overview Mathematica notebook containing links to data and dependencies:
[enter link description here][2]
[1]: https://www.linkedin.com/pulse/functional-dataflow-wolfram-live-coding-session-mar-19-calvitti-phd
[2]: %22https://drive.google.com/drive/folders/1Af0yNPA5YZB0ep0Y9a6Vj2kbsWDSRqYV?usp=sharing%22Alan Calvitti2019-03-18T15:17:10ZThe Chaos Game - Sierpinski triangles and beyond - part I
https://community.wolfram.com/groups/-/m/t/1025180
EDIT: See also the follow up posts [here.][1] and [here][2].
![enter image description here][3]
Roughly 8-9 years ago a friend of mine told me I could make the Sierpinski triangle by starting at one of the vertices of an equilateral triangle, and then repeatedly jump half-way to one of the (randomly chosen) vertices.
## 0 memory ##
The following code will accomplish that:
ClearAll[sequence]
sequence[n_,m_]:=RandomChoice[Range[n],m]
pts=N@CirclePoints[3];
pts=FoldList[(#1+pts[[#2]])/2&,RandomChoice[pts],sequence[3,10]]
Graphics[{{FaceForm[],EdgeForm[Black],RegularPolygon[3]},Red,Arrow[Partition[pts,2,1]]}]
giving:
![enter image description here][4]
If one does this 1000s of time, and only mark the viewed points, one will get:
ClearAll[sequence]
sequence[n_,m_]:=RandomChoice[Range[n],m]
pts=N@CirclePoints[3];
pts=FoldList[(#1+pts[[#2]])/2&,RandomChoice[pts],sequence[3,25000]];
Graphics[{FaceForm[],EdgeForm[Black],RegularPolygon[3],PointSize[0.001],Point[pts]}]
giving:
![enter image description here][5]
Which will indeed show that by randomly choosing a vertex we can still get structure! Quite a surprise! Of course we can do this with squares, pentagons, hexagons et cetera:
ClearAll[sequence]
sequence[n_,m_]:=RandomChoice[Range[n],m]
Table[
circlepoints=N@CirclePoints[n];
pts=FoldList[(#1+circlepoints[[#2]])/2&,RandomChoice[circlepoints],sequence[n,50000]];
Rasterize[Graphics[{FaceForm[],EdgeForm[Black],RegularPolygon[n],PointSize[0.001],Point[pts]},ImageSize->500,PlotRange->1.1],"Image"]
,
{n,3,8}
] // Partition[#, 3] & // ImageAssemble
giving:
![enter image description here][6]
Very neat! (apart from 4, which just gives a homogeneous distribution of points). Here I run the pentagon many many points and high resolution to get:
![enter image description here][7]
Where now the gray-color represents the density of points.
## 0 memory - restricted ##
Now we can make the dynamics a bit more interesting by not moving to any other vertex but to only specific vertices. Imagine that we are at some position p, then we always have n choices (n being the number of sides): we can jump to the vertex 1 ahead, 2 ahead, .... n ahead (same as last time).
ClearAll[CreateSequence,CreateSequenceImage]
CreateSequence[n_,steps_,choices_]:=Mod[Accumulate[RandomChoice[choices,steps-1]~Prepend~1],n,1]
CreateSequenceImage[n_,m_,choices_]:=Module[{seq,pts},
seq=CreateSequence[n,m,choices];
pts=N@CirclePoints[n];
seq=FoldList[(#1+pts[[#2]])/2&,First[pts],seq];
Rasterize[Graphics[{PointSize[0.001],Point[seq]},ImageSize->500,PlotRange->1],"Image",RasterSize->{300,300}]
]
For a 3 sided polygon (i've been told these are called triangles) we can jump 1, 2, or 3 ahead or subsets of that:
Grid[Join@@@Partition[{#,CreateSequenceImage[3,10^5,#]}&/@Subsets[Range[3],{1,\[Infinity]}],UpTo[3]],Frame->All]
![enter image description here][8]
Some interesting structure can be seen for some of the subsets.
For squares:
Grid[Join@@@Partition[{#,CreateSequenceImage[4,10^5,#]}&/@Subsets[Range[4],{1,\[Infinity]}],UpTo[4]],Frame->All]
![enter image description here][9]
and for pentagons:
Grid[Join@@@Partition[{#,CreateSequenceImage[5,10^5,#]}&/@Subsets[Range[5],{1,\[Infinity]}],UpTo[4]],Frame->All]
![enter image description here][10]
the higher the number of sides, the more subsets we can choose. The number of subsets scales as 2^n -1 (minus one because the set can not be empty; we have to jump somewhere!).
Lastly, for hexagons:
Grid[Join@@@Partition[{#,CreateSequenceImage[5,10^5,#]}&/@Subsets[Range[5],{1,\[Infinity]}],UpTo[4]],Frame->All]
![enter image description here][11]
Ok, you can try polygons with large number of sides on your own, but note that the number of subsets doubles every time.
## 1 memory - restricted ##
We can even go beyond this, and consider the position of the penultimate vertex as well:
![enter image description here][12]
We can consider 5 cases for a pentagon (or, in general, n cases). We will consider the last point to be at position 0 (or n), now the penultimate vertex could be in 5 different positions. For each of these combinations we can choose a different subset of {1,2,3,4,5}. Just to get an idea how many possibilities we now have:
the number of subsets is 2^n - 1, and we have to choose n of these, so there will be (2^n-1)^n different systems to explore:
Table[{n, (2^n - 1)^n}, {n, 3, 8}] // Grid
![enter image description here][13]
as one can see, the combination grow very quickly.
ClearAll[Stamp,CreateSequence2,CreateSequenceImage2]
CreateSequence2[n_,m_,start:{start1_,start2_},choices_]:=Module[{out,last, penultimate,new,pos2},
{penultimate,last}=out=start;
out=Reap[Do[
pos2=Mod[penultimate-last,n,1];
new=Mod[last+RandomChoice[choices[[pos2]]],n,1];
penultimate=last;
last=new;
Sow[new]
,
{m-2}
]][[2,1]];
Join[start,out]
]
Stamp[n_,choices_]:=Module[{},
Image[Normal[SparseArray[Thread[Join@@MapThread[Thread[{#1,#2}]&,{Range[Length[choices]],choices}]->1],{n,n}]]]
]
CreateSequenceImage2[n_,m_,start:{start1_,start2_},choices_]:=Module[{seq,pts,ras,stamp},
seq=CreateSequence2[n,m,start,choices];
pts=N@CirclePoints[n];
seq=FoldList[(#1+pts[[#2]])/2&,First[pts],seq];
ras=Rasterize[Graphics[{PointSize[0.001],Point[seq]},ImageSize->500,PlotRange->1],"Image",RasterSize->{300,300}];
stamp=ImagePad[Stamp[n,choices],1,Red];
ImageCompose[ras,stamp,{Center,Bottom},{Center,Bottom}]
]
Before looking at the general case, we can look at a small subset, namely one can **not** jump i ahead from the last, and j ahead from the penultimate. Here the example for i=1, and j =3:
ClearAll[JumpPos2]
JumpPos2[n_,{d1_,d2_}]:=Module[{pos},
pos=Range[n];
pos=DeleteCases[pos,d1];
DeleteCases[pos,Mod[d2+#,n,1]]&/@Range[n]
]
CreateSequenceImage2[4,10^4,{1,2},JumpPos2[4,{1,3}]]
![enter image description here][14]
Very neat structure! Of course we can try all i and j from the set {1,2,3,4}:
delta=Tuples[Range[4],2];
deltas=JumpPos2[4,#]&/@delta;
Grid[Join@@@Table[{{i,j},CreateSequenceImage2[4,10^4,{1,2},JumpPos2[4,{i,j}]]},{i,4},{j,4}],Frame->All]
![enter image description here][15]
All very neat, but it is just a small subset of the 50625 possibilities. Here let's try 64 random ones:
sc=Reverse@Subsets[Range[4],{1,\[Infinity]}];
Table[
CreateSequenceImage2[4,10^4,{1,2},RandomChoice[sc,4]]
,
{64}
] // Partition[#,8]& // ImageAssemble
![enter image description here][16]
As you can see very nice and rich structure! Notice that I 'stamped' all of them with their 'input':
CreateSequenceImage2[4, 10^4, {1, 2}, {{1, 4}, {3}, {1, 3, 4}, {1, 2, 3}}]
![enter image description here][17]
And if one looks closely (save the image and zoom), one will see the 'stamp' (or the rule) at the bottom:
![enter image description here][18]
This can be read as follows:
- The first (top) line, the white pixels are in places 1 and 4, so if the penultimate vertex was '1', move 1 or 4 places from the last vertex
- The 2nd line, the white pixel is in place 3, jump the position 3 ahead compared to last vertex
- 3rd line, white pixel at 1,3, and 4.
- 4th line 1, 2, or 3.
Basically the nth line corresponds to the position of the penultimate vertex. and the white pixels corresponds to 'allowed' number of jumps.
I'll stop here for now. There are many more ideas to explore, I'll name a few:
- <s>3D positions, 3D images</s> See below the post of Henrik!
- Anything other than regular polygons
- Have different probabilities for each of the vertices...
- Move in the perpendicular direction
- ...
See also the follow up posts [here.][19] and [here][20] and some additional visualizations below!
[1]: http://community.wolfram.com/groups/-/m/t/1039030
[2]: http://community.wolfram.com/groups/-/m/t/1047603
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=opener.png&userId=73716
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=trial1.png&userId=73716
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=trial2.png&userId=73716
[6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=3446trial3.png&userId=73716
[7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=trial4b.jpg&userId=73716
[8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=trial5.png&userId=73716
[9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=trial6.png&userId=73716
[10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=trial7.png&userId=73716
[11]: http://community.wolfram.com//c/portal/getImageAttachment?filename=trial8.png&userId=73716
[12]: http://community.wolfram.com//c/portal/getImageAttachment?filename=explanation-01.png&userId=73716
[13]: http://community.wolfram.com//c/portal/getImageAttachment?filename=trial9.png&userId=73716
[14]: http://community.wolfram.com//c/portal/getImageAttachment?filename=trial10.png&userId=73716
[15]: http://community.wolfram.com//c/portal/getImageAttachment?filename=trial11.png&userId=73716
[16]: http://community.wolfram.com//c/portal/getImageAttachment?filename=5983trial12.png&userId=73716
[17]: http://community.wolfram.com//c/portal/getImageAttachment?filename=trial13.png&userId=73716
[18]: http://community.wolfram.com//c/portal/getImageAttachment?filename=trial14.png&userId=73716
[19]: http://community.wolfram.com/groups/-/m/t/1039030
[20]: http://community.wolfram.com/groups/-/m/t/1047603Sander Huisman2017-03-04T21:41:21ZThe Chaos Game - infinitygon and Markov-chains - part III
https://community.wolfram.com/groups/-/m/t/1047603
In case you missed the first two parts check them out before reading this post:
- [The Chaos Game - Sierpinski triangles and beyond - part I][1]
- [The Chaos Game - part II][2]
Today on the menu is to go from triangles, squares, pentagon, and hexagons all the way to a regular polygon with infinite vertices: the infinitygon, commonly known as a circle. So let's do the jumping again, but this time to a random point on a circle:
ClearAll[CreateSequence,CreateSequenceImage]
CreateSequence[steps_]:=RandomReal[{0,2Pi},steps]
CreateSequenceImage[m_,\[Alpha]_]:=Module[{seq,circlepoints,pts,plotdata,colors},
seq=CreateSequence[m];
seq=Transpose[{Cos[seq],Sin[seq]}];
pts=Rest@FoldList[(1-\[Alpha])#1+\[Alpha] #2&,seq];
Rasterize[Graphics[{FaceForm[],EdgeForm[Black],Circle[{0,0},1],PointSize[0.001],Point@pts,Text[NumberForm[\[Alpha],{\[Infinity],2}],{0,1.05}]},ImageSize->300,PlotRange->1.1],"Image",RasterSize->300]
]
here alpha is the step-factor, as before. Let's vary alpha from 0.1 to 0.9:
ImageAssemble[Partition[CreateSequenceImage[30000, #] & /@ Range[0.1, 0.9, 0.1], 3]]
![enter image description here][3]
For small alpha it just tends to go the center, and for large alpha we go towards the rim, while the center remains inaccessible.
Probability density function
----------------------------
Let's have a look at PDF of the radial position of the points to see how they are distributed for a range of alpha:
ClearAll[CreateSequence,CreateSequenceHistogram]
CreateSequence[steps_]:=RandomReal[{0,2Pi},steps]
CreateSequenceHistogram[m_,\[Alpha]_,\[Delta]_:0.01]:=Module[{seq,circlepoints,pts,plotdata,colors},
seq=CreateSequence[m];
seq=Transpose[{Cos[seq],Sin[seq]}];
pts=Rest@FoldList[(1-\[Alpha])#1+\[Alpha] #2&,seq];
Histogram[Norm/@pts,{0,1,\[Delta]},"PDF",Frame->True,PlotLabel->\[Alpha],ImageSize->300,PlotRange->{{0,1},{0,4.5}}]
]
Grid[Partition[CreateSequenceHistogram[10^6,#]&/@Range[0.1,0.8,0.1],UpTo[3]]]
![enter image description here][4]
Especially the cases around 0.7 look interesting because of its unexpected shape, let's make high-resolution PDF for that alpha:
CreateSequenceHistogram[10^7, 0.7, 0.001]
![enter image description here][5]
So we can calculate this more quickly? Well, let's first look at how a single jump works:
Clear[GetOverView,GetPlot\[Theta]r,GetCDFFunc,GetPDFFunc,r]
GetOverView[b_,\[Alpha]_]:=Graphics[{Circle[],Red,Point[{b,0}],Black,Circle[{(1-\[Alpha])b,0},\[Alpha]]}]
GetPlot\[Theta]r[b_,\[Alpha]_]:=Plot[Sqrt[\[Alpha]^2+(1-\[Alpha])^2 b^2+2\[Alpha] Cos[\[Theta]](1-\[Alpha])b],{\[Theta],0,2Pi},PlotRange->{0,1},AxesLabel->{"\[Theta]","r"},Ticks->{Range[0,2Pi,Pi/2]}]
GetCDFFunc[b_, \[Alpha]_] := \[Piecewise] {
{0, r < Abs[b (1 - \[Alpha]) - \[Alpha]]},
{1, r > b (1 - \[Alpha]) + \[Alpha]},
{((\[Pi] -
ArcCos[(b^2 - r^2 - 2 b^2 \[Alpha] + \[Alpha]^2 +
b^2 \[Alpha]^2)/(2 b (-\[Alpha] + \[Alpha]^2))])/\[Pi]), \!\(
TagBox["True",
"PiecewiseDefault",
AutoDelete->False,
DeletionWarning->True]\)}
}
GetPDFFunc[b_,\[Alpha]_]:=D[GetCDFFunc[b,\[Alpha]],r]
GetPDFFunc[b_, \[Alpha]_] := \[Piecewise] {
{0, r - Abs[b (1 - \[Alpha]) - \[Alpha]] <
0 || -b + r - \[Alpha] + b \[Alpha] > 0},
{-(r/(b \[Pi] (-\[Alpha] + \[Alpha]^2) Sqrt[
1 - (b^2 - r^2 - 2 b^2 \[Alpha] + \[Alpha]^2 +
b^2 \[Alpha]^2)^2/(
4 b^2 (-\[Alpha] + \[Alpha]^2)^2)])), \!\(
TagBox["True",
"PiecewiseDefault",
AutoDelete->False,
DeletionWarning->True]\)}
}
GetPlotCDF[b_,\[Alpha]_]:=Plot[GetCDFFunc[b,\[Alpha]],{r,0,1},AxesLabel->{"r","CDF(r)"},PlotRangePadding->None]
GetPlotPDF[b_,\[Alpha]_]:=Plot[GetPDFFunc[b,\[Alpha]],{r,0,1},AxesLabel->{"r","PDF(r)"},PlotRangePadding->None]
Manipulate[GraphicsGrid[Partition[{GetOverView[b,\[Alpha]],GetPlot\[Theta]r[b,\[Alpha]],GetPlotCDF[b,\[Alpha]],GetPlotPDF[b,\[Alpha]]},2],Spacings->Scaled[.5],ImageSize->600],{{b,0.78},0,1},{{\[Alpha],0.5},0,1}]
![enter image description here][6]
the red point shown above can jump to any position of the inner circle. Top right shows the radius (from the center) as a function of theta for that circle. Bottom left shows the CDF of the possible radial positions, and bottom right the PDF of the possible radial positions. For the shown example you can see it will end up somewhere with a radius between 0.2 and 0.9, and most likely at those edges as the PDF is very large there.
Starting from an initial flat PDF of equal probability as a function of radius we can iterate that PDF to get the next PDF if we 'jump those probabilities':
ClearAll[GetMatrix,DoPDFFind]
GetMatrix[binranges_,\[Alpha]_]:=Module[{midbins,func},
midbins=MovingAverage[binranges,2];
Transpose[Table[
func=GetCDFFunc[Subscript[midbins, [[i]]],\[Alpha]];
Differences[Table[func,{r,binranges}]]
,
{i,Length[midbins]}
]]
]
DoPDFFind[\[Alpha]_,bins_Integer,n_:25]:=Module[{binwidth,initprob,prob,binranges,tmp,mat,plotdata},
binwidth=1/bins;
initprob=1/bins;
prob=N[ConstantArray[initprob,bins]];
binranges=N[Range[0,1,binwidth]];
mat=Re[GetMatrix[binranges,\[Alpha]]];
tmp=bins Nest[mat.#&,prob,n];
plotdata={MovingAverage[binranges,2],tmp}\[Transpose];
plotdata=Mean/@Partition[plotdata,2];
ListLinePlot[plotdata,PlotRange->{{0,1},{0,All}},PlotStyle->Directive[Red,Thick]]
]
Now we check if the PDF matches:
\[Alpha]=0.7;
Show[{CreateSequenceHistogram[10^7,\[Alpha],0.001],DoPDFFind[\[Alpha],500]},ImageSize->500,AxesLabel->{"r","PDF(r)"},PlotLabel->Row[{"\[Alpha]=",\[Alpha]}],Frame->True]
![enter image description here][7]
We can actually see the convergence:
ClearAll[DoPDFFindAll]
DoPDFFindAll[\[Alpha]_,bins_Integer,n_:25]:=Module[{binwidth,initprob,prob,binranges,tmp,mat},
binwidth=1/bins;
initprob=1/bins;
prob=N[ConstantArray[initprob,bins]];
binranges=N[Range[0,1,binwidth]];
mat=GetMatrix[binranges,\[Alpha]];
mat=Re[mat];
tmp=bins NestList[mat.#&,prob,n];
tmp={MovingAverage[binranges,2],#}\[Transpose]&/@tmp;
tmp=(Mean/@Partition[#,2])&/@tmp;
ListLinePlot[tmp,PlotRange->{{0,1},{0,All}},Frame->True,PlotLegends->Automatic,ImageSize->600]
]
DoPDFFindAll[0.7,500,5]
![enter image description here][8]
As you can see, it quickly converges to its final form. What we've done here is called a Markov chain, and this entire procedure could've been simplified by using the **DiscreteMarkovProcess** function in the Wolfram Language:
bins=500;
binwidth=1/bins;
initprob=1/bins;
prob=N[ConstantArray[initprob,bins]];
binranges=N[Range[0,1,binwidth]];
mat=GetMatrix[binranges,0.7];
dmp=DiscreteMarkovProcess[prob,Transpose@mat];
sd=StationaryDistribution[dmp];
sdpdf=PDF[sd,x];
plotdata=Table[{x/bins,bins Chop[sdpdf]},{x,1,bins}];
ListPlot[plotdata,Joined->True,Frame->True,ImageSize->500,PlotRange->{0,4.5}]
giving the same result:
![enter image description here][9]
That is it for now...
[1]: http://community.wolfram.com/groups/-/m/t/1025180
[2]: http://community.wolfram.com/groups/-/m/t/1039030
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ChaosGame1.png&userId=73716
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ChaosGame2.png&userId=73716
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ChaosGame3.png&userId=73716
[6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ChaosGame4.png&userId=73716
[7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=10684ChaosGame5.png&userId=73716
[8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ChaosGame6.png&userId=73716
[9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ChaosGame8.png&userId=73716Sander Huisman2017-03-29T22:52:21ZEnable code captions in Mathematica for Raspberry Pi?
https://community.wolfram.com/groups/-/m/t/1636173
How can I enable code captions in Mathematica for Raspberry Pi?
I followed this instruction ( https://reference.wolfram.com/language/workflow/ConfigureNonEnglishCodeCaptions.html )
but I can't find 'Preferences' or settings.
Questions:
- Where can I find options?
- How can I enable code captions?Jeongho Shin2019-03-20T12:24:35ZCreate 9 sided dice?
https://community.wolfram.com/groups/-/m/t/1632720
G'Day Folks,
I am interested in creating a (3d printed) sudoku board...
I wanted to start with (something like) a 9-sided dice.
I think that if you 'sliced' 9 flat faces into a sphere you'd get something like it. :)
The faces would need to be the same size and equidistant; which sounds simple.
But, my mathematical knowledge isn't good enough for this.
I've been using Open SCAD for modelling; and have created a Dodecahedron (12 sided regular polyhedron); and I guess this would be OK - with 3 "black" faces.
Does anyone have any suggestions!?
cheers
SteveStephen Peter2019-03-15T05:49:34Z[GIF] Minimal (Rotating minimal lattice trefoil knot)
https://community.wolfram.com/groups/-/m/t/1634541
![Rotating minimal lattice trefoil knot][1]
**Minimal**
This shows the trefoil knot lying on the simple cubic lattice with the fewest possible number of edges (it's [a theorem of Yuanan Diao][2] that the lattice stick number of the trefoil is 24), rotated, and projected to the plane.
The 3D vertex locations are in [KnotPlot][3]. At least in the MacOS version of KnotPlot, the data is contained in the app bundle at `/Applications/KnotPlot/KnotPlot.app/Contents/Resources/special/mscl/3.1`; if you don't have KnotPlot installed, you can download the data by going to <https://knotplot.com/download/> and clicking the link to download `kpdist.tar.gz`. If you do that and then unzip to get a directory called `kpsdist`, the following commands will import the vertices and mean center:
lattice31 = Import["kpdist/special/mscl/3.1", "Table"];
lattice31 = lattice31 - Table[Mean[lattice31], {Length[lattice31]}];
As usual for animations where I want to smoothly stop and start a motion, I'm going to use the [`smootheststep` function][4]:
smootheststep[t_] := -20 t^7 + 70 t^6 - 84 t^5 + 35 t^4;
Here, then, is the `Manipulate` for the above animation (the giant obnoxious `Which` is to switch between different axis rotations, which I obviously could have made a little cleaner with some extra work):
DynamicModule[{p, q, a, b, n, M, θ, pl,
cols = RGBColor /@ {"#fd5f00", "#05004e", "#fbfaf1"}},
Manipulate[
Which[t < 1 || t == 4,
{p, q} = RotationMatrix[ArcTan[1/Sqrt[2]]].{Normalize[{1, 1, 0}], {0, 0, 1}};
θ = -(ArcTan[1/Sqrt[2]] + π/2) smootheststep[Mod[t, 1]];
{n, b} = RotationMatrix[θ].{p, q};,
1 <= t < 2,
{p, q} = {{0, 0, 1}, {-(1/Sqrt[2]), -(1/Sqrt[2]), 0}};
θ = (π - ArcTan[Sqrt[23 - 16 Sqrt[2]]]) smootheststep[Mod[t, 1]];
{n, b} = RotationMatrix[-θ,
N@{Sqrt[1/17 (5 + 2 Sqrt[2])], Sqrt[1/17 (7 - 4 Sqrt[2])],
Root[1 - 10 #1^2 + 17 #1^4 &, 1]}].# & /@ {p, q};,
2 <= t < 3,
{p, q} = {{-1, 0, 0}, {0, 0, 1}};
θ = 3 π/4 smootheststep[Mod[t, 1]];
{n, b} = RotationMatrix[θ].{p, q},
3 <= t,
{p, q} = {{1/Sqrt[2], 0, -(1/Sqrt[2])}, {-(1/Sqrt[2]), 0, -(1/Sqrt[2])}};
θ = (π - ArcCot[(3 - 2 Sqrt[2] + 2 Sqrt[3] + Sqrt[6])/Sqrt[
13 - 4 Sqrt[3] + 2 Sqrt[6]]]) smootheststep[Mod[t, 1]];
{n, b} = RotationMatrix[-θ,
N@{Root[1 - 156 #1^2 + 1670 #1^4 - 5148 #1^6 + 4801 #1^8 &,
1], Root[1 - 52 #1^2 + 870 #1^4 - 5044 #1^6 + 4801 #1^8 &,
2], (2 + Sqrt[2])/Sqrt[
94 - 48 Sqrt[2] + 48 Sqrt[3] - 32 Sqrt[6]]}].# & /@ {p, q};
];
a = Cross[b, n];
M = {a, b};
pl = M.# & /@ lattice31;
Graphics[
{Thickness[.004], cols[[1]], Line[Append[#, First[#]] &[pl]],
FaceForm[cols[[-1]]],
EdgeForm[Directive[Thickness[.004], cols[[2]]]],
Disk[M.#, .05] & /@ Sort[lattice31, n.#1 > n.#2 &]},
ImageSize -> 540, PlotRange -> 2.2, Background -> cols[[-1]]],
{t, 0, 4}]
]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=lt7q.gif&userId=610054
[2]: https://doi.org/10.1142/S0218216593000234
[3]: https://knotplot.com
[4]: https://en.wikipedia.org/wiki/SmoothstepClayton Shonkwiler2019-03-17T23:11:24ZNDSolve piecewise differential equations associated with a water hammer?
https://community.wolfram.com/groups/-/m/t/1636116
I am trying to solve the differential equations associated with water hammer. I have three pipe segments and I am using piecewise function for the differential equations. When I try to solve using NDSolve I get an error message " The function value {0,.....} is not a list of numbers with dimension {50} at {x,P[x,t],V[x,t]}={...}". Can someone please help me with this.
L1 = 3100; (*Length of first pipe*)
L2 = 2700;(*Length of second pipe*)
L3 = UnitConvert[Quantity[30., "ft"], "m"][[
1]];(*Length of third pipe*)
D1 = UnitConvert[Quantity[4, "in"], "m"][[
1]]; (*Diameter of first pipe *)
D2 = UnitConvert[Quantity[6, "in"], "m"][[
1]];(*Diameter of second pipe *)
D3 = UnitConvert[Quantity[1.75, "in"], "m"][[
1]];(*Diameter of third pipe *)
f = 0.002; (*Friction factor*)
\[Rho] = 1000; (*Density of fluid*)
Ef = 2.19*^9; (*Bulk modulous of fluid*)
Ep = 210*^9;(*Elastic modulous of pipe*)
ee = 4.5*^-5; (* Pipe roughness*)
\[Mu] =
0.001002; (* Fluid viscosity in Poise*)
Qmax = 0.1;
A1 = Pi/4 D1^2;
A2 = Pi/4 D2^2;
A3 = Pi/4 D3^2;
w = UnitConvert[Quantity[0.2, "in"], "m"][[1]];
solEe = Solve[1/EE == 1/Ef + 1/(w Ep), EE][[1]];
Ee = EE /. solEe;
c = Sqrt[Ee/\[Rho]];
pde1 = D[P[x, t], t] + \[Rho] c^2 D[V[x, t], x] == 0
sol1 = NDSolve[{pde1,
D[V[x, t], t] + 1/\[Rho] D[P[x, t], x] ==
Piecewise[{{-((f V[x, t] Abs[V[x, t]])/(2 D1)), 0 < x < L1},
{-((f V[x, t] Abs[V[x, t]])/(2 D2)) == 0, L1 < x < L1 + L2},
{-((f V[x, t] Abs[V[x, t]])/(2 D3)) == 0,
L1 + L2 < x < L1 + L2 + L3}}],
V[x, 0] == 0.,
P[x, 0] == 0.,
P[L1 + L2 + L3, t] == \[Rho]/(2 A3^2) (A3 V[L1 + L2 + L3, t])^2,
V[L1 + L2 + L3, t] == 10 t}, {P, V}, {x, 0, L1 + L2 + L3}, {t, 0,
12}]srinivas.gk2019-03-20T03:26:00Z[✓] Use Epilog in Manipulate?
https://community.wolfram.com/groups/-/m/t/1635365
Hello,
Epilog with "No Points" in Manipulate are not working as it should be. Does anyone know what's wrong?
data2 = {{1, 10}, {2, 11}, {3, 20}, {4, 30}};
Manipulate[
ListLinePlot[data2
, Epilog -> If[points == "No Points", None
, If[points == "Points", {PointSize[0.04], Red, Point[data2]}]
]]
, {points, {"No Points", "Points"}}
]
Thank you in advance !
Regards,....JosJos Klaps2019-03-19T01:28:52Z[✓] Draw a bell curve with specified shading under the curve?
https://community.wolfram.com/groups/-/m/t/1635282
Pardon the newbie-type question, but I'm struggling with the Mathematica syntax for a bell curve. All I want to draw is a bell curve with mean 3 and SD of 0.3, but with the region between the graph, the x-axis, -2sigma and +1 sigma shaded (where sigma = standard deviation). Can someone help?
TIA
Geoffreygeoffrey Marnell2019-03-19T01:13:46Z[✓] Play back an imported audio file using ListPlay?
https://community.wolfram.com/groups/-/m/t/1634947
Dear all,
I am a complete beginner at Mathematica in general, and at using it to try to investigate sounds in particular. I have done the following thing: Imported a short sample of spoken text using Import. I then looked at the plot of this imported object, using AudioPlot. The signal looks to be the same as how it was when I had the file open in another program (audacity).
Then I used AudioData to extract a sample from the imported file. At this point I am confused as to what AudioData is actually doing, because when I then use ListPlot to visualize the extracted data, it had quite clearly been clipped. Then when I tried playing back the data using ListPlay, it has transformed a sample that is 9 seconds long into a load of unintelligible nonsense that lasts for nearly a minute.
Can anyone give me a clue as to what is going on? Do I need to upload the sample file and notebook?
Thanks very much!Sara Ann2019-03-18T15:03:58ZCreate dynamic PlotLegends?
https://community.wolfram.com/groups/-/m/t/1635563
How to add dynamic `PlotLegends` to the below code?
DynamicModule[{inputData = 0, dataSet = {}},
Column[{
InputField[Dynamic[inputData]],
Button["Plot",
AppendTo[dataSet, Table[inputData + i^j, {i, 5}, {j, 2}]]],
Spacer[5],
Dynamic@ListPlot[dataSet, Joined -> True, ImageSize -> {300}]
}]]
I would like to have a `PlotLegends` which appears only when the `Button` is pressed and `ListPlot` prints the curve, otherwise it shouldn't be visible. Also every time the `Button` is pressed `ListPlot` appends the new curve to the old one, therefore the `PlotLegends` should print the name for every printed curve, but one at the time. How to achieve that?
I spent hours on searching some guidance which could give me at least an idea of how to start, but all I found is for the static `PlotLegends`. This is why I'm asking you for a help.Kamila Szklarczyk-Marshall2019-03-19T10:59:50Z[✓] Evaluate a function in two variables at a particular point (a,b)?
https://community.wolfram.com/groups/-/m/t/1635060
I need evaluate a a function in two variables in a particular point, I mean, if f(x,y)=x^2+y^2, and p=(1,1), I want to get f(1,1).Kratos Desparta2019-03-18T17:32:13Z[Package] Phylogenetics for Mathematica
https://community.wolfram.com/groups/-/m/t/784207
[Dr. P. David Polly from Indiana University][1] published a [Phylogenetics package for Mathematica][2]. A detailed [User's Guide][3] is also available. Short discription is copied below.
**Keywords**: Phylogenetics; Ancestral Node Reconstruction; Newick Trees
**Abstract**: This add-in package for Mathematica performs basic phylogenetic functions, including reading and drawing Newick format trees, calculating phylogenetically independent contrasts, reconstructing ancestral values for continuous traits, performing random walks, and simulating continuous traits on phylogenetic trees. The file is a ".m" file, which can be imported into Mathematica 6.0 and later (functions do not work in earlier versions of Mathematica). Install using the "Install" item on the "File" menu. Once installed, you must load the package like any other with the line `<<PollyPhylogenetics`, using either this suggested name or another.
[1]: http://mypage.iu.edu/~pdpolly
[2]: https://scholarworks.iu.edu/dspace/handle/2022/14614
[3]: http://mypage.iu.edu/~pdpolly/Software/Guide%20to%20PollyPhylogenetics%203.0.pdfVitaliy Kaurov2016-02-01T13:07:47Z[✓] Use Cases with RuleDelayed?
https://community.wolfram.com/groups/-/m/t/1632770
Let us assume very simple and dumb example of pattern extracting from some data list by Cases[]:
Cases[{{1}, {2}}, x_ -> x[[1]]]
One can run it and get
During evaluation of In[1]:= Part::partd: Part specification x[[1]] is longer than depth of object.
Out[1]= {1, 2}
What a hell, why x is not an array?
Or a little more complex example:
In[287]:= Cases[{"2","1 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1"}, mList_String -> StringExtract[mList, All], 1]
During evaluation of In[287]:= StringExtract::strse: String or list of strings expected at position 1 in StringExtract[mList,All].
Out[287]= {{"2"},{"1", "0", "0", "0", "0", "1", "0", "0", "0", "0", "1", "0", "0", "0", "0", "1"}}
One can tell, that as we get after all an correct output there is no big problem in such warnings.
But if we go a little deeper the real problem rises:
In[304]:= Cases[{"2", "1 0 0 0 0 1 0 0 0 0 1 0 0 0 0 1"}, mList_String -> ToExpression[StringExtract[mList, All]], 1]
During evaluation of In[304]:= StringExtract::strse: String or list of strings expected at position 1 in StringExtract[mList,All].
During evaluation of In[304]:= ToExpression::notstrbox: StringExtract[mList,All] is not a string or a box. ToExpression can only interpret strings or boxes as Wolfram Language input.
Out[304]= {$Failed, $Failed}
Any correct result at all.
So, what is exact problem with Cases[] and how to fix it correctly (i managed to make a simple and dirty fix, but do not like it)?Snegirev Maksym2019-03-15T17:01:05ZCalculate delta coefficients?
https://community.wolfram.com/groups/-/m/t/1635481
Hi,
I want to calculate delta coefficients in Mathematica. However, I cannot find the optimal way to do it. The mathematical definition can be found there [here][1]. If t+n>n then the last element is used. Similarly, for t-n, the first element is used. I tried to compute this by first padding n first elements at the beginning and n last elements at the end and then calculating the deltas from the definition.
delta = Sum[(n-l)*(lst[[t+n]-lst[[t-n]]]),{n,l+1,2l}];
delta = delta/(2*Sum[n^2,{n,1,l}]);
Where lst is the array, l is the length of the array (before padding) and t is the element for which we want to calculate delta. I think, that there should be a better way to do this, nevertheless I cannot find is. Therefore, my question is, how can I improve the computation?
[1]: http://practicalcryptography.com/miscellaneous/machine-learning/guide-mel-frequency-cepstral-coefficients-mfccs/Jan Malinowski2019-03-19T09:20:14ZSpecify the size of points and square in RandomPoint?
https://community.wolfram.com/groups/-/m/t/1635092
The following two lines generate almost exactly what I want:
pts = RandomPoint[Rectangle[], 250]
Graphics[{ImageSize->Small,PointSize[Tiny], Point[pts]}]
However, I want to be able to specify specific sizes for the points (i.e. diameter of 1.5 microns on a square that is 1000 um x 1000 um). Is there a way to do set these parameters?
If not, is there a good function in Python that would allow me to randomly plot circles of specific diameters on squares of specified size?Claire Ruddiman2019-03-18T19:36:50ZAutomate converting an imported excel spreadsheet to a dataset?
https://community.wolfram.com/groups/-/m/t/1566323
I would like to import a large excel spreadsheet with many columns into Mathematica. The first row of the spreadsheet contains the column headings and the remaining rows contain the data. After importing I first separate the column headings and data into separate variables and would like to convert the data to a dataset. Here is an example of what I have tried.
These steps simulate of importing the spreadsheet and separating into columns and data
cols = {"col1", "col2", "col3", "col4", "col5"};
dat = RandomReal[{0, 1}, {10, 5}];
I now need to create an association to use to map the data to the columns but here is where I am having trouble. The best I am able to come up with is to generate
assoc = Table[cols[[k]] -> #[[k]], {k, 1, 5}]
This results in some error messages, but produces
{"col1" -> 1, "col2" -> #1[[2]], "col3" -> #1[[3]], "col4" -> #1[[4]],
"col5" -> #1[[5]]}
which is nearly the result desired. I can then copy that result, paste it into a new cell, and edit that cell by hand, changing the first element of the list, applying an association function, and applying a function to get the desired function to apply to the data
assoc1 = Association[{"col1" -> #[[1]], "col2" -> #1[[2]],
"col3" -> #1[[3]], "col4" -> #1[[4]], "col5" -> #1[[5]]}] &
Map[assoc1,dat]
With this association I can then generate the dataset. Is there any way of generating this function without the necessity of the hand editing step?Mike Luntz2018-12-05T14:55:47ZNDSolve two coupled first order PDEs with specific boundary conditions?
https://community.wolfram.com/groups/-/m/t/1635326
Hi :-)
Reading and re-reading the NDSolve documentation, I don't understand the generic way to express boundary conditions. I want to solve the wave equation expressed as a system of two coupled first order equations on the voltage v(t,x) and current i(t,x). The initial v(0,x) has a bell shape and the initial i(0,x) is zero everywhere.
eq1 = D[v[t, x], x] + D[i[t, x], t] == 0;
eq2 = D[i[t, x], x] + D[v[t, x], t] == 0;
shape = D[0.125 Erf[(x - 0.5)/0.125], x];
ics ={v[0, x] == shape, i[0, x]==0};
Now the problem is to be numerically integrated with NDSolve over x in [0,1] and t in [0,2]. I want to specify either open ends v[t, 0] =v[t, 1]=0 or non reflective boundary conditions. In the first case I can do it:
region = Line[{{0}, {1}}];
bcs = {v[t, 0] == 0, v[t, 1] == 0};
sol = NDSolve[{eq1,eq2, ics, bcs}//Flatten, {v, i}, {t,0,2}, {x} \[Element] region]
How to do the same in the non-reflective (or impedence matched) case? All my attemps fail: calling
sol2 = NDSolve[{eq1,eq2, ics}//Flatten, {v, i}, {t,0,2}, {x} [Element] region]
without bcs renders a solution that does not correspond to the targeted case (by the way, which default bcs are assumed in this case?). Using v= Z i with Z=1 the wave and load impedence, i.e.
bcs2b = {v[t, 0] == i[t, 0] , v[t, 1] == i[t, 1]};
sol2b = NDSolve[{eq1,eq2, ics, bcs2b}//Flatten, {v, i}, {t,0,2}, {x} \[Element] region]
returns an error about "Cross-coupling of dependent variables in DirichletCondition".
bcs3c = {
Derivative[0,1][v][t, 0] ==-Derivative[1,0][i][t, 0] ,
Derivative[0,1][v][t, 1] ==-Derivative[1,0][i][t, 1] };
sol3c = NDSolve[{eq1,eq2, ics, bcs3c}//Flatten, {v, i}, {t,0,2}, {x} \[Element] region]
returns an error about too high order derivatives in boundary conditions.
How to proceed with this system of coupled first order PDEs? (note that I know how to do with a second order wave equation and Neumann values, but that's not my question). I want to express the conditions on v and i.
Thank you for your help.Denis Vion2019-03-18T19:56:07ZAvoid error with the following recursive code?
https://community.wolfram.com/groups/-/m/t/1634599
Thanks for any help! I must be doing something wrong in the following recursive code:
ClearAll[lim, hlim, count, e]
lim = 25;
hlim = lim/5;
count[heading_, v_] := count[heading, v] = Block[{nv = v},
If[Total[nv] == lim,
If[heading == 0, 1, 0],
If[nv[[heading]] == hlim, 0,
nv[[heading]] = nv[[heading]] + 1;
count[If[heading == 4, 0, heading + 1], nv] +
count[If[heading == 0, 4, heading - 1], nv]]]]
e[] := Module[{}, 2*count[1, {1, 0, 0, 0, 0}]]
e[] // Timing
I expect a number, but I get:
{0.007164,
870 If[List == 5, 0, nv[[0]] = nv[[0]] + 1;
count[If[0 == 4, 0, 0 + 1], nv] + count[If[0 == 0, 4, 0 - 1], nv]]}Joe Gilray2019-03-18T07:03:07ZAvoid .NET/Link error in Visual Studio 2015?
https://community.wolfram.com/groups/-/m/t/1634807
Hi All,
Hope you are all fine.
I am trying to maintain and extend the functionality of a very old C++ program (initially coded in 2009). It was using .NET/Link feature of Wolfram. However it does not have many documentation neither comments for the code. I've encountered a problem of compiling and running it with the error said:
Exception thrown: 'System.TypeLoadException' in mscorlib.dll
Exception thrown: 'System.DllNotFoundException' in Wolfram.NETLink.dll
Exception thrown: 'System.TypeInitializationException' in Wolfram.NETLink.dll
Exception thrown: 'System.TypeInitializationException' in [My Project].exe
I should mention that this happens in the very first beginning of the code:
kernel = nullptr;
kernel = MathLinkFactory::CreateKernelLink();
And the similar problem happens to me when I was trying to run the sample code from Wolfram official platform, it is a C# program though:
Exception thrown: 'System.TypeLoadException' in mscorlib.dll
Exception thrown: 'System.DllNotFoundException' in Wolfram.NETLink.dll
Exception thrown: 'System.TypeInitializationException' in Wolfram.NETLink.dll
'MathKernelApp.vshost.exe' (CLR v2.0.50727: MathKernelApp.vshost.exe)
I am not sure if this is a problem of environment setup or it is because of the incompatibility between Wolfram and Windows 10.
Operating System: Windows 10
IDE: Visual Studio 2015
Target Platform Version: 10.0.16299.0
Platfomr Toolset: Visual Studio 2015 (v140)
**A quick update:**
I have resolved problem in MathKernelApp provided by Wolfram by copying and pasting the ml64i4.dll into the Release folders. I thought it may help to my original problem but not. It is a separate problem and I still have no idea of how to fix the first one.Haifeng Zhao2019-03-18T00:41:44ZImport .dae 3D format files without ignoring nodes?
https://community.wolfram.com/groups/-/m/t/1633798
Collada .dae 3D format is in fact xml document which contains <library_geometries> section with some "meshes", where the coordinates and normals of surface meshes points are provided.
But that coordinates are not refereed to basic coordinate system. DAE file contains an other, <library_visual_scenes> section, which holds a tree of nested lists of "nodes" - transformation matrices describing coordinate transformation of the nested node from the parent one. And only the last, leaf node contains reference to some mesh name, so the mesh coordinate system is given by set of coordinate transformation. A lot of 3D modelling soft exports a set of model "parts" in very such way.
Looks like Mathematica Import[] function do not take into account nodes section, so imported complex models have details teared apart and grouped near the center of coordinates. Import[SomeModel, "CoordinateTransform"] provides a single and unit transformation matrix not changes at all on change of "nodes" matrices
1. Have tried to import some .dae models. Import[SomeModel, "MeshRegion"] and Import[SomeModel, "GraphicsComplex"] both give the same teared apart result.
2. Coded some handmade parser, which extracts meshes from <library_geometries> and provides the resulting set of 3D surfaces without additional transformations - completely the same "teared" result as in stage 1.
3. Coded additional parser, which extracts a set of transformation matrices for every mesh, and applied a result to it - valid 3D model with the parts on proper places.
ps: it would be very convenient if Import[] did not "melts" all meshes in a single one, but provides them as a set of objects together with their transformation martices, or have a option for this.Snegirev Maksym2019-03-16T09:40:04ZGenerate Newton-Girald formula?
https://community.wolfram.com/groups/-/m/t/1634323
n = 2
I am not getting the determinant of the NW. Can somebody suggest what is wrong?
S[1] = Table[i*e[i], {i, 1, n}]
S[2] = {1, Table[e[i], {i, 1, n - 1}]}
S[3] = {0, 1, Table[e[i], {i, 1, n - 2}]}
For[i = 4; t = x, i < n + 1, i++,
S[i] = {ConstantArray[0, i - 2], ConstantArray[1, 1],
Table[e[j], {j, 1, n - i + 1}]}; Print[S[i]]]
EQ1 = Table[S[j], {j, 1, n}]
NW = MatrixForm[EQ1]
NW1 = Det[Transpose[NW]]Rajan Prasad2019-03-17T03:30:03ZIncrease mathematica's menu font size?
https://community.wolfram.com/groups/-/m/t/1634439
Hello, I have vision issues & need to increase the size of the font in my menu. Can someone tell me how to do this? Thanks, JeffreyJeffrey Denison2019-03-16T19:30:11ZAvoid issue in DateString?
https://community.wolfram.com/groups/-/m/t/1633972
Consider the following code:
DateString[{2000, 1, 1, 0, 0, 0}, {"Year", " ", "Month", " ", "Day",
" ", "SecondExact", " "}]
yields
2000 01 01 00.000
but
DateString[{2000,1,1,0,0,0},{"Year"," ","Month"," ","Day"," ","MinuteExact"," "}]
and
DateString[{2000,1,1,0,0,0},{"Year"," ","Month"," ","Day"," ","HourExact"," "}]
yield
2000 01 01 {0., QuantityMagnitude[Minute]}
and
2000 01 01 {0., QuantityMagnitude[Hour]}
respectively.
It does not seem like the units should be present in the last two cases for Minute and Hour.Vincent Virgilio2019-03-15T23:42:20Z