Community RSS Feed
https://community.wolfram.com
RSS Feed for Wolfram Community showing any discussions in tag Mathematica sorted by activeSymbolic 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:21ZNIntegrate
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:19ZImport 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:17ZImport .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:04ZIncrease 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 leaky symbols in "Install Wolfram System Item"?
https://community.wolfram.com/groups/-/m/t/1634031
The first execution of dialog "File > Install …" fails in its field "Source" if symbols x or s\$ exist in the context path. The second execution of same dialog clears the errors, whereupon field "Source" appears to work properly. The second execution does /not/ remove or clear symbols x and s\$; they are still in the context path in multiple locations.Vincent Virgilio2019-03-16T00:44:42ZUpdate AppendTo when interacting with PopupMenu?
https://community.wolfram.com/groups/-/m/t/1632919
I'm trying to `ListPlot` a list calculated by the `Button` called "Plot" with `PopupMenu` linked to `ListPlot` to control the temperature units of displayed data, for example: if `"DegreesCelsius" -> "C"` is selected from the list then `ListPlot` should show plotted curve in `"DegreesCelsius"` and the same goes for `"DegreesFahrenheit"`. `AppendTo` is used here to `ListPlot` new list every time the input of `InputField` is changed and `Button` is pressed by appending it to the old one.
My Problem is that the temperature units of the plotted curves don't change when selecting different values from `PopupMenu`. `AppendTo` doesn't update accordingly. I can see that `popupSelection` variable changes when interacting with `PopupMenu` but `plotData` variable only changes when `Button` is pressed, using current `PopupMenu` selection.
If I remove `AppendTo` from `Button` and include `dataSet4:=Transpose[...]` instead, as well as keeping it in `Initialization` everything works as I wanted. I tried to make several changes by shifting things around but nothing helped.
Please Help!
The example below demonstrates the issue.
DynamicModule[{},
inputList = {{1, 5}, {2, 4}, {3, 8}};
Dynamic@Column[{
InputField[Dynamic[inputData]],
Dynamic@Button["Plot",
dataSet1 = Map[Norm, Differences[inputList]];
dataSet2 = Exp[-N[Pi]*0.345*5*dataSet1/(10*2000)];
dataSet3 = FoldList[10 + (#1 - 10)*#2 &, inputData, dataSet2];
AppendTo[plotData, dataSet4]], Spacer[5],
PopupMenu[Dynamic[popupSelection], {"DegreesCelsius" -> "C", "DegreesFahrenheit" -> "F"}],
ListPlot[plotData, Joined -> True, ImageSize -> {300}, Frame -> True]}],
Initialization :> (
popupSelection = "DegreesCelsius";
inputData = 0;
plotData = {};
dataSet3 = {0};
dataSet4 := Transpose[{inputList[[All, 1]], QuantityMagnitude@UnitConvert[QuantityArray[dataSet3, "DegreesCelsius"], popupSelection]}];),
SynchronousInitialization -> False]Kamila Szklarczyk-Marshall2019-03-15T14:46:49Z[Numberphile] - The Square-Sum Problem
https://community.wolfram.com/groups/-/m/t/1264240
As part of my Numberphile series of posts:
- [\[Numberphile\] - Frog Jumping - Solving the puzzle][1]
- [\[Numberphile\] - The Illumination Problem][2]
- [\[Numberphile\] - Sandpiles - Done in the Wolfram Language][3]
here is another one about a recent video called [The Square-Sum Problem][4]
[![enter image description here][5]][6]
The question is: if you have the integers 1 through n, can you arrange that list in such a way that every two adjacent ones sum to a square number. As seen in the video and the [extra footage][7].
We can easily check this in the Wolfram Language:
Let's see which number can pair up to a pair:
SquareEdges[n_Integer?Positive]:=Reap[Do[If[IntegerQ[Sqrt[i+j]],Sow[{i,j}]],{i,n-1},{j,i+1,n}]][[2,1]]
Now let's try for 15, as in the main video:
n = 15;
poss = SquareEdges[n];
gr = Graph[TwoWayRule @@@ poss, VertexLabels -> Automatic];
path = FindHamiltonianPath[gr, PerformanceGoal :> "Speed"]
HighlightGraph[gr, BlockMap[Rule @@ # &, path, 2, 1]]
giving:
{9, 7, 2, 14, 11, 5, 4, 12, 13, 3, 6, 10, 15, 1, 8}
![enter image description here][8]
In the extra footage, it is revealed that they found the solution for up to n=299. Can we do better? Yes we can! Changing n to 300 in the above code and rerunning gives us the solution in 0.28 sec on my laptop.
{289,35,65,259,30,294,67,257,32,292,69,100,44,125,71,154,135,189,211,113,248,8,281,119,205,195,166,158,283,6,250,191,133,156,285,4,252,277,12,244,117,207,193,168,273,16,240,160,164,236,20,269,131,94,230,59,197,92,232,57,199,90,234,22,267,217,224,137,152,73,123,46,150,75,121,48,148,77,179,110,214,270,19,237,163,161,239,17,272,128,41,103,297,27,262,62,227,97,99,190,210,114,175,50,146,79,177,112,212,188,253,3,286,155,134,266,23,233,91,198,58,231,93,196,60,229,95,130,159,165,276,13,243,118,206,194,167,274,15,241,288,1,255,186,138,223,218,143,181,108,88,201,55,170,86,203,53,172,84,37,107,182,142,299,25,264,220,221,140,184,216,225,64,36,85,171,54,202,87,169,56,200,89,235,21,268,132,157,284,5,251,278,11,245,116,208,192,249,7,282,247,9,280,204,120,136,153,72,124,45,151,74,122,47,149,76,180,109,215,185,139,222,219,265,24,300,141,183,106,38,83,173,52,144,81,40,104,296,28,261,63,226,98,127,42,102,298,26,263,61,228,96,129,271,18,238,162,279,10,246,115,209,275,14,242,287,2,254,187,213,111,178,78,147,49,176,80,145,51,174,82,39,105,295,29,260,101,43,126,70,291,33,256,68,293,31,258,66,34,290}
and a completely mess of a graph:
![enter image description here][9]
Can we go beyond? Let's optimize a code a bit, and let's find the solution for larger n:
Let's store our intermediate results in the association **db**:
SetDirectory[NotebookDirectory[]];
$HistoryLength=1;
db=If[FileExistsQ["squaresumdb.mx"],
Import["squaresumdb.mx"]
,
<||>
];
And now our main code:
ClearAll[SquareEdges,SquareEdges2,CheckSol,TryToFind]
SquareEdges[n_Integer?Positive]:=Reap[Do[If[IntegerQ[Sqrt[i+j]],Sow[{i,j}]],{i,n-1},{j,i+1,n}]][[2,1]]
SquareEdges2[n_Integer]:=Module[{tmp},
tmp=Table[
{i,#}&/@(Range[Ceiling[Sqrt[2 i]],Floor[Sqrt[i+n]]]^2-i)
,
{i,1,n-1}
];
tmp=Join@@tmp;
Select[tmp,Less@@#&]
]
CheckSol[l_List]:=Sort[l]===Range[Length[l]]\[And](And@@BlockMap[IntegerQ@*Sqrt@*Total,l,2,1])
TryToFind[n_Integer?Positive]:=Module[{edges,out},
If[!KeyExistsQ[db,n],
edges=SquareEdges2[n];
If[Union[Flatten[edges]]===Range[n],
edges=TwoWayRule@@@edges;
edges=RandomSample[edges];
Do[
out=TimeConstrained[FindHamiltonianPath[Graph[edges],PerformanceGoal:>"Speed"],5+i,$Failed];
If[out=!=$Failed,
If[Length[out]==0,
Print[Style["No solution for ",Red],n];
,
status=Row[{"Found solution for ",n,":",i}];
];
AssociateTo[db,n->out];
Break[]
];
Print["Failed ",n,":",i];
edges=RandomSample[edges];
,
{i,5}
]
,
Print["Edges are not connected for ",n];
AssociateTo[db,n->{}]
]
]
]
Let's scan the first 1000:
Dynamic[status]
status = "";
Do[TryToFind[k], {k, 3, 1000}]
Export["squaresumdb.mx", db];
Note that if finding the Hamiltonian path takes too long I mix the edges and try again, sometimes, seemingly random, it then finds the solution quickly.
I can tell you now that all of them have a solution. In fact I went up to larger numbers and found that all up to 2667 have a solution, and possibly beyond. I attached the notebook and the solutions in form of a mx file.
[1]: http://community.wolfram.com/groups/-/m/t/1055504
[2]: http://community.wolfram.com/groups/-/m/t/1048489
[3]: http://community.wolfram.com/groups/-/m/t/1058615
[4]: https://www.youtube.com/watch?v=G1m7goLCJDY
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-11at23.36.51.png&userId=73716
[6]: https://www.youtube.com/watch?v=G1m7goLCJDY
[7]: https://www.youtube.com/watch?v=7_ph5djCCnM
[8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-11at23.43.52.png&userId=73716
[9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2018-01-11at23.46.51.png&userId=73716Sander Huisman2018-01-11T23:29:05Z[GIF] Mochi For Pie Day
https://community.wolfram.com/groups/-/m/t/1632354
####*Please download the notebook at the end of the discussion*
----------
![loop][1]
The idea is from the study of the graphical representation of [this inequality][2]: for positive $a$ $b$ and $c$
$\frac{1}{a+2b}+\frac{1}{b+2c}+\frac{1}{c+2a} \le \sqrt{ \frac{a+b+c}{3abc}}$
Usually this type of problems is not AM-GM or Cauchy-Schwartz or Muirhead friendly. Very tricky to use elementary methods and they are pooly generalized to other similar case, because they highly depends on the convexity of quadratic function and critical infomation like $C^{\infty}$ is not respected.
The animation is for a generalized form of the aforementioned inequality.
WLOG (based on homogenity of power on both LHS and RHS) let's assume $a + b + c = 1$ and parameterize them with spherical coordinate:
a = (Cos[\[Theta]] Sin[\[Phi]])^2;
b = (Cos[\[Theta]] Cos[\[Phi]])^2;
c = Sin[\[Theta]]^2;
The original equation is thus reduced to this form:
expr = Sqrt[3*a*b*c]*(1/(a + 2*b) + 1/(b + 2*c) + 1/(c + 2*a));
and the inequality problem automatically transforms to an optimization problem.
maxima = Table[
FindMaximum[
expr, {{\[Phi], x}, {\[Theta], y}}], {x, {1}}, {y, {0.5, 2.5}}]
Label the maxima:
![graph][3]
I suspect the magic $3$ on the RHS of the inequality comes from the coefficients of $1(a)+2(b)$ of the denominators on the LHS (no proof and is only true for some $\lambda$) , including the cyclic forms. Thus I replace the coefficients by $1+\lambda$ and $2-\lambda$ respectively, to keep their sum equal to 3. The animation is generated by sweeping through a set of different values of $\lambda$. $Tan^{-1}$ is used to make the animation slow-mo when approaching the end points of $\lambda$ domain. The visual is smooth and soothing.
constant=N[ArcTan/@(Range[0,40,2.]*0.1)]*0.9
frames=(0.5-Reverse@constant)~Join~(0.62+constant);
ListPlot[frames]
![plot][4]
The animation is interesting to look at. One of the unusual behavior is that the function has very flat top when $\lambda$ is close to $1.7$, the [Rosenbrock function like plateau][5] makes it very hard to find extrema.
I call it mochi because the wavy transformation of the 3D graphics in the animation resembles [this video clip of baking japanese rice cake][6].
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=3952loop3.gif&userId=23928
[2]: https://artofproblemsolving.com/community/c6h1800806p11954963
[3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=1925graph.png&userId=23928
[4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=giphy2.gif&userId=23928
[5]: http://mathworld.wolfram.com/RosenbrockFunction.html
[6]: https://youtu.be/C5C8GQnI7C0?t=34Shenghui Yang2019-03-14T16:54:20ZAvoid issue while using RegionPlot?
https://community.wolfram.com/groups/-/m/t/1631786
My simple code
o1 = Rectangle[{0, 0}, {3, 2}];
o2 = Disk[{3, 1}, 0.5];
o = RegionDifference[o1, o2];
RegionPlot[o, PlotRange -> Full]
DiscretizeRegion[o]
Produces this strange output. It seems to me, that the RegionPlot output is not OK, beacuse the shape of the region is different. Function DiscretizeRegion works as expected..
![Screenshot][1]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=regionplot.jpg&userId=143709Tomáš Hruš2019-03-14T09:12:13ZPerformance reduction of FindMinimum in version 10
https://community.wolfram.com/groups/-/m/t/868933
When working on [this question][1] dedicated to what I believe is a significant limitation/defect of the current implementation of the `"LevenbergMarquardt"` algorithm in `FindMinimum`, I found that the same code evaluates 15 - 25 times slower in version 10.4.1 as compared to version 8.0.4 on the same machine!
At the bottom of this post a Notebook containing the complete setup reproducing the issue is attached.
The following is a comparison of absolute timings of the same `FindMinimum` code evaluated with the two versions along with the number of steps taken by `FindMinimum`, achieved minimum and obtained new values of parameters of the model. The setup can be found in the attached Notebook.
With version 8.0.4 on Windows 7 x64 I get the following:
findMinimum[init, MaxIterations -> 500, WorkingPrecision -> 20, PrecisionGoal -> 3,
StepMonitor :> ++steps, Method -> {"LevenbergMarquardt", "Residual" -> residualVect}]
> {"00:06:35", 220, 0.00405321003823167,
> {ν0[1]->406.18, Γ[1]->346.16, ζ[2]->0.22879, ν0[2]->666.41, Γ[2]->239.54, ζ[3]->0.20278}}
The output means that the evaluation has taken 6 min 35 sec and finished in 220 steps, obtained minimum is `0.00405321003823167`, the obtained new values of the parameters follow.
And this is what I get with version 10.4.1 installed on the same machine:
findMinimum[init, MaxIterations -> 500, WorkingPrecision -> 20, PrecisionGoal -> 3,
StepMonitor :> ++steps, Method -> {"LevenbergMarquardt", "Residual" -> residualVect}]
> {"02:37:07", 220, 0.00405321003823167,
> {ν0[1]->406.18, Γ[1]->346.16, ζ[2]->0.22879, ν0[2]->666.41, Γ[2]->239.54, ζ[3]->0.20278}}
As you see, the only difference is that now the evaluation has taken 2 hours 37 min 7 sec! **It is more than 23 times slower than with version 8.0.4!**
----------
Do you experience the same problem? Is it possible to get `FindMinimum` of version 10.4.1 working as fast as `FindMinimum` of version 8.0.4?
[1]: http://mathematica.stackexchange.com/q/116295/280Alexey Popkov2016-06-07T09:49:31ZArrowHead not at the end of a tube? (Mathematica V11.3)
https://community.wolfram.com/groups/-/m/t/1302365
With the 11.3 version the combination Arrow Tube give unexpected results : the arrow head is not positionned at the end of the tube as expected from documentation :
http://reference.wolfram.com/language/ref/Arrow.html
3rd example of the basics
Code example :
Graphics3D[{Red, Arrowheads[0.1],
Arrow[Tube[{{1, 1, -1}, {2, 2, 0}, {3, 3, -1}, {4, 4, 0}}, 0.05]]}]Dominique Massiot2018-03-14T17:17:07Z