Community RSS Feed
https://community.wolfram.com
RSS Feed for Wolfram Community showing any discussions in tag Mathematics sorted by activeHas anybody implemented recently a Monte Carlo simulation?
https://community.wolfram.com/groups/-/m/t/1567932
Has anybody implemented recently a Monte Carlo simulation?Sergio Terrazas2018-12-08T19:49:50ZFinding all roots to equation
https://community.wolfram.com/groups/-/m/t/1568356
I'm currently doing some Mathematica exercises, and I'm stuck on this one task where you're supposed to plot the functions h(t)= |3-t^2|+|t-1|-t^2 , g(t)=3sin(t) in the same grap, and then find all the roots. This is what I've got so far:
![enter image description here][1]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=UHvxo.png&userId=1540567
The instructions say that I should use FindRoot to exactly decide all the roots, but I don't think I've done it right. What should I change with the function in order to make it find all of the roots?
Thanks in advance.Jhn Snd2018-12-09T11:50:45ZCan we improve coding for faster computation?
https://community.wolfram.com/groups/-/m/t/1567948
Hello, The problem of finding the coordinates of a triangular (equilateral) mesh discussed earlier is solved. It also counts the number of equilateral triangles formed by the intersecting parallel lines. But the problem is that the code takes more time for larger values of n i.e. the size of the side of the triangle. Can the code be improved? The code is given here. Thanks for any suggestion.
n = 4;
Print["Number of lines/size of triangle = ", n]
h = Sqrt[3] /2;
Array[x, n];
Array[s, n];
x[0] = {{n/2, n h}};
For[i = 1, i <= n, i++,
x[i] = Table[{x[0][[1, 1]] - i/2 + j, n h - i h}, {j, 0, i}]];
set = Apply[Union, Table[x[i], {i, 0, n}]];
Print["Number of vertices = ", Length[set]]
cond := (EuclideanDistance[#[[1]], #[[2]]] ==
EuclideanDistance[#[[2]], #[[3]]] ==
EuclideanDistance[#[[1]], #[[3]]] && #[[1]] != #[[2]] != #[[
3]] && #[[1, 1]] < #[[2, 1]] < #[[3,
1]] && (#[[1, 2]] == #[[2, 2]] || #[[2, 2]] == #[[3, 2]] || #[[
3, 2]] == #[[1, 2]]) &)
tr0 = Tuples[set, 3];
tr1 = Select[tr0, cond];
Print["Number of Triangles = ", Length[tr1]]jagannath debata2018-12-09T07:39:12ZPlot Poincare Map in order to analyze chaos
https://community.wolfram.com/groups/-/m/t/1567675
U[t] + 3 U[t]^2 + 6 V[t] + 3 V[t]^2 + 5 W[t] + 2 W[t]^2 + 4 U[t]*V[t] == 2 U'[t] ;
6 U[t] + 3 U[t]^2 + 3 V[t] + 4 V[t]^2 + 8 W[t] + 4 W[t]^2 + 3 U[t]*V[t] == V'[t];
5 U[t] + 3 U[t]^2 + 5 V[t] + 3 V[t]^2 + 8 W[t] + 4 W[t]^2 + 8 U[t]*V[t]+ Q*Sin[100*t] == W'[t] + 2 W''[t];
U[0] == V[0] == W[0], U'[0] == V'[0] == W'[0]==0.0001
Q=const
I need to plot a Poincare map with W [t], W '[t]. I am having trouble. I thank everyone.Vũ Ngọc Việt Hoàng2018-12-08T07:33:18ZSolve the differential equation by Runge Kutta method?
https://community.wolfram.com/groups/-/m/t/1563269
I need to solve the equation as follows by numerical methods such as Runge Kutta, Newton Raphson, ... Hope everyone help me. I thank everyone.
![enter image description here][1]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=Untitled.png&userId=1563397Vũ Ngọc Việt Hoàng2018-12-01T15:10:42ZNMinimize calling a own defined function with findroot
https://community.wolfram.com/groups/-/m/t/1567276
I defined my own function which solves a transcendental equation by using a findroot, and it works. But, when I call my own defined function with NMinimize, it gives me an error. I do not understand where it comes from. Attached please find my code. Please let me know if you know where the problem might be.Mario Junior Mencagli2018-12-07T05:10:37ZAvoid problem using "Nested" NMaximize?
https://community.wolfram.com/groups/-/m/t/1566000
I'm having trouble with NMaximize in the following code (this is an example of my real problem, I know that this example has an exact analytical solution).
This part works just fine, is the clasical consumer maximization problem :
Util[x_, y_, a_] := x^a* y^(1 - a)
UtilMax[a_, px_, py_, P_] := Module[{temp, UtilMax, XYOptim},
temp = NMaximize[{Util[x, y, a], px*x + py*y <= P, x > 0,
y > 0}, {x, y}];
UtilMax = temp[[1]];
XYOptim = {x, y} /. Last[temp];
Flatten[{XYOptim, UtilMax}]]
Sales[vecAlfa_, vecP_, px_, py_] := Module[{temp},
temp = Table[
UtilMax [vecAlfa[[i]], px, py, vecP[[i]]], {i, 1,
Length[vecAlfa]}];
Sum[temp[[i, 1]] + temp[[i, 2]], {i, 1, Length[vecAlfa]}]
]
vecAlfa = {0.1, 0.9};
vecP = {10, 20};
Test that the functions are working ok:
In[6]:= UtilMax[vecAlfa[[1]], 5, 5, vecP[[1]]]
UtilMax[vecAlfa[[2]], 5, 5, vecP[[2]]]
Sales[vecAlfa, vecP, 5, 5]
Out[6]= {0.2, 1.8, 1.44493}
Out[7]= {3.6, 0.4, 2.88987}
Out[8]= 6.
The problem arises with the followin part:
NMaximize[{Sales[vecAlfa, vecP, px, py], 0 < px < 100, 0 < py < 50}, {px, py}]
During evaluation of In[10]:= NMaximize::bcons: The following constraints are not valid: {x>0,y>0,px x+py y<=10}. Constraints should be equalities, inequalities, or domain specifications involving the variables. >>
During evaluation of In[10]:= ReplaceAll::reps: {x,y} is neither a list of replacement rules nor a valid dispatch table, and so cannot be used for replacing. >>
During evaluation of In[10]:= NMaximize::bcons: The following constraints are not valid: {x>0,y>0,px x+py y<=20}. Constraints should be equalities, inequalities, or domain specifications involving the variables. >>
During evaluation of In[10]:= ReplaceAll::reps: {x,y} is neither a list of replacement rules nor a valid dispatch table, and so cannot be used for replacing. >>
During evaluation of In[10]:= NMaximize::nnum: The function value -x^0.9 y^0.1-x^0.1 y^0.9-2 ({x,y}/. {x,y}) is not a number at {px,py} = {1.91862,1.66351}. >>
Out[10]= NMaximize[{x^0.9 y^0.1 + x^0.1 y^0.9 + 2 ({x, y} /. {x, y}),
0 < px < 100, 0 < py < 50}, {px, py}]
Any idea what could I've been doing wrong?Augusto Umaña2018-12-06T05:47:13ZFind the Coordinates of a triangular mesh?
https://community.wolfram.com/groups/-/m/t/1565820
Hello , I have an equilateral triangle with vertices at {0,0},{4,0} and {2,2 Sqrt[3]}. Three points on each side are taken dividing the side into four equal parts .These points are joined so as to draw lines parallel to the sides. How do we get the coordinates of the intersecting points of the triangular mesh obtained? For example {{1/2,sqrt[3]/2},{1,0},{0,0}} is a triangle. Thanks for any help.jagannath debata2018-12-04T16:04:49ZFind the curvature of an object from an image
https://community.wolfram.com/groups/-/m/t/1562821
`curvatureMeasure.m` is a Mathematica script for calculating curvature along the boundary of an image object. It might be useful to people working in the computer vision community. This simple script can be easily extended to even track the curvature of an object as it deforms (will add soon) across several images.
Here is our input image:
![enter image description here][1]
boundary is discretized into equidistant points
![enter image description here][2]
circle fits to a given point point Pi, Pi + N-left, Pi + N-right, where N is the neighbour to the point Pi.
![enter image description here][3]
curvatures (found as 1/radius) is the colormap:
![enter image description here][4]
**code**
(* ::Package:: *)
BeginPackage["curvatureMeasure`"];
curvatureMeasure::usage = "measures the curvature along the image object";
Begin["`Private`"];
shiftPairs[perimeter_,shift_]:=Module[{newls},
newls=perimeter[[-shift;;]]~Join~perimeter~Join~perimeter[[;;shift]];
Table[{newls[[i-shift]],newls[[i]],newls[[i+shift]]},{i,1+shift,Length[newls]-shift}]
];
(* we can either use the suppressed code below to fit circles or the Built-In Circumsphere to find the fits
(* from Mathematica StackExchange: courtesy ubpdqn *)
circfit[pts_]:=Module[{reg,lm,bf,exp,center,rad},
reg={2 #1,2 #2,#2^2+#1^2}&@@@pts;
lm=LinearModelFit[reg,{1,x,y},{x,y}];
bf=lm["BestFitParameters"];
exp=(x-#2)^2+(y-#3)^2-#1-#2^2-#3^2&@@bf;
{center,rad}={{#2,#3},Sqrt[#2^2+#3^2+#1]}&@@bf;
circlefit[{"expression"->exp,"center"->center,"radius"->rad}]
];
circlefit[list_][field_]:=field/.list;
circlefit[list_]["Properties"]:=list/.Rule[field_,_]:>field;
circlefit/:ReplaceAll[fields_,circlefit[list_]]:=fields/.list;
Format[circlefit[list_],StandardForm]:=HoldForm[circlefit]["<"<>ToString@Length@list<>">"]
*)
curvatureMeasure[img_Image,div_Integer,shift_Integer]:=Module[{\[ScriptCapitalR],polygon,t,interp,sub,sampledPts,
pairedPts,circles,\[Kappa],midpts,regMem,col,g,fn},
\[ScriptCapitalR] = ImageMesh[img, Method -> "Exact"];
polygon = Append[#,#[[1]]]&@MeshCoordinates[\[ScriptCapitalR]][[ MeshCells[\[ScriptCapitalR],2][[1,1]] ]];
t = Prepend[Accumulate[Norm/@Differences[polygon]],0.];
interp = Interpolation[Transpose[{t,polygon}],InterpolationOrder -> 1,
PeriodicInterpolation->True];
sub = Subdivide[interp[[1,1,1]],interp[[1,1,2]],div];
sampledPts = interp[sub];
Print[Show[\[ScriptCapitalR],Graphics@Point@sampledPts,ImageSize-> 250]];
pairedPts = shiftPairs[sampledPts, shift];
circles = (Circumsphere/@pairedPts)/. Sphere -> Circle;
(*circles = (fn=circfit[#]; Circle[fn["center"],fn["radius"]])&/@pairedPts;*)
Print[Graphics[{{Red,Point@sampledPts},{XYZColor[0,0,0,0.1],circles}}]];
\[Kappa] = 1/Cases[circles,x_Circle:> Last@x];
midpts = Midpoint/@pairedPts[[All,{1,-1}]];
regMem = RegionMember[\[ScriptCapitalR],midpts]/.{True-> 1,False-> -1};
\[Kappa] *= regMem;
col = ColorData["Rainbow"]/@Rescale[\[Kappa], MinMax[\[Kappa]],{0,1}];
g = Graphics[{PointSize[0.018],MapThread[Point[#1,VertexColors->#2]&,{sampledPts,col}]}];
Print[Show[HighlightMesh[\[ScriptCapitalR],{Style[1, Black],Style[2,White]}],g,ImageSize->Medium]];
\[Kappa]
]
End[];
EndPackage[];
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=inputImage.png&userId=942204
[2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=mesh.png&userId=942204
[3]: https://community.wolfram.com//c/portal/getImageAttachment?filename=curvatureFitstoShape_cropped.png&userId=942204
[4]: https://community.wolfram.com//c/portal/getImageAttachment?filename=curvatureFinal.png&userId=942204Ali Hashmi2018-11-30T07:26:13ZEdit specific parts of vector fields?
https://community.wolfram.com/groups/-/m/t/1565312
I would like to take a specific part of a given vector field, and make all the vectors bold.
For example, I want to take the {x, y} vector field, and make all the vectors from x=0 to x=10 to be
bold, and the rest of the field to be regular. I would appreciate it if anyone could help me figure this out!Hafez Rais2018-12-04T05:24:35ZGet 3358th digit of Pi, E and Phi using W|A?
https://community.wolfram.com/groups/-/m/t/1564133
According to subidiom.com the first occurrence of 1984 on Pi is at the 3358th decimal digit.
http://www.subidiom.com/pi/pi.asp
![enter image description here][1]
I can use the command "3359 digit of pi" to get a similar output on WolframAlpha including nearby digits as you can see below.
http://m.wolframalpha.com/input/?i=3359+digit+of+pi
Unfortunately it doesn't seem to work with e or phi. Does someone have a workaround for that ?
Thanks,
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=F22D299C-8F24-4047-9F52-CAA9DC8A2271.png&userId=1562578Renan José2018-12-02T23:51:41ZString Art
https://community.wolfram.com/groups/-/m/t/1563492
In the United States from the late 1960s to the early 1970s there was a fad for making [string art][1]. In basement workshops and garages all over the country, amateur artists whiled away their free time stringing colorful bits of yarn between little tacks hammered into felt-covered plywood. The resulting artwork looked vaguely mathematical, and I recall that a photograph of one such piece graced the cover of my seventh grade mathematics textbook.
For this post, imagine 360 tacks spaced evenly around a circle. Beginning at the top (i.e., the 12:00 position) label the tacks from 0 to 359 proceeding clockwise. Choose a constant *m*. Then, for points *i* = 0 to 359, draw a line (or string a piece of yarn if you wish) between tack *i* and tack (*i m*) mod 360.
Different values of m produce different patterns, but allowing m to vary smoothly between 1 and 360 produces a psychedelic effect that might have inspired Dr. Timothy Leary back in the day.
![String Art][2]
The Mathematica code is very simple:
base = 360;
max = 359;
plist = {Sin[(2.*Pi*#/base)], Cos[2.*Pi*#/base]} & /@
Range[0, base - 1];
colors = Table[Hue[x], {x, 0, 1, 1./base}];
zlist[p_, m_] :=
Table[{p[[i + 1]], p[[Mod[IntegerPart[m*i], base] + 1]]}, {i,
base - 1}]
stringArt =
Animate[Graphics[{colors[[IntegerPart[m]]],
Line[zlist[plist, m]]}], {m, 1.1, base - 0.1, 0.1},
AnimationRate -> 3, AnimationRunning -> True,
AnimationDirection -> Forward, AnimationRate -> .1]
The gif doesn't really do it justice; to get the full effect I suggest you run the code in your own copy of Mathematica.
[1]: https://en.wikipedia.org/wiki/String_art
[2]: https://community.wolfram.com//c/portal/getImageAttachment?filename=stringart.gif&userId=66744John Shonder2018-12-01T21:45:03ZCalculate and plot the roots of a polynomial?
https://community.wolfram.com/groups/-/m/t/1565716
Hi, on mathematica I have represented the following polynomial a * x ^ 4 + b * x ^ 2 + c * x + 2 using the "Plot" command and, through the "Manipulate" command, it is possible to vary the parameters a, b, c. Now, however, I would like the program to give me back the roots of the polynomial according to the parameters a, b, c .... could you help me kindly?
This is the code:
Manipulate[
Plot[a*x^4 + b*x^2 + c*x + 2, {x, -20, 20},
PlotRange -> {{-20, 20}, {-20, 20}}],
{a, -1, 1}, {b, -10, 10}, {c, -10, 10}, ControlPlacement -> Right]Pasquale Rossi2018-12-04T19:00:18ZDisplay a specific part of an output?
https://community.wolfram.com/groups/-/m/t/1563923
Hello,
I have created a code that can expand an expression then groups the output in terms of exponential powers. My code deals with the Homotopy Analysis Method. In this method the goal is to collect secular terms. As my interest is only these terms I am inquiring to see if there is a way to tell Mathematica to display only these terms and not the rest of the expansion. Below is an image of the expansion and collection of terms. I just want the output to display e^(i*w*t). I've attached the code for reference. Any help is appreciated.
![I just want the output to display e^(i*w*tau)][1]
[1]: https://community.wolfram.com//c/portal/getImageAttachment?filename=mathematicacode.JPG&userId=1190441Christopher Reyes2018-12-02T04:39:48ZNonlinear feedback system
https://community.wolfram.com/groups/-/m/t/1564351
I have a set of nonlinear equation which i have solve it by using AffineStateSpaceModel. My code is given below. I have the following query
1.Is it correct to use OutputResponse syntax to find the solution of the AffineStateSpaceModel.
2.I use interpFN to extract each of the output from the solution. Is there any alternative way to extract the solution so that i can plot the graph.
3.And finally I wanted to use If condition as input value which I am unable to do it.
Kindly help me. Thanks in advance
{i1 = 10, i2 = -1, i3 = 0.9, i4 = Abs[Sqrt[1 - i3^2]], mu1 = 1,
mu2 = 0, mu3 = 0}
nsys = AffineStateSpaceModel[{{x3, x4, 0, 0, 0, 0, 0.6 x9, 0.6 x10, 0,
0, 0, 0},
{{0, 0}, {0, 0}, {x5, 0}, {x6, 0}, {-x3, 0}, {-x4, 0}, {0, 0}, {0,
0}, {0, 0.6 x11}, {0, 0.6 x12}, {0, -0.6 x9}, {0, -0.6 x10}},
{x1, x2, x7, x8, x1 - x7, x2 - x8, 0.6 x10 - x4, x3 - 0.6 x9}},
{{x1, i1}, {x2, i2}, {x3, i3}, {x4, i4}, {x5, -i4}, {x6, i3}, {x7,
0}, {x8, 0}, {x9, 1}, {x10, 0}, {x11, 0}, {x12, 1}}]
sol = OutputResponse[nsys,
{-mu1*Dot[
Normalize[{x1[t] - x7[t], x2[t] - x8[t]}], {0.6 x10[t] - x4[t],
x3[t] - 0.6 x9[t]}]
- mu2*
Integrate[
Dot[Normalize[{x1[t] - x7[t], x2[t] - x8[t]}], {0.6 x10[t] -
x4[t], x3[t] - 0.6 x9[t]}], t]
- mu3*
Dot[Normalize[{x1[t] - x7[t],
x2[t] - x8[t]}], {.36 x12[t] Dot[
Normalize[{x1[t] - x7[t], x2[t] - x8[t]}], {-x10[t],
x9[t]}], -.36 x11[t] Dot[
Normalize[{x1[t] - x7[t], x2[t] - x8[t]}], {-x10[t],
x9[t]}]}],
Dot[Normalize[{x1[t] - x7[t], x2[t] - x8[t]}], {-x10[t], x9[t]}]},
{t, 0, 300}];
u1 = interpFN = sol[[1]];
u2 = interpFN = sol[[2]];
u3 = interpFN = sol[[3]];
u4 = interpFN = sol[[4]];
u5 = interpFN = sol[[5]];
u6 = interpFN = sol[[6]];
u7 = interpFN = sol[[7]];
u8 = interpFN = sol[[8]];
ParametricPlot[{{u5, u6}}, {t, 0, 20}, Mesh -> 40,
GridLines -> Automatic]
{ParametricPlot[{{u1, u2}, {u3, u4}}, {t, 0, 15},
PlotLegends -> {"pursuer", "evader"}, Frame -> True,
GridLines -> Automatic, Mesh -> 10],
ParametricPlot[{{u1, u2}, {u3, u4}}, {t, 0, 20},
PlotLegends -> {"pursuer", "evader"}, Frame -> True,
GridLines -> Automatic],
ParametricPlot[{{u1, u2}, {u3, u4}}, {t, 0, 30},
PlotLegends -> {"pursuer", "evader"}, Frame -> True,
GridLines -> Automatic, Mesh -> 30],
ParametricPlot[{{u1, u2}, {u3, u4}}, {t, 0, 300},
PlotLegends -> {"pursuer", "evader"}, Frame -> True,
GridLines -> Automatic]}
r = EuclideanDistance[{u1, u2}, {u3, u4}]
Plot[r, {t, 0, 30}, GridLines -> Automatic, AxesLabel -> {t, "r"}]
gamma = Dot[Normalize[{u5, u6}], Normalize[{u7, u8}]]
Plot[gamma, {t, 0, 30}, GridLines -> Automatic,
AxesLabel -> {t, \[CapitalGamma]}]OBIROY LAIRENJAM2018-12-03T19:11:23Z