Community RSS Feed
http://community.wolfram.com
RSS Feed for Wolfram Community showing any discussions in tag Wolfram Sciencesearch.php sorted by activeHow to resolve a simple issue...maybe simple
http://community.wolfram.com/groups/-/m/t/1206935
If I have a simple integral that I wish to solve numerically, such as NIntegrate[x^a, {a, 1., 2., .1}],
often on the first evaluation, I just get the function back since x is undefined.
However, the second time I do this, I get:
"NIntegrate::inumr: The integrand x^a has evaluated to non-numerical values for all sampling points in the region with boundaries {{1.,2.}}"
When I ClearAll or Clear x and the variable, the integral still tries to evaluate and I get the same statement as above.
Why does Mathematica try to evaluate the integral when all terms are not defined? In other more complex functions, if I miss a variable or screw up the syntax, the function does not evaluate and the function is repeated as the output, and I get no statement such as the above, which is a cue to look for a syntax error.
Also, in some cases, when I set up the accuracy and precision to be some value and set the working precision to be twice these values, I also get inane statements like "the precision in the argument is less than the working precision." Of course it is!!
These behaviors likely have an obvious cause and can likely be simply explained...I hope.
Thanks for the help.
LutherLuther Nayhm2017-10-22T14:15:51ZDisplay system of 4 equations dependent on time and each other
http://community.wolfram.com/groups/-/m/t/1206858
Hi everyone,
I do not have much experience with Mathematica and I am hoping to use it to display a system of four equations, where I can set and change the starting values and visualize how the system always reaches equilibrium. I've taken advanced math courses but it has been a while since I've tried to do something like this. I think I've been able to come up with the correct equations, but I'm struggling to find a way to visualize them. Can you help?
My code is below. I added in spaces for ease of reading. I also attached them as a Wolfram file.
Plot [ {A (x >= 1) == ((G (x - 1))/25) - ((A (x - 1))/25) +
A (x - 1),
G (x >= 1) == ((T (x - 1))/25) - ((A (x - 1))/50) + ((G (x - 1))/
50) + G (x - 1),
T (x >= 1) == ((A (x - 1))/25) - ((A (x - 1))/75) + ((G (x - 1))/
75) + ((T (x - 1))/75) + T (x - 1),
Y (x >= 1) == ((A (x - 1))/25) - ((A (x - 1))/75) + ((G (x - 1))/
75) + ((T (x - 1))/75) + Y (x - 1),
A (x < 1) == 30,
G (x < 1) == 20,
T (x < 1) == 15,
Y (x < 1) == 35},
{x, 0, 100}
]Jeff Powell2017-10-22T16:36:29ZTemperature in Champaign, IL from 1973-2017 - Visualization
http://community.wolfram.com/groups/-/m/t/1205691
Oftentimes when browsing the [DataIsBeautiful][1] subreddit I look at the content and think to myself, "this would be pretty easy to make in Wolfram Language," at which point I promptly forget I had that thought and move on to the next post (where I likely have the same thought).
Today I stumbled upon [a post][2] by user with a beautiful graphic visualizing the hourly temperature in Brooklyn from 1973 through 2017. This time I decided to act upon my "this would be pretty easy to make in Wolfram Language" thoughts, and went at it.
Wolfram Language's `WeatherData` functionality made gathering the temperatures a breeze (weather puns), and I was able to bring all the data into Mathematica with a single line of code:
WeatherData[Entity["City", {"Champaign", "Illinois", "UnitedStates"}],
"Temperature", {{1970, 1, 1}, Today, "Day"}]
After that it was just a matter of converting the degrees to Fahrenheit, getting the colors right (I really liked the colors in the original graphic, so I tried to mimic them), and then creating and formatting the rows (click to zoom).
[![Champaign Weather][3]][4]
I really don't want to take anything away from the original creator (here is a [GitHub link][5] with his R source code), as his was much more carefully done (he took care of leap years so his hours actually line up, etc...), I just wanted to demonstrate how easy it was to accomplish something similar in the Wolfram Language.
Here is [the notebook][6] (also attached) I used to create this (in the Cloud some things don't line up quite the same as they do on my Desktop, but the end result is the same). All that would be required to make this same chart for another city would be to edit the city entity in the first line of code, and perhaps edit the scaling to better accommodate the maximum and minimum temperature for that region.
----------
# CODE
champaignTemp=WeatherData[
Entity["City",{"Champaign","Illinois","UnitedStates"}],"Temperature",{{1970,1,1},Today,"Day"}];
datePath=champaignTemp["DatePath"]/.{x_,y_Quantity}:>{x,UnitConvert[y,"DegreesFahrenheit"]};
{min,max}=MinMax[datePath[[All,2]]]
![enter image description here][7]
mean=Mean@datePath[[All,2]]
![enter image description here][8]
$blendingColors={RGBColor[1/6,0,2/3],RGBColor[2/3,1/4,5/12],RGBColor[1,9/10,0]};
Graphics[Table[{Blend[$blendingColors,x],Disk[{8x,0}]},{x,0,1,1/8}]]
(*quick pic for looking at how the bleding will turn out*)
![enter image description here][9]
cf[x_]:=Blend[$blendingColors,x]
$legend=BarLegend[{cf[#]&,{0,1}},"Ticks"->{0,.5,1},"TickLabels"->(Style[#,FontFamily->"Avenir"]&/@
{Quantity[-10,"DegreesFahrenheit"],Quantity[45,"DegreesFahrenheit"],Quantity[100,"DegreesFahrenheit"]}),
LegendLabel->Style["Temperature",FontFamily->"Avenir"]];
scaledDatePath=datePath/.{x_,y_}:>
{x,Rescale[y,{Quantity[-10,"DegreesFahrenheit"],Quantity[100,"DegreesFahrenheit"]}]};
sortedScaledByYear=GroupBy[scaledDatePath,#[[1,1,1]]&];
Table[imgData[i]=Table[#,4]&/@(Blend[$blendingColors,#]&/@sortedScaledByYear[i][[All,2]])
//Transpose,{i,sortedScaledByYear//Keys}];
imgData[2017]=Transpose[Join[imgData[2017]//Transpose,
Table[{White,White,White,White},365-Length@Last@sortedScaledByYear]]];
grid=Grid[
Join[
{{Null,Column[{Style["Daily Temperature in Champaign, IL",FontFamily->"Helvetica",
18,Bold],Style["1973 - 2017",FontFamily->"Avenir",13]}],SpanFromLeft}
},
Table[{Style[i,FontFamily->"Avenir"],Image[imgData[i],ImageSize->1200],SpanFromLeft},
{i,sortedScaledByYear//Keys}],
{{Null,Style["January",FontFamily->"Avenir",13],Style["December",FontFamily->"Avenir",13]}}
]
,
Spacings->{.5,0.1},
Alignment->{{Left,Left,Right},Top}
];
final=Framed[Labeled[grid,$legend,Right],ImageMargins->10,FrameStyle->None]
SetDirectory[NotebookDirectory[]];
finalImg=Rasterize[final,ImageResolution->200]
Export["ChampaignWeather.png",finalImg]
[1]: https://www.reddit.com/r/dataisbeautiful/
[2]: https://www.reddit.com/r/dataisbeautiful/comments/77an8j/temperature_of_every_hour_in_ny_since_1973_oc/
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ChampaignWeather.png&userId=570780
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ChampaignWeather.png&userId=570780
[5]: https://gist.github.com/yeedle/82c5a7d73ab785eaaa8a220b5b0f1bf2
[6]: https://www.wolframcloud.com/objects/user-770cd577-83d6-4fc1-9b12-8de56235edbb/personalDeployments/ChampaignWeather.nb
[7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=4ertwg.png&userId=11733
[8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ert54ert.png&userId=11733
[9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=saf43qtegwdfav.png&userId=11733Kyle Martin2017-10-20T01:44:20ZHow can I solve this inverse laplace transform?
http://community.wolfram.com/groups/-/m/t/1206642
Hello, I`m trying to solve the step response inverse Laplace transform of this transfer function:
`F(s) = (C(s)/(1+(G(s)-P(s))*C(s)))*(1/s) (1)`
In which:
` G(s) = 10/(s+10) (2)`
`P(s) = (10/(s+10))*E^(-0.5*s) (3)`
`C(s) = k(1+1/(T*s) (4)
The last equation (4) is a Pi controller with parameters "k" and "T".substituting (2),(3) and (4) in (1) gives me:
`F(s) = k*(T*s + 1)*(s + 10)/(T*s*(s + 10) + 10*k*(T*s + 1)*(1 - E^(-0.5*s))) (5)`
I use the following command on (5)
**InverseLaplaceTransform**`[(k*(T*s+1)*(s+10)/(T*s*(s+10)+10*k*(T*s+1)*(1-E^(-0.5*s))))*(1/s), s,t] (6) `
The result of (6) is:
k **InverseLaplaceTransform**`[((10+s)(1+sT))/( s(s (10+s)T+10(1-e^(-0.5s)) k (1+sT))), s, t] `
I´ve already tried this command with easier transfer functions and it works perfectly but with a bigger transfer fucntion it does not. Does anybody know what I am doing wrong in order to properly calculate this inverse Laplace transform?
Kind regards,
FelipeFelipe Nicolau2017-10-22T09:09:25ZProxy-respectful ResourceData
http://community.wolfram.com/groups/-/m/t/1206598
Hello,
I tried [digit classification][1] last night. The download process by `ResourceData` was very slow. I had set the SOCKS proxy, and left all other proxies empty, but I observed that the connection was direct and not through the proxy.
Is it possible to make `ResourceData` respect my proxy settings?
Thanks in advance.
[1]: http://www.wolfram.com/language/11/neural-networks/digit-classification.html?product=languageGuanpeng Xu2017-10-22T01:36:33ZSignificant digits
http://community.wolfram.com/groups/-/m/t/1205988
hz = N[28 2^(-(n/6)) , {Infinity, 3}];
Column[Table[{n, hz}, {n, 36, 41}]]
Why do I get two different types of results digitwise?Nelson Zink2017-10-21T00:01:44ZAlways print "Updating from Wolfram Research server ..."
http://community.wolfram.com/groups/-/m/t/1206507
When I launch wolframscript form shell, it always prints "Updating from Wolfram Research server ..." after In[1]:=
Like this:
$ wolframscript
Wolfram Language 11.2.0 Engine for Mac OS X x86 (64-bit)
Copyright 1988-2017 Wolfram Research, Inc.
In[1]:= Updating from Wolfram Research server ...
If I type `wolframscript -code 1+1 > foo.txt`, everything is OK.
`cat foo.txt` will return:
2
But if I type `wolframscript -code 9^9^9 > bar.txt`, "Updating from Wolfram Research server ..." will be added at the beginning of bar.txt.
`head -c 100 bar.txt` will return:
Updating from Wolfram Research server ...
4281247731757470480369871159305635213390554822414435141747
Waiting or disconnecting the network can't solve this problem.Zhou Zhuang2017-10-21T01:39:34Z[✓] Implement simple birth death process?
http://community.wolfram.com/groups/-/m/t/1205656
Hi All, I am trying to implement simple birth death process. Why my code does not work? Any suggestion. Thanks.
birthDeath[λ_, μ_, initialPopulation_, numOfReaction_] :=
NestList[(
Δt1 = RandomVariate[ExponentialDistribution[λ #]];
Δt2 = RandomVariate[ExponentialDistribution[μ #]];
If[Δt1 < Δt2, {# + 1}, {# - 1}]) &, initialPopulation, numOfReaction]
birthDeath[3, 1, 10, 2]Okkes Dulgerci2017-10-19T18:07:59ZDropbox API version change and ServiceConnect
http://community.wolfram.com/groups/-/m/t/1204980
Dropbox has updated their access API causing the
ServiceConnect["Dropbox"]
to now return an error message:
<|"Error" -> "v1_retired"|>
I deleted the cached connection info stored in ~/Library/Mathematica/Paclets associated with Dropbox and same problem.
Is there a workaround?Philip Zecher2017-10-18T13:34:27Z[✓] Call a slow running function from dynamic interface?
http://community.wolfram.com/groups/-/m/t/1205472
I have a custom function which demands much time (maybe several hours) to calculate result. I wanted to call the function from dynamic interface, where I define input variables and call the function by button. I found that the function outputs results differently from the case, when I call it without interface. And calculation is aborted after short time without any error message. The function is outside the interface. I tried different methods to force the function to run till end of calculation but in vain. I made a simple example to show the problem.
(*Example of function with long time of execution*)
long[max_] := Block[{ max1},
max1 = max;
Print["max=", max1];
Table[Print[i, " ", ProgressIndicator[i, {0, max}]]; Pause[2],
{i, 1, max1}];
Print["End"]
]
(*Call of long[max]*)
long[8]
The function runs till end.
(*Call of the same function from interface*)
DynamicModule[{},
Column[{
Row[{Control[{n, {3, 5, 8, 10, 20}}]}],
Button["Start", long[n]]}]
]
The function terminates after 6 sec of running
Is it possibility to call slow function from dynamic interface?Ivan Siahlo2017-10-19T16:02:43Z[GIF] Vitals (Animated von Mises distribution)
http://community.wolfram.com/groups/-/m/t/1199921
![Animated von Mises distribution][1]
**Vitals**
This one is pretty simple: there are 22 rows of dots, translating left or right depending on whether the row number is even or odd. Within each row, you can see the dots as plotting the density of the [von Mises distribution][2]. Specifically, the radius of each dot is the value of the von Mises pdf at that point.
Note that the von Mises distribution is like a Gaussian distribution on the circle. In particular, it is a periodic probability distribution, which is why each row is periodic, showing a total of 5 periods.
Here's the code:
Manipulate[
Show[
GraphicsGrid[
Table[{
Graphics[{
Lighter[ColorData["Rainbow"][1 - (n + 10)/21], .2],
Disk[{#, 0}, PDF[VonMisesDistribution[0, .3], Mod[# + (-1)^n t, 2 π, -π]]] & /@ Range[-4 π, 4 π, π/6]},
PlotRange -> {{-4 π - π/12, 4 π + π/12}, {-.5, .5}}]},
{n, -10, 11}],
Spacings -> {-6, Automatic}], ImageSize -> 600, Background -> GrayLevel[.1],
PlotRangePadding -> {None, Scaled[.0242]}
],
{t, 0, 2 π}]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=dots12sc.gif&userId=610054
[2]: https://en.wikipedia.org/wiki/Von_Mises%E2%80%93Fisher_distributionClayton Shonkwiler2017-10-09T00:55:26Z[GIF] Trifolium (Envelope of the trifolium curve)
http://community.wolfram.com/groups/-/m/t/1202255
![Envelope of the trifolium curve][1]
**Trifolium**
The animation shows 800 tangent lines to the trifolium as they slowly move around the curve. In order to make it, I first ran `PlaneCurveData["Trifolium", "ParametricEquations"]` to get the parametrization, which I then rotate to get a vertically-oriented trifolium:
tri[t_] := RotationMatrix[π/6].{-Cos[t] Cos[3 t], -Cos[3 t] Sin[t]};
After that, it's just a matter of creating the tangent lines with `InfiniteLine[]` and choosing some colors. Here's the code:
With[{d = 2 π/800.},
Manipulate[
Show[
Table[
Graphics[{Thickness[.001], Opacity[.8], Hue[Mod[(s + t)/π, 1]],
InfiniteLine[tri[t + s], tri'[t + s]]},
PlotRange -> {{-1.4, 1.4}, {-1.18125`, 1.61875`}}],
{t, 0., π - d, d}],
ImageSize -> 540, Background -> GrayLevel[.1]],
{s, 0, d}]
]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=lem8.gif&userId=610054Clayton Shonkwiler2017-10-13T03:19:40Z[GIF] Grid (Transformation of the square grid)
http://community.wolfram.com/groups/-/m/t/1204826
![Transformation of the square grid][1]
**Grid**
Unlike [_Part of the Journey_][2], [_Play_][3], and [_Limits_][4], this is not a conformal transformation of a regular grid on the plane. Instead, I've taken the square grid, inverse steregraphically projected it to the sphere, then orthogonally projected back to the plane, producing a collection of curves contained in the unit disk. This is not conformal since orthogonal projection does not preserve angles.
In the animation, I'm translating the entire grid by $-t (1,2)$ as $t$ varies from 0 to 1, which is a symmetry of the square grid, and applying the inverse-stereographic-project-then-orthogonally-project transformation.
There are a couple of quirks in the code. First, the `Disk[]` is there because I didn't extend the grid out far enough to actually fill in the center (which would have been computationally expensive); instead I just placed a small disk in the center to cover the hole in the middle. Second, the funny business on `x` in the `Table[]` is because I'm using progressively less precision for the grid lines which cluster in the center in order to cut down on computational complexity that doesn't actually contribute anything visible.
Anyway, here is the code:
InverseStereo[{x_, y_}] := {2 x/(1 + x^2 + y^2), 2 y/(1 + x^2 + y^2), (x^2 + y^2 - 1)/(1 + x^2 + y^2)};
With[{d = 30, cols = RGBColor /@ {"#FF5151", "#000249"}},
Manipulate[
Graphics[
{cols[[1]], Disk[{0, 0}, .07], Thickness[.003],
Line /@ # & /@ (Transpose /@ Table[InverseStereo[# - t {1, 2}][[;; 2]] & /@ {{n, x}, {x, n}},
{n, -d - 0.5, d + 0.5, 1},
{x, Join[Range[-d, -20], Table[-20 + i Abs[n]/40, {i, 1, 1600/Abs[n]}], Range[20, d]]}])},
Background -> cols[[-1]], ImageSize -> 540, PlotRange -> 1.1],
{t, 0., 1}]
]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=stereotiles12c.gif&userId=610054
[2]: http://community.wolfram.com/groups/-/m/t/1171765
[3]: http://community.wolfram.com/groups/-/m/t/1173214
[4]: http://community.wolfram.com/groups/-/m/t/1179440Clayton Shonkwiler2017-10-18T05:10:47ZBasis of factors for large degree polynomials
http://community.wolfram.com/groups/-/m/t/1198917
In $\mathbb{Z}_2$, the polynomial $x^{2^6}+x+1$ or $x^{64}+x+1$ factors into $x^4+x+1$, $x^{12}+x^9+x^5+x^2+1$, $x^{12}+x^9+x^5+x^4+x^2+x+1$, $x^{12}+x^9+x^8+x^5+1$, $x^{12}+x^9+x^8+x^5+x^4+x+1$, $x^{12}+x^9+x^8+x^6+x^3+x^2+1$. Below, under $1+x+x^{64}$, you can see the degree 12 factors arranged as columns, followed by the basis (a gray bar separates factors and basis). The same is shown for $n$ from 5 to 13.
[![factors and basis][1]][1]
In $\mathbb{Z}_2$, $x^{2^n}+x+1$ has many factors of degree $2 n$ and the number of basis elements always seems to be $n-2$. Here are pictures of the basis for $n$ from 7 to 18.
[![basis in z2][2]][2]
Here's Mathematica code for the first image.
data = Table[Module[{ polynomials, len, polyandbasis},
polynomials = Last[Sort[SplitBy[SortBy[CoefficientList[#, x] & /@ (First /@
FactorList[x^(2^power) + x + 1, Modulus -> 2]), {Length[#], Reverse[#]} &], Length[#] &]]];
len = Length[polynomials[[1]]];
polyandbasis = Flatten /@ Transpose[{ 3 Transpose[polynomials], Table[{0, 1, 0}, {len}],
3 Transpose[Select[RowReduce[polynomials, Modulus -> 2], Total[#] > 0 &]]}];
Column[{Text[x^(2^power) + x + 1], ArrayPlot[polyandbasis, PixelConstrained -> True,
ImageSize -> {800, 2 len + 4}, Frame -> False]}, Alignment -> Center]], {power, 5, 13}];
Column[{Row[Take[data, 6], Spacer[30]], Row[Take[data, {7, 8}], Spacer[60]], Row[Take[data, {9}]]}]
First question: Does the $\mathbb{Z}_2$ polynomial $x^{2^n}+x+1$ have a particular name? It has a lot of nice properties.
I'd like to make pictures of higher order basis elements. Unfortunately, Mathematica doesn't want to Factor $x^{1048576}+x+1$, claiming it's out of bounds. Also, PolynomialGCD doesn't like high exponents. I've looked at the [Cantor–Zassenhaus algorithm](https://en.wikipedia.org/wiki/Cantor%E2%80%93Zassenhaus_algorithm) and other factorization methods over finite fields, but didn't readily understand them.
Is there some clever way to get the basis of the $\mathbb{Z}_2$ factors of $x^{2^n}+x+1$ for $n$ from 19 to 120 in Mathematica? Is there some nice way of quickly getting some of the degree $2n$ factors.
(Also at [math.stackexchange](https://math.stackexchange.com/questions/2460638/basis-of-factors-for-large-degree-polynomials) )
[1]: https://i.stack.imgur.com/GGXyR.jpg
[2]: https://i.stack.imgur.com/SwUO0.jpgEd Pegg2017-10-06T18:33:27ZLines of 4 points and 3 degrees above zero
http://community.wolfram.com/groups/-/m/t/1190377
At [Extreme Orchards for Gardner](http://community.wolfram.com/groups/-/m/t/947771) I mentioned barycentric coordinates. I found an interesting connection between the terms of degree 0 1 2 3 and barycentrics for record-setting lines in 3D space. The power set has the *ab* terms of degree 0 to 3. I calculate points of permutations of this power set. By appending 1 to each, the points can be gathered into lines with RowReduce. And then the graphic, showing how 64 points can be arranged in 66 lines of 4 points.
powerset ={{0, 0, 0, 1}, {0, 0, a, b}, {0, a^2, a b, b^2}, {a^3, a^2 b, a b^2, b^3}};
tetra = {{-1, -1, -1}, {-1, 1, 1}, {1, -1, 1}, {1, 1, -1}};
FromBarycentrics[{m_, n_, o_, p_}, {{x1_, y1_, z1_}, {x2_, y2_, z2_}, {x3_, y3_, z3_}, {x4_, y4_, z4_}}] := {m x1 + n x2 + o x3 + (1 - m - n - o) x4, m y1 + n y2 + o y3 + (1 - m - n - o) y4, m z1 + n z2 + o z3 + (1 - m - n - o) z4};
pts = Sort[FromBarycentrics[#/Total[#], tetra] & /@ Flatten[Permutations[#] & /@ (powerset /. {a -> 5, b -> 9}), 1]];
lines = Select[Union[Flatten[#, 1]] & /@ SplitBy[SortBy[Subsets[Append[#, 1] & /@ pts, {2}], RowReduce], RowReduce], Length[#] == 4 &];
lindex = Flatten[Position[pts, Drop[#, -1]] & /@ #] & /@ lines;
Graphics3D[{Sphere[#, .092] & /@ pts, Tube[pts[[#]], .02] & /@ lindex}, SphericalRegion -> True, Boxed -> False, ImageSize -> 800]
![lines of 4][1]
In above, I use $a=5, b=9$, but any reasonable values work. 0001 0011 0111 1111 1122 1112 1222 0012 0112 0122 1123 1223 1233 0123 2345 can be used instead to produce 241 lines of 5, a sporadic 3D extension of my previous graphic.
![lines of 5][2]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=linesof4.jpg&userId=21530
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=trees25-18-5.gif&userId=21530Ed Pegg2017-09-23T01:21:42Z[GIF] Voronoi visualization
http://community.wolfram.com/groups/-/m/t/1202074
I recently saw a gif showing the [growth of a Voronoi diagram][1] on [this][2] wiki page. This gif shows a Voronoi diagram but restricts each cell to lie in a disk that slowly grows over time.
I decided to recreate this with the Wolfram Language and thought I'd share the code and final result here.
#Visualization
First and foremost, here's the result:
![enter image description here][3]
#Code
First I start off with 20 random points in 2D:
pts = RandomReal[{-1, -1}, {20, 2}];
Then I extract each point's Voronoi cell by calling `VoronoiMesh` and then arranging the primitives to correspond to `pts`.
voronoi = VoronoiMesh[pts, {{-1, 1}, {-1, 1}}];
prims = BoundaryDiscretizeRegion /@ MeshPrimitives[voronoi, 2];
prims = Table[First[Select[prims, RegionMember[#, p] &]], {p, pts}];
Let's quickly pause to make sure the cells correspond to the correct point.
MapThread[Show[#1, Epilog -> {Red, PointSize[Large], Point[#2]}] &, {prims, pts}][[1 ;; 5]]
![enter image description here][4]
Now that we have the primitives, we can show the scene with disks of radius $r$ by applying `RegionIntersection` at each cell with a disk of radius $r$.
First we will discretize a disk to force `RegionIntersection` to return a `BoundaryMeshRegion`.
disk[{x_, y_}, d_, n_:100] := BoundaryMeshRegion[CirclePoints[{x, y}, d, n], Line[Mod[Range[n + 1], n, 1]]]
Now at radius $r$ we intersect, which I packed into a function. First, here's the code for a single cell. It will take the Voronoi cell, its corresponding point, and a color for styling purposes.
colors = RandomColor[RGBColor[_, _, _, 0.3], 20];
PartialVoronoiCell[r_][p_, cell_, color_] :=
BoundaryMeshRegion[
RegionIntersection[disk[p, r], cell],
MeshCellStyle -> {1 -> Directive[Thick, GrayLevel[.5]], 2 -> color}
]
The main function will effectively map over each point. When $r \leq 0$, we just show the points.
PartialVoronoiCells[_?NonPositive] = Graphics[Point[pts], PlotRange -> {{-1, 1}, {-1, 1}}, PlotRangePadding -> Scaled[.0125]];
PartialVoronoiCells[r_] :=
Show[
MapThread[PartialVoronoiCell[r], {pts, prims, colors}],
Epilog -> Point[pts], PlotRange -> {{-1, 1}, {-1, 1}}, PlotRangePadding -> Scaled[.0125]
]
This function is fast enough to visualize the growth with `Manipulate`.
Manipulate[PartialVoronoiCells[r], {r, 0, 1}]
![enter image description here][5]
[1]: https://en.wikipedia.org/wiki/Voronoi_diagram#/media/File:Voronoi_growth_euclidean.gif
[2]: https://en.wikipedia.org/wiki/Voronoi_diagram
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=voronoi.gif&userId=46025
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Screenshot2017-10-1221.55.07.png&userId=46025
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=screenshot.gif&userId=46025Chip Hurst2017-10-13T02:59:08Z[✓] Find all ZipCodes within 5 miles of a KML line?
http://community.wolfram.com/groups/-/m/t/1203262
I drew a line using Google Earth. I saved it as "Line2.kml" (not kmz). I uploaded it to Wolfram Programming Lab.
I can successfully import the line into Wolfram:
kml1 = Import["Line2.kml", "Graphics"];
I can find all of the zip codes within 5 miles of a single point:
zipCodeList = GeoEntities[GeoDisk[GeoPosition[{46.73333672951149,-117.009711345202,0}], Quantity[5, "Miles"]], "ZIPCode"]
Is there a way to find all of the zip codes within 5 miles of all of the points?Steve LaDuke2017-10-15T07:55:31Z'Help needed with Abstract Algebra - using Mathematica v11'
http://community.wolfram.com/groups/-/m/t/1205679
Help Needed Please: Trying to figure out how to make my old 'Exploring Abstract Algebra with Mathematica' work with Mathematica v11. Has anyone had success with this? If so would you please share? Thank you... BillBill Depue2017-10-19T20:26:25ZAvoid to evaluate cells twice for the initialization of a Manipulate?
http://community.wolfram.com/groups/-/m/t/1204311
This manipulate program below allows the user to enter points on a LocatorPane and then draws a line through the points.
![enter image description here][1]
The Manipulate has an Initialization, where the programmer can define initial values for the points. The initial values are the variable ipts in the code below. What I observe is that the definition of the Manipulate must be evaluated twice before the modified values are displayed. Suspect that I am misunderstanding some fundamental concept about how initialization works. Could someone point out how to revise the code?
On a possibly related note, what must be done so that the variables, ipts, xMin and xMax in the code below have a scope local to the Manipulate?
*Steps to reproduce the problem:*
1. Action: evaluate the cell; Response: the manipulate will appear
2. Action: edit the code; change the value of ipts (e.g. change the first point to {0.15, 0.05}
3. Action: evaluate the cell; Response, the manipulate will appear, the first point will have the **original** value {0.15, 0.35}
4. Action: evaluate the cell; Response: the manipulate will appear, the first point will have the **revised** value {0.15, 0.05}
**Question**: what must change so that manipulate will display the revised value after step 3?
myTest2 = Manipulate[
(*User points*)
posSorted = Sort[pos];
xMin = Min[posSorted[[All, 1]] ];
xMax = Max[posSorted[[All, 1]] ];
gvfuncUser = Interpolation[posSorted, InterpolationOrder -> 1];
myPlot =
Plot[gvfuncUser[x], {x, xMin, xMax},
PlotRange -> {{0, 1}, {0, 1}}, Frame -> True, ImageSize -> 400];
Grid[{
{LocatorPane[Dynamic@pos, myPlot, LocatorAutoCreate -> True,
ContinuousAction -> False] }
}]
,
(*list of controls*)
{{pos, ipts}, ControlType -> None}
(*Initialization*)
, TrackedSymbols :> {pos, ipts}
, Initialization :> (
ipts = {{0.15, 0.35}, {0.25, 0.15}, {0.50, 0.17}, {0.75,
0.18}, {1, 1}};
posSorted = {}; (*do this so that posSorted is local to this Manipulate (?) *)
gvfuncUser = {};
)
, SynchronousUpdating -> False
];
myTest2
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Manipulate_Initialization.PNG&userId=894223Robert McHugh2017-10-17T04:38:31ZDifference between the "FindMinimum" and "Minimization" ?
http://community.wolfram.com/groups/-/m/t/1205354
Could any one please explain with example what is the difference between the "Find Minimum" and "Minimization" functions in Mathematica?Amir Khan2017-10-19T05:42:13ZMathematica's benefits and difficulties
http://community.wolfram.com/groups/-/m/t/1205525
Hi! We are college students and we are doing a project that we have to talk about the software Mathematica. We would like to know the difficulties and benefits that you found while using the program. Thank you!!Amanda Correa2017-10-19T11:11:06ZTriangular and pyramidal numbers
http://community.wolfram.com/groups/-/m/t/1205088
f(n)="The triangular numbers"=1+2+ . . .+n. Using 9 for n,
Graphics[{PointSize[Large], Point[Permutations[Range@9, {2}]]}]
![enter image description here][1]
I.e.,the unequal pairs of numbers up to 9 plots as a 9*9 square minus
its length 9 diagonal. But this is just two copies of 1+ . . .+8. So
![enter image description here][2]
Solving for f(n)
RSolve[%, f[n], n] // Factor
![enter image description here][3]
This is essentially how Gauß, the youngster, startled his grammar school teacher.
In highschool, my friend Reed Carson and I got this a different way - by adding up the areas of n+1 triangles:
Table[{x, y}, {x, 4}, {y, x}]
> {{{1, 1}}, {{2, 1}, {2, 2}}, {{3, 1}, {3, 2}, {3, 3}}, {{4, 1}, {4,
> 2}, {4, 3}, {4, 4}}}
Graphics[{EdgeForm[White],
Blue, % /. {x_Integer, y_} -> Rectangle[{x, y}]}] /. {L___,
Rectangle[{x_Integer, y_}]} :> {L,
Triangle[{{x, y}, {x + 1, y}, {x + 1, y + 1}}], Red,
Triangle[{{x, y}, {x, y + 1}, {x + 1, y + 1}}]}
![enter image description here][4]
Now for 3D. Using as coordinates the integers 1, 2, ..., n taken three at a time,
Graphics3D[Sphere[Permutations[Range@9, {3}], 1/2]]
![enter image description here][5]
The unequal triads of numbers up to 9 plots as a 9x9x9 cube minus
those diagonals which have two or three coordinates the same:
Graphics3D[Sphere[Select[Tuples[Range@9, 3], Not[UnsameQ @@ #] &], 1/2]]
![enter image description here][6]
This is six triangulars of size 8 (= n-1) plus the central column of 9 (=n).
The former is six pyramids of size 7 (= n-2). Together they make a cube of size n=9.
So the equation for the pyramidal numbers solves as
RSolve[6 f[n - 2] + 6 n (n - 1)/2 + n == n^3, f[n], n] // Factor
![enter image description here][7]
Instead of 1 + 3 + 6 + . . . + n, summing $1^2 + 2^2 + . . . + n^2$ gives the "square pyramidal numbers",
Table[Sphere[{x, y, z}, 1/2], {z, 7}, {y, z}, {x, z}] // Graphics3D
![enter image description here][8]
each of which is the sum of two consecutive ordinary pyramidal numbers:
% /. Sphere[{x_, y_, z_}, 1/2] :> Sphere[{x, y, z}, 1/4] /; x < y
![enter image description here][9]
So the sum of the first n squares, $1^2 + 2^2 + . . . + n^2$, is
Factor[1/6 (n-1) (n+1) n+1/6 (n+1) (n+2) n]
![enter image description here][10]
(You can also see that each square (each layer) is the sum of two consecutive triangular numbers.)
But, as before, my friend Reed and I got this geometrically, as the the sum of a big pyramid plus two triangular arrays of half-cubes, plus n "notched" cubes (shown transparent) running up the long diagonal, each notch being a little pyramid of volume ⅓:
Graphics3D[{White,
Table[If[x == y, {Opacity[.0], #}, #] &@
Cuboid[{x - 1, y - 1, 5 - z}], {z, 5}, {y, z}, {x, z}],
Polygon[{{{0, 0, 0}, {5, 0, 0}, {5, 5, 0}, {0, 5, 0}}, {{0, 0,
0}, {0, 0, 5}, {5, 0, 0}}, {{0, 0, 5}, {5, 5, 0}, {5, 0,
0}}, {{0, 0, 5}, {0, 0, 0}, {0, 5, 0}}, {{0, 0, 5}, {5, 5,
0}, {0, 5, 0}}}]}]
![enter image description here][11]
For 5 = n, the volume of this is big pyramid + n notched cubes + two triangles of half-cubes , or
Factor[n^3/3+(1-1/3) n+(2 n (n-1))/(2 2)]
![enter image description here][12]
(For this problem, we don't need to know that the volume of a pyramid is always ⅓ the volume of its circumscribing prism, because a cube can always dissect into three copies of the (square based) pyramid we're discussing.)
![enter image description here][13]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=78961.png&userId=20103
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=73512.png&userId=20103
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=29923.png&userId=20103
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=64344.png&userId=20103
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=35585.png&userId=20103
[6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=68706.png&userId=20103
[7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=25207.png&userId=20103
[8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=99038.png&userId=20103
[9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=103309.png&userId=20103
[10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=175810.png&userId=20103
[11]: http://community.wolfram.com//c/portal/getImageAttachment?filename=797911.png&userId=20103
[12]: http://community.wolfram.com//c/portal/getImageAttachment?filename=852212.png&userId=20103
[13]: http://community.wolfram.com//c/portal/getImageAttachment?filename=902213.png&userId=20103Bill Gosper2017-10-18T15:46:36ZMike Foale's Machine Learning Flight System
http://community.wolfram.com/groups/-/m/t/1179035
## Introduction ##
A few weeks ago, I had the privilege of speaking with Michael Foale -- astronaut, astrophysicist, entrepreneur, and Mathematica fan -- about his recent work with the Wolfram Language on the Raspberry Pi. As an experienced pilot, Mike thought he could use the Wolfram Language's machine learning capabilities to alert pilots to abnormal or unsafe flying conditions. Using a collection of sensors attached to a Pi, the Wolfram Language's Classify function would constantly analyze things like altitude, velocity, roll, pitch, and yaw to determine whether the pilot might be about to lose control of the plane. You can read [Mike's User story here][1], his experience with [Mathematica on the Space Station Mir here][2]. and the full code for Mike's Imminent Loss Of Control Identification system, or ILOCI, [is here][3].
## Getting the Initial Data ##
Mike decided that the Raspberry Pi would be a good base for this project because of how easy it is to connect various sensors to the device. In his case, there were 3 sensors he wanted to read from: an accelerometer, an aero sensor attached to the tail, and a flex sensor attached to the rudder. All of these are attached via GPIO pins, which the Wolfram Language can communicate through. In Mike's case, he wrote a MathLink driver in C to do this, but since he began this project we have been pushing to make GPIO communication easier. Now, the Wolfram Language can read from sensors with [the DeviceOpen and DeviceRead functions][4]. If Mike were to re-do this project, that would have saved him quite a bit of time and debugging!
![Left: Prototype Pi and sensor setup. Right: ILOCI attached to a small plane for a test flight.][5]
Before the Classify function can tell whether current flying conditions are normal or not, it must first learn what normal is. To do this, Mike took his Pi setup on a test-flight where he occasionally forced his plane to stall, or come close to stalling (please, do not try this for yourself!). After landing, he manually separated the sensor readings into "in family" and "out of family" moments -- that is, normal flying conditions and moments where loss of control is imminent.
## Importing the Data ##
For Mike's flights, he had the Pi save data from an initial test flight to a CSV file and had Mathematica import that file to train his Classify function on. For example:
datafile = FileNameJoin[{"","home","pi","Documents","training.dat"}];
data = Import[datafile];
For convenience's sake, I've embedded this same data in a notebook attached to this post, so that you can test and manipulate this data on your own as well. This data, saved under the variable "data", was divided up by Mike into the "in family" and "out of family" periods mentioned earlier:
noloc1 = Take[data, {3500, 3800}]; (* Ground, engine off *)
noloc2 = Take[data, {3900, 4200}]; (* Ground, engine on *)
noloc3 = Take[data, {4500, 4600}]; (* Takeoff, climbing at 60 knots *)
noloc4 = Take[data, {4800, 4900}]; (* Climbing, 70 knots *)
noloc5 = Take[data, {5000, 5200}]; (* Climbing, 50 knots *)
noloc6 = Take[data, {6200, 6300}]; (* Gliding, 42 knots *)
noloc7 = Take[data, {6900, 7100}]; (* Climbing, 60 to 70 knots *)
noloc8 = Take[data, {9200, 9400}]; (* Landing *)
noloc9 = Take[data, {9300, 9400}]; (* Rolling out*)
loc1 = Take[data, {6450, 6458}]; (* Straight stall *)
loc2 = Take[data, {6480, 6484}]; (* Left stall *)
loc3 = Take[data, {6528, 6534}]; (* Right stall *)
loc4 = Take[data, {6693, 6700}]; (* Right Yaw *)
loc5 = Take[data, {6720, 6727}]; (* Left Yaw *)
You might notice that the list above doesn't cover the entire dataset. That's because some of the data is kept aside for verification, to ensure the Classify function is recognizing "in family" and "out of family" moments correctly. This is a very important part of training any artificially intelligent program! Below are some plots of the above datasets, just to get a visual feel for what the Pi is "seeing" during a flight.
ListLinePlot[Transpose[noloc4],
PlotLegends -> {"AccelerationZ", "AccelerationY", "AccelerationX",
"RudderDeflection", "ElevatorDeflection", "TailYawRelative",
"TailAngleAttackRelative", "TailAirspeedRelative"}, Frame -> True]
![Sensor readings while climbing at 70 knots][6]
ListLinePlot[Transpose[loc1],
PlotLegends -> {"AccelerationZ", "AccelerationY", "AccelerationX",
"RudderDeflection", "ElevatorDeflection", "TailYawRelative",
"TailAngleAttackRelative", "TailAirspeedRelative"}, Frame -> True]
![Sensor readings while stalled][7]
These plots give us a good idea of what happens at some specific instances, but what does the flight as a whole look like? Recall from above that takeoff begins around datapoint 4500, the first stall around 6450, landing around 9200, and the rollout ends around 9400. According to Mike, the rudder movement around 11000 is simply moving the rudder to steer the aircraft back into the hangar.
ListLinePlot[Transpose[data],
PlotLegends -> {"AccelerationZ", "AccelerationY", "AccelerationX",
"RudderDeflection", "ElevatorDeflection", "TailYawRelative",
"TailAngleAttackRelative", "TailAirspeedRelative"}, Frame -> True,
ImageSize -> Large]
![Sensor readings from whole flight][8]
## Training the Classifier Data ##
After separating the data, Mike created Rules to label these moments as "Normal", "Stall Response", "Yaw Response Left", and "Yaw Response Right"; respectively "N", "D", "L", and "R". These Rules teach Classify which patterns belong to which label, so that later on Classify can tell what the appropriate label is for incoming, unlabeled data. Note that the ConstantArray functions simply repeat the data 10 times so the "out of family" moments are not overshadowed by the "in family" ones.
normal = Join[noloc1, noloc2, noloc3, noloc4, noloc5, noloc6, noloc7, noloc8];
normalpairs = Rule[#1, "N"] & /@ normal;
down = Flatten[ConstantArray[Join[loc1, loc2, loc3], 10], 1];
downpairs = Rule[#1, "D"] & /@ down;
left = Flatten[ConstantArray[loc4, 10], 1];
leftpairs = Rule[#1, "L"] & /@ left;
right = Flatten[ConstantArray[loc5, 10], 1];
rightpairs = Rule[#1, "R"] & /@ right;
Finally, with the data segmented and labeled, Mike created a ClassifierFunction able to take live data from the sensors, then quickly tell the pilot when something is wrong and how to correct it.
classify = Classify[Join[normalpairs, downpairs, leftpairs, rightpairs], Method -> {"NeuralNetwork", PerformanceGoal -> "Quality"}]
ClassifierInformation[classify]
![Output of the ClassifierInformation function][9]
Let's use this ClassifierFunction on a couple of the data points that we set aside earlier, to be sure the ClassifierFunction is correct, and to show how a ClassifierFunction is used.
nolocVerify = Take[data, {4600, 4700}];
locVerify = Take[data, {6587, 6595}];
classify[nolocVerify]
classify[locVerify]
![Results of Mike's classifier function on untrained data][10]
Recall that the ClassifierFunction returns one of 4 labels for each data point: "N" for normal, "L" for left yaw response, "R" for right yaw response, and "D" for down response. Mike's ClassifierFunction perfectly recognizes the first verification set, and comes close to being perfect on the second set. Not bad, given how little data he had to train it with!
This use-case gives a pretty good idea of how the ClassifierFunction works, but for a more in-depth example you can watch [this video from Wolfram Research][11].
## Using the ClassifierFunction on Real Data ##
At the moment I am neither a pilot nor the owner of an airplane, so performing a live test of Mike's ClassifierFunction would be a bit challenging. Fortunately, the Wolfram Language makes it easy to take Mike's recorded data and re-run it as though the ClassifierFunction were receiving this data in real time. First, we need to import the data that Mike recorded in his test flight. We actually did this already, when we called Import on the file containing the data. Next we'll import the timing data from the test flight. This is the absolute time in seconds and microseconds from the beginning and end of the flight, so subtracting the beginning time from the end time gives us the total time of the flight. With the times and the data known, we can determine how often the Pi read in measurements on the test flight. We will use that frame time to "replay" the test flight accurately. Mike's ILOCI system records timing information that we can Import from, but again I'll include it here for the sake of convenience:
timing = {1466861802, 255724, 1466867826, 498879, 11660};
dataseconds = timing[[3]] - timing[[1]];
datausecs = timing[[4]] - timing[[2]];
frametime = (dataseconds + datausecs*1.0*^-6)/(Length[data] - 1)
Now, let's use that frame length to create an animated output of the ClassifierFunction. This goes through the whole dataset and runs at the same rate as the Pi did. If we were actually flying an airplane, this would show us what the Pi thinks about our current environment, whether our motion is "in-family" or "out-of-family".
Animate[
classify[ data[[frame]] ],
{frame, 1, Length[data], 1},
AnimationRate -> (1/frametime),
FrameLabel -> {{None, None}, {None, "Full Flight Playback"}}
]
This would take a little over 90 minutes to run, and the non-normal readings go by fairly quickly, so let's focus in on some of the more interesting sections. First, let's see the straight stall that was reserved for verification. Again, the ClassifierFunction was not trained using this set -- it is brand new as far as the Classifier is concerned.
Animate[
classify[ data[[frame]] ],
{frame, 6580, 6595, 1},
AnimationRate -> (1/frametime),
FrameLabel -> {{None, None}, {None, "Stall Playback"}}
]
![Animate of the stall playback][12]
Notice that the Classifier constantly reads the situation and updates it's classification accordingly. Next let's look at one of the verification sets where everything was normal. It should read as "N" for the entire set:
Animate[
classify[ data[[frame]] ],
{frame, 6300, 6400, 1},
AnimationRate -> (1/frametime),
FrameLabel -> {{None, None}, {None, "Normal Playback"}}
]
![Animate of the normal playback][13]
## Conclusion ##
If we go back and count, there is about 60 lines of code. That's all that was needed to create plots, animations, and a neural net-based Classifier that might one day save lives. This is what makes the Wolfram Language such a powerful choice for projects like this -- quick prototyping and a plethora of built-in functions allows users to create some truly unique projects, regardless of experience or expertise. We hope that this will inspire you to start experimenting with your own ideas with the Wolfram Language!
[1]: http://www.wolfram.com/mathematica/customer-stories/training-a-neural-network-to-think.html
[2]: http://www.wolfram.com/mathematica/customer-stories/astronaut-places-a-customer-service-call-to-wolfram-research-from-space-station-mir.html
[3]: https://github.com/cfoale/ILOCI
[4]: http://reference.wolfram.com/language/guide/UsingConnectedDevices.html
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=PiAndPlaneSetup.png&userId=313765
[6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=LinePlot1.png&userId=313765
[7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=LinePlot2.png&userId=313765
[8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=LinePlot3.png&userId=313765
[9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ClassifierInfo.png&userId=313765
[10]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ClassifierResults.png&userId=313765
[11]: https://youtu.be/ce6UptPYKxI?t=20m40s
[12]: http://community.wolfram.com//c/portal/getImageAttachment?filename=StallPlayback.gif&userId=313765
[13]: http://community.wolfram.com//c/portal/getImageAttachment?filename=NormalPlayback.gif&userId=313765Brett Haines2017-09-07T18:16:06ZUsing Automatic for FaceGrids with Plot3D not working as for Plot?
http://community.wolfram.com/groups/-/m/t/1204646
Hi,
I am sure there is a good reason why I don´t seem to be able to do:
Plot3D[Evaluate[Abs[zin2/.{f->f0}]], {ca, c1/2, 2*c1}, {cb, c2/2, 2*c2},
FaceGrids->
{{{0,0,1}, {{c1},{c2}}},
{{1,0,0}, {{c2},Automatic}},
{{0,-1,0}, {{c1},{All}}}
}
]
but this will plot with a specific vertical grid and automatic horizontal grid lines with no problems:
Plot[Evaluate[Abs[zin2/.{{cb->c2, f->f0}}]], {ca, 0.5 c1, 2 c1}, GridLines->{{c1},Automatic}]
The documentation for FaceGrids specifically states that ¨For each face, specifications {xgridi,ygridi} can be given to determine the arrangement of grid lines. These specifications have the form described in the notes for GridLines.¨
GridLines states that ¨For each direction, the following grid line options can be given:¨ and it proceeds to list 5 options including the Automatic option.
Any help would be greatly appreciated.
Thanks,
JorgeJorge Diaz-Santiago2017-10-18T02:13:57ZCalculate mean graph distance in a citation network?
http://community.wolfram.com/groups/-/m/t/1204062
Hi,
I'm a PhD student. For my research, I'm trying to find the shortest path length of a citation network. As I understand, I can use the MeanGraphDistance function for this purpose in mathematica. However, for a citation graph similar to the following, the mean graph distance shows as infinity. Moreover, the number of connected components in this graph show up as 10 though it is a connected graph.
g = Graph[{1 -> 2, 1 -> 3, 1 -> 4, 2 -> 5, 2 -> 6, 2 -> 3, 3 -> 7,
3 -> 8, 4 -> 9, 4 -> 7, 4 -> 8, 4 -> 10}];
ConnectedComponents[g]
MeanGraphDistance[g]
This is the output I get
{{7}, {8}, {3}, {5}, {6}, {2}, {9}, {10}, {4}, {1}}
\[Infinity]
I'm not able to understand why. Any help would be greatly appreciated.Praveena Chandra2017-10-17T01:56:12Z[✓] Multiply more than 2 matrices?
http://community.wolfram.com/groups/-/m/t/1203793
I am trying to find the stiffness matrix of a bilinear rectangular element, so I need to multiply three matrices together in Mathematica. Multiplying three at once didn't seem to work, so then I decided to multiply the first two matrices, and then that result by the third matrix. That doesn't seem to be working, either. It seems that Mathematica is not seeing my [T] matrix as a matrix, but rather just a variable - even after I defined [T] above. Attached is what I've entered.
Any help is greatly appreciated!
Clear [x, y]
Clear [B]
B = ( {
{(y - 10)/100, 0, (10 - y)/100, 0, y/100, 0, -y/100, 0},
{0, (x - 10)/100, 0, -x/100, 0, x/100, 0, (10 - x)/100},
{(x - 10)/100, (y - 10)/100, -x/100, (10 - y)/100, x/100,
y/100, (10 - x)/100, -y/100}
});
Clear [M]
M = ({
{10666.67, 2666.67, 0},
{2666.67, 10666.67, 0},
{0, 0, 4000}
});
Clear [Q]
Q = Transpose[B].M.B // MatrixForm
Integrate[Q, {x, 0, 10}, {y, 0, 10}]Tracy Borne2017-10-16T17:57:26Z[✓] Speed up Sum while implementing the Jacobi method for linear systems?
http://community.wolfram.com/groups/-/m/t/1203706
Hi,
I've come across a strange performance issue while implementing the Jacobi method. In the attachment, the last parameter in the "Jacobi" function, just controls how a certain sum is computed: using the Mathematica Sum (WithSum==1) or by standard partial sums. In my understanding, this should be equivalent, however I see a whole different story...
For very small dimensions, say n <= 200, using Sum gives slightly smaller computational times. However, from a certain point on ( in my case n = 250), Sum suddenly starts taking forever... For n=250 using sum takes almost 40 times more then not using Sum!
How can this be??João Janela2017-10-16T11:45:46Z[✓] Get two significant digits to the right of the decimal point?
http://community.wolfram.com/groups/-/m/t/1203574
N[x,3] gives me 1.10 and 0.982, when what I want is 0.98.
How do I get two and only two digits to the right of the decimal point?Nelson Zink2017-10-15T21:09:09ZUsing .NET with MONO under OSX 10.10
http://community.wolfram.com/groups/-/m/t/472977
Hello,
I'm quite new using Mathematica 10.0.0.2 Home Edition and .NET on my Mac Book running OSX10.10.
In order to use .NET I installed the latest MONO version "MonoFramework-MDK-3.12.1-macosx10.xamarin.x86.pkg".
MONO install path is "/Library/Frameworks/Mono.framework/Versions/3.12.1/lib/libmonoboehm-2.0.1.dylib"
But when I try to establish a .NET communication e.g. with
Needs["NETLink`"]
InstallNET[];
the only message is :
Cannot set current directory to \
/Applications/Mathematica.app/Contents/Contents/Frameworks/mathlink.\
framework/. >>
The path is wrong as the Mathematica installation path is :
/Applications/Mathematica.app/Contents/SystemFiles/Links/NETLink
So the path "../contents/contents/.." seems to be the issue.
Anybody out there to provide some advice ?
Thank a lot in advance.
ChristianChristian Boge2015-04-03T13:15:31ZAvoid GeoNearest to timeout?
http://community.wolfram.com/groups/-/m/t/1199959
This is the complete code that shows the issue:
GeoNearest["ZIPCode", GeoPosition[{40.11, -88.24}], {All, Quantity[5,"Miles"]}]
Error message:
A network operation for Geonearest timed out. Please try again later.
Tried 10/8/2017 9:40 PM PDT
I am using the WOLFRAM PROGRAMMING LAB with a URL that starts with https://lab.wolframcloud.comSteve LaDuke2017-10-09T04:47:06ZSimulating GeoNearest with GeoEntities & GeoDisk
http://community.wolfram.com/groups/-/m/t/1203815
Imagine you have a set of geo positions that outline a path and you need to find all ZIP cods within 5 ml distance from this path. `GeoNearest` computation might time out due to complexity even for a single geo position, and even more so for, say, a few hundreds of them along a path. The computation is hard, because it involves lots of intersections with the ZIPCode polygons. But there is an easy work around via `GeoEntities` suggested [here][1]. I will show how to generalize it to a path. Import the data (attached) and extract positions:
data = Import["Line2.kml"];
pos = First[Cases[data, _GeoPosition, Infinity]]
![enter image description here][2]
Sample 5 ml geo discs along the path in am optimal step: not to small to be redundantly overlapping and not too large to have gaps in coverage:
disks = GeoDisk[GeoPosition[#], Quantity[5, "Miles"]] & /@ pos[[1, 1 ;; -1 ;; 30]]
![enter image description here][3]
As we can see this is pretty good coverage:
GeoGraphics[{disks, Point[pos]}]
![enter image description here][4]
But why at step 30 ? Well first it could be trial and error. But simple calculations show the same. We need number of points long the path (for disk centers):
Length[First[pos]]
(* 257 *)
Length of path in miles:
UnitConvert[GeoLength[GeoPath[pos]], "Miles"]
(* Quantity[29.52736447128438`, "Miles"] *)
And now the upper bound for step which I then decreased a bit to 30 for better coverage:
Length[First[pos]] Quantity[5, "Miles"]/UnitConvert[GeoLength[GeoPath[pos]], "Miles"]
(*43.51895345247198`*)
Now easily get all ZIPs with `GeoEntities`:
zips = Flatten[GeoEntities[disks, "ZIPCode"]]
![enter image description here][5]
and visualize the result. We take `Union` below to remove duplicates. Note high diversity of ZIP regions sizes. ZIP regions obviously span beyond the disks, but all disks are contained within most outer border of ZIPs - so we did not miss anything.
GeoGraphics[{disks, Point[pos], {EdgeForm[{Red, Thick}], FaceForm[], Polygon[Union[zips]]}}]
![enter image description here][6]
[1]: http://community.wolfram.com/groups/-/m/t/1199959
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=we5q34terg.png&userId=11733
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-10-16at3.14.58AM.png&userId=11733
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=45trhgar4q3t5wthr.png&userId=11733
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-10-16at3.16.45AM.png&userId=11733
[6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=rehgw5465ujetyhrsg.png&userId=11733Vitaliy Kaurov2017-10-16T08:19:29ZMake Mathematica's interface less blurry?
http://community.wolfram.com/groups/-/m/t/1202244
I run Mathematica 11.2 in Windows 10. I have a 4k monitor (resolution 3840x2160) at work and another at home running at recommended 150% scale. The Mathematica interface looks really blurry and it is painful to read (see attached image, the window behind Mathematica is the browser window where this message was being composed. Browser text is very sharp, as is the rest of Windows. Mathematica text is blurry).
My laptop (Surface book) runs at a resolution of 3000x2000 and 200% scale and Mathematica there looks even blurrier.
High dpi monitors have been out for many years and Mathematica has always been blurry for me on them. Is there a way of making it give good text? Am I missing some non-obvious setting that improves this?
Luis.Luis Rademacher2017-10-13T02:23:21ZGet gradient of PredictorFunction with respect to input?
http://community.wolfram.com/groups/-/m/t/1203073
For special forms of the PredictorFunction, there is an analytical formula for the gradient of the predictor wrt the input, x. For example, in a Gaussian Process, the prediction at $x$ is the posterior mean $m(x)$, and it is a linear combination of the kernel used
$$ m(x) = \sum a_{n} * k(x_n, x) $$
Hence, it is possible to obtain analytically the gradient of the mean wrt $x$ by taking a linear combination of the gradient of $k$. I was wondering, is it already implemented in the Wolfram function `Predict[]` or maybe `PredictorFunction[]` ? If not, is there an easy way to find the pieces needed? E.g. kernel parameters and kernel used, and possibly its gradient wrt $x$?
ThanksUmberto Noe2017-10-16T01:41:36Z[✓] Give a different color to each point in a plot of points?
http://community.wolfram.com/groups/-/m/t/1203194
Hello everyone, I'm new in mathematica so I have had some problems with it :/ . I have to make a plot from a science data in a 3D plot using points, and I have to give to each point a different color... and that's where is my issue. I've been trying with this
colorfunc = ColorData["Rainbow"];
norm = (vels - Min[vels])*1000; (*Some of the velocities are <0 so I plus them a value to avoid this.*)
cs = Normalize[norm];
Graphics3D[{PointSize[0.005], colorfunc@#[[1]], Point[#[[2]]]} & /@ Transpose[{cs, coord}], Axes -> True]
where coord is a 3D list of points (x,y and z cords),vels is a list with velocities, cs is the list containing the data for the colors. My problem is that when I execute the code the graph that I get has all the points with pretty similar colors, and I already know that I should see a difference between them, so I'm asking you for help with this. How should I give a different color to each point in such a way that I can see the difference between each point?
Thank you.Brayan Del Valle2017-10-15T00:48:20Z[✓] Compute a triple integral with NIntegrate?
http://community.wolfram.com/groups/-/m/t/1196434
I am trying to numerically compute a triple integral. The code is as follows:
I61 =(8 (((-1+E^(-(1/2) (u+v+z)^2)) z^2)/(u+v+z)^2-((-1+E^(-(1/2) (u+v+z)^2)) (v+z)^2)/(u+v+z)^2+((-E^(-(z^2/2))+E^(-(1/2) (u+v+z)^2)) (v+z)^2)/((u+v) (u+v+2 z))+(E^(-(1/2) (u+v+z)^2) (-1+E^(1/2 u (u+2 (v+z)))) z^2)/(u (u+2 (v+z)))))/(v z^2 (v+z)^2 (v+2 z))
I62 = Simplify[Together[I61]]
NIntegrate[I62, {z, 0, Infinity}, {u, 0, Infinity}, {v, 0, Infinity}, PrecisionGoal -> 4]
This works if I set PrecisionGoal to be 4. But increasing it 5 causes an error:
"The integrand ... has evaluated to Overflow, Indeterminate, or Infinity for all sampling points in the
region with boundaries {{3.,1.}, {0.,1.70984*10^14},{\[Infinity],7.}}"
Is there anyway to increase the precision a bit?Xing Shi Cai2017-10-02T14:29:30ZComputer Based Maths, list of educational outcomes.
http://community.wolfram.com/groups/-/m/t/1200235
Computer Based Maths ( https://www.computerbasedmath.org/about ) wish to consult you on our list of educational outcomes. These are the long-term goals that we want students learning mathematics to achieve through their schooling.
As valuable members of our community, we would like your feedback, to critique, compliment or suggest improvements upon the fundamentals that drive the initiative.
So please take the time to step through the list of outcomes, including the details and provide some feedback on what you think (comment / post below).
https://www.computerbasedmath.org/outcomes
This link is for the online list of the outcomes, found on that same page is a link to download the outcomes in PDF format should that prove useful!Mark Braithwaite2017-10-09T10:54:59Z[✓] Obtain inverse of a function?
http://community.wolfram.com/groups/-/m/t/1202155
I'm quite new to Mathematica and have so far been unable to resolve the following (minor) technical issue. In principle, the task is very straightforward: I'd like to define the inverse of the function F(x) = 1 - x^2/(2cosh(x)-2) *for x >= 0*, but because F is not a 1-1 function on the reals, I often get answers with the wrong sign if I set:
g[x_] = InverseFunction[F][x]
I need to compose g with another function, so it's not enough to just reflect the plot of F in the line y=x.
The easy fix I've found is just to let
g[x_] = Abs[InverseFunction[F][x]]
but this feels like a bit of a cheat, and on my machine, it takes quite a long time to generate a plot (it is possible to speed up this process?)
Instead, I've been trying to define g as a function with a restricted domain using ConditionalExpression, as in the example at
http://reference.wolfram.com/language/ref/InverseFunction.html
I must be doing something wrong, because I don't get any plot whatsoever!
Any help would be much appreciatedOliver Feng2017-10-12T15:52:55ZWhy a Histogram is not returned properly as image with CloudDeploy?
http://community.wolfram.com/groups/-/m/t/952355
In Notebook the below code runs properly
myDist[Latitude_, Longitude_] :=
EstimatedDistribution[
WeatherData[{Latitude, Longitude},
"MaxWindSpeed", {{1990}, {2015}, "Year"}],
GumbelDistribution[\[Alpha], \[Beta]],
ParameterEstimator -> "MaximumLikelihood", WorkingPrecision -> 25]
URLExecute[CloudDeploy[api], {"Latitude" -> 40, "Longitude" -> 18}]
and the result is look like this
![enter image description here][1]
But I need to deploy to the cloud, and after CloudDeploy and APIFunction used the respond is sometimes only the data set instead of the PNG image with the histogram. Even if I used the same coordinates as input. (i.e 40,18)
![enter image description here][2]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=histogram.png&userId=392591
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=hist2.png&userId=392591Balazs Kisfali2016-10-31T06:46:16ZUse SemanticImport in 11.2.0.0?
http://community.wolfram.com/groups/-/m/t/1200910
I can't get SemanticImport to work in 11.2.0.0. Even the Documentation files won't function. Mac; OS High Sierra; MacBookProColin Grace2017-10-10T07:04:50ZFind the combinations of 10 inputs that result in a Boolean Logic (0 or 1)?
http://community.wolfram.com/groups/-/m/t/1201941
I have a complex Boolean logic with, say, 10 inputs and one output. Is there any mathematical method or an algorithm to identify all the possible combinations of the inputs that can result in a specific output (0 or 1)? Note that the logic is known. But we don't want to 'try' or simulate all possible combinations of input and check which ones result in the specific output. We would like to solve the problem backward: know the desired output, know the logic, find out the input combinations that can result in that output.Hamid Jahanian2017-10-12T10:19:26ZUse NIntegrate with vectors?
http://community.wolfram.com/groups/-/m/t/1202204
Is there a way to get Mathematica to provide a meaningful answer - perhaps semi-numerically - for the following numerical integral over vectors? Note that it is OK to assume a value for \Alpha. Additionally the vector $\vec{x}$ is not being integrated over. So, if absolutely essential, different values of $\vec{x}$ could be taken for the numerical integration.
$Assumptions = Element[p1v | p3v | p4v | p5v | xv, Vectors[3, Reals]];
a = Simplify[ReleaseHold[Hold[E^((-I)*p1v . xv)]]]
b = Simplify[ReleaseHold[Hold[(p1v . p1v + p3v . p3v)/
((p3v - p1v)*(p3v - p1v)*(\[Alpha]^2*p3v . p3v + 1)^2)]]]
jj = FullSimplify[a*b]
Now, the following symbolic integral doesn't seem to work, i.e. Mathematica just spits back the input
Integrate[(p1v . p1v + p3v . p3v)/(E^(I*p1v . xv)*
((p1v - p3v)^2*(1 + \[Alpha]^2*p3v . p3v)^2)),
{p1v, -Infinity, Infinity}, {p3v, -Infinity, Infinity}]
but neither do the following NIntegrate commands work
NIntegrate[(p1v . p1v + p3v . p3v)/(E^(I*p1v . xv)*
((p1v - p3v)^2*(1 + p3v . p3v)^2)), {p1v, 0, 1}, {p3v, 0, 1},
{xv, 0, 1}]
NIntegrate::inumr: The integrand (E^(-I p1v.xv) (p1v.p1v+p3v.p3v))/((p1v-p3v)^2 (1+p3v.p3v)^2) has evaluated to non-numerical values for all sampling points in the region with boundaries {{0,1},{0,1},{0,1}}.
Note that above, \Alpha was taken to be zero, and a simultaneous integration over $\vec{x}$ was attempted, if Mathematica can't do any kind of semi-numerical integration.
The following NIntegrate doesn't work either - probably because I don't know how to make Mathematica perform a numerical integration with an algebraic parameter.
NIntegrate[(p1v . p1v + p3v . p3v)/(E^(I*p1v . xv)*
((p1v - p3v)^2*(1 + p3v . p3v)^2)), {p1v, 0, 1}, {p3v, 0, 1}]
NIntegrate::inumr: The integrand (E^(-I p1v.xv) (p1v.p1v+p3v.p3v))/((p1v-p3v)^2 (1+p3v.p3v)^2) has evaluated to non-numerical values for all sampling points in the region with boundaries {{0,1},{0,1}}.
If there is a way to conclusively know before integration whether the integrals are non-convergent, that would be very helpful, but that's also unknown to me how to do that in Mathematica.Arny Toynbee2017-10-12T16:51:05ZAffordable Care Act: an experiment on possible new regulations
http://community.wolfram.com/groups/-/m/t/1201589
President Trump will evidently propose today (10/12/2017) some expansion of alternative health insurance arrangements such as "short term health insurance" or "Association Health Plans." Supporters say this proposal will give more Americans the chance to buy health insurance policies at lower prices and that better fit their needs. Critics say that this expansion will result in healthier people deserting insurance plans in which the price can not depend on the expected claims of the individual. This desertion will in turn cause expected claims in the original pool to rise, leading to insurers losing money and raising prices.
Can Mathematica quantify this possibility? Thus, a little quick experiment.
I start with a reparameterized version of the lognormal distribution in which the first parameter is the mean and the second parameter is the ratio of the median to the mean.
LogNormalDistribution3[m_,ν_]:=LogNormalDistribution[Log[m]-Log[1/ν],Sqrt[2] Sqrt[Log[1/ν]]]
Here is probability density function for the values of parameters used below:
Plot[PDF[LogNormalDistribution3[7000, 0.27], x], {x, 0, 10^3}, PlotTheme -> "Business"]
![enter image description here][1]
I now create a risk pool with 100, 000 persons with mean claims of 7,000 and a ratio of median to mean of 0.27. This models fairly well the current situation. The actual selection of the mean does not affect the results. The median to mean ratio does affect results, however.
rv = RandomVariate[LogNormalDistribution3[7000, 0.27], 100000]
![enter image description here][2]
Now, create a function that computes the mean claims of those not defecting to an alternative pool when those with expected claims below the median have a specified probability of defecting to the alternative pool. We could create a more general defection function that made the probability of defection depend inversely on the expected claims of the individual, but this approach strikes me as reasonable for a quick and dirty analysis.
residualExpectedClaims[rv_,defectionProbability_]:=Mean@Pick[rv,
With[{median=Median[rv]},Map[If[#<median,RandomVariate[BernoulliDistribution[1-defectionProbability]],1]&,rv]],1]
Now let's run an experiment in which 25% of those below the median defect.
r025 = residualExpectedClaims[rv, 0.25]
We can now compute the fractional increase in risk in the original pool.
(r025-Mean[rv])/Mean[rv]
The answer is about 13%.
We can also make a table showing how the residual expected claims vary as the fraction of defectors increases:
originalPoolExpectedClaims=Table[{defectPct,residualExpectedClaims[rv,defectPct]},{defectPct,0,0.9,0.1}]
Here's the output:
> {{0., 7000.}, {0.1, 7322.07}, {0.2, 7684.62}, {0.3, 8111.13}, {0.4, 8552.09},
> {0.5, 9061.95}, {0.6, 9677.75}, {0.7, 10359.4}, {0.8, 11146.6}, {0.9, 12142.1}}
ListLinePlot[originalPoolExpectedClaims, PlotTheme -> "Business"]
![enter image description here][3]
There's obviously more that can be done, but I thought Mathematica did a great job here in quickly modeling out the consequences of what may be a very important policy change in the United States.
# Closed form solution
It turns out there is a closed form solution to the problem I originally posed and for which I originally simulated results. I present it here.
Recall that the project is to determine the ratio between the expected values (means) of two distributions: an original distribution and a post-defection distribution. The original distribution represents the health insurance claims filed by a pool of insureds. It is described as a lognormal distribution that has a mean of *m* and a ratio between its median and its mean of *v*. One can think of *v* as a measure of the heterogeneity of claims. Low *v* means claims are highly heterogeneous; high *v* means the distribution is more symmetric and that claims are fairly homogeneous.
LogNormalDistribution3[m_, \[Nu]_] :=
LogNormalDistribution[Log[m] - Log[1/\[Nu]],
Sqrt[2] Sqrt[Log[1/\[Nu]]]];
original = LogNormalDistribution3[m, v];
The idea of the post-defection distribution is that, because of hypothesized implementations of an Executive Order signed today by President Trump, some fraction of those below the median level of claims might purchase alternative forms of insurance. We can describe the post-defection distribution as a mixture distribution in which the weights are *a* and 1-*a*. The components are both truncated distributions, the first being right-truncated at the median and the second being left-truncated at the median.
postDefection =
MixtureDistribution[{a,
1 - a}, {TruncatedDistribution[{0, m*v}, original],
TruncatedDistribution[{m*v, \[Infinity]}, original]}]
We can now compute the mean of the post-defection distribution. The output is called *ratio*. Warning: this may take up to 10 minutes, depending on one's computer. Apparently, the underlying integral is somewhat complex.
ratio = FullSimplify[
Refine[Mean[postDefection], 0 < a < 1 && m > 0 && 0 < v < 1]/m]
The result is:
$$(2 a-1) \text{erfc}\left(\sqrt{-\log (v)}\right)-2 a+2$$
What we see is that the mean *m* has dropped out and that the ratio depends simply on the weighting *a* placed on those with claims less than the median and *v* the heterogeneity of the original distribution.
I would prefer to describe the scenario not in terms of weights attached to those with claims less than the median but rather with a fraction *b* of those with claims below the median that will defect to alternative forms of insurance due to implementations of the Trump executive order. This can be done with a reparameterization rule:
reparameterizationRule = a -> ((1 - b)*(1/2))/((1 - b)*(1/2) + 1/2);
FullSimplify[ratio /. reparameterizationRule]
The result is
$$\frac{b \text{erfc}\left(\sqrt{-\log (v)}\right)-2}{b-2}$$
We can thus write our final function *meanRatio* that yields the desired result:
meanRatio[v_, b_] := (-2 + b*Erfc[Sqrt[-Log[v]]])/(-2 + b)
If we set v=0.27 and b=0.25 -- which was what was done in the original simulation -- we obtain 1.12777, which is extremely close to the simulated result. If 25% of those with claims below the median defect to alternative forms of insurance, the mean claims of those remaining in the original pool goes up about 13%.
The code below produces a surface showing how different values of *v* and *b* determine the ratio of mean claims post defection to original mean claims.
Plot3D[meanRatio[v, b], {v, 0.05, 0.95}, {b, 0, 1},
AxesLabel -> {"median to mean ratio", "defector fraction", "new mean ratio"},
ImageSize -> 600, ColorFunction -> "TemperatureMap", MeshFunctions -> {#3 &}]
![enter image description here][4]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=erttrtgsfd345rehgsda.png&userId=11733
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=34yewgadfs.png&userId=11733
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ert4354whtrsbdv.png&userId=11733
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=ScreenShot2017-10-20at5.35.48AM.png&userId=11733Seth Chandler2017-10-12T13:45:43ZIncrease speed in notebook that uses Dynamic[FinancialData]
http://community.wolfram.com/groups/-/m/t/1200792
I want to make a cfd that presents an analysis of the course of stock prices obtained from FinancialData and in which the user can jump from one stock to another. But when I for instance make a notebook with the following commands
Dynamic[p]
Dynamic{FinancialData[p,{2017,1,1}]
p="GE"
Mathematica becomes awfully slow, while other programs at the same time keep running at the usual speed. Is there any remedy for this problem?
In the Windows 10 task manager I can see that Mathematica uses only about 1% of the Intel i5 processor and 92 MB of the 8 GB memory while the Mathematica Kernel uses about 5% of the processor, 288 MB of the memory and 1 to 2 Mbps of my 50 Mbps download internet connection speed.Laurens Wachters2017-10-10T12:35:43Z[✓] Choose dates dynamically with a Slider?
http://community.wolfram.com/groups/-/m/t/1195481
I would like to select a date from a list of dates using a slider, and show the chosen date right underneath the slider in the form of a date string..
Take for instance the following simple list:
list={{2000, 1, 3}, {2000, 1, 4}, {2000, 1, 5}, {2000, 1, 6}, {2000, 1, 7}, {2000, 1, 10}, {2000, 1, 11}, {2000, 1, 12}, {2000, 1, 13}, {2000, 1, 14}}
So I could for instance choose with the slider the third element of this list, which is {2000, 1,5}, and then convert this with the command DateString[DatObject[{2000, 1, 7}]] to the data string "Wed 5 Jan 2000". Now I want this date string shown underneath the slider instead of the usual number, which in this case would be 3.
The slider would be for instance:
Slider[Dynamic[m],{1,10,1}
The problem is now that Dynamic[m] is not accepted by Part. With the command
list[[Dynamic[m]]]
one gets an error message that the result from the slider cannot be used as a part specification.
How do I solve this problem? Thanks in advance for your help.Laurens Wachters2017-10-01T20:35:36Z[WSS16] Quantum Computing with the Wolfram Language
http://community.wolfram.com/groups/-/m/t/897811
**Introduction to the Problem**
While a gate-based quantum computer has yet to be implemented at the level of more than a handful of qubits, and some worry that the decoherence problem will remain an obstacle to real-world use of these machines; the field of theoretical quantum computing has its own virtue apart from these problems of construction and implementation. The theory of quantum computation and quantum algorithms have been used as powerful tools to tackle long-standing problems in classical computation such as proving the security of certain encryption schemes and refining complexity classifications for
some approaches to the Traveling Salesman problem. Moreover, learning how to apply quantum effects like superposition, interference, and entanglement in a useful, computational, manner can help students gain a better understanding of how the quantum world really works. These educational and research advantages of quantum computing, along with the ever-present goal of designing new quantum algorithms that can provide us with speedups over their classical counterparts, furnish ample reason to make the field as accessible as possible. The goal of this project was to do just that by using the Wolfram language to design functionality that allows for researchers and students alike to engage with quantum computing in a meaningful way.
**Getting it Done**
This project involved the design and development of a suite of functions that allows for the simulation of quantum computing algorithms. The overarching goal was a framework that allows for easy implementation of quantum circuits, with minimal work done by the user. The specific design challenges were to have a tool simple enough to be used as an educational aide and powerful enough for researchers. To this end circuits can be built iteratively, allowing students, and those new to quantum computing, to build a working knowledge of the field as they increase the complexity of the algorithms. The system has a universal set of gates allowing it to carry out any operation possible for a quantum computer (up to limits on the number of qubits due to the size of the register).
----------
*Short note on this: I have not rigorously tested the system yet, but unless you want to wait several hours for your computation to complete, I suggest not attempting computations with more than ~20 qubits. To classically simulate an N-qubit register, requires a state vector of length 2<sup>N</sup>. Interestingly, it is this insight into the computational difficulty of simulating a quantum state that led Feynman to realize the power that quantum computing could have.*
----------
The project has functionality for the following gates: Hadamard, X, Y, Z, Rotation (any angle, about any axis), C-NOT, C-anything, SWAP, and QFT. It takes input in standard quantum circuit notation, and can output circuit diagrams, and the corresponding unitary transformation matrix as well as return the probabilities for results of measurements on a given qubit. Moreover, there is built in functionality for easy circuit addition, allowing one to stitch together large circuits from smaller ones, a boon for comprehension and testing.
**A Simple Example**
We initialize some random circuit by specifying it's corresponding circuit notation. For sake of brevity, we start with a medium-sized circuit that is already formed, and perform operations on it, but one can easily build a circuit up qubit-by-qubit and gate-by-gate with the applyQ and circuitQ functions. Below we name some variable `quantumCircuit` using the function `circuitQ` to which we pass some circuit notation. This notation is just a matrix representing the quantum logic circuit, with the gates and qubits arranged schematically.
quantumCircuit= circuitQ[{{"H", "R[1,Pi/2]", "N", "SWAP1"}, {"H", 1, "C",
"SWAP2"}, {"X", 1, "C", 1}}];
`circuitQ` outputs the circuit diagram corresponding to the notation given:
![enter image description here][1]
But, say I wish to alter the circuit. We can add in as many layers of gates or extra qubits as we wish, without having to deal with the pesky notation matrix. Here I add a Hadamard gate to the second qubit after the SWAP using the function `applyQ`:
applyQ[quantumCircuit, "H", 2]
the output of which is:
![enter image description here][2]
One can also use `Append`, `Join`,`Nest` and a variety of other Wolfram language functions to build up highly complex circuits. However, the `circuitQ` function is overloaded, and one can also perform computations with it. We will now build the actual unitary transformation matrix that corresponds to the circuit diagram:
unitar=matrixBuild@quantumCircuit
which, for our circuit, produces:
![enter image description here][3].
Now we can easily perform operations with circuit. Let's specify some random 3 qubit initial state (in the computational basis):
initalState = {1, 0, 0, 1, 0, 0, 1, 0} // Normalize
![enter image description here][4]
We can pass this initial state to the circuit easily with:
premeasure=unitar.initialState
which gives back the state of the quantum register (in this case our 3 qubits) after they have been operated on by the circuit, but pre-measurement:
![enter image description here][5]
We can now sample our state using the `projection` function. Here we will calculate the probability of getting state |0> when measuring qubit #3:
projection[2,0,premeasure]
which, for our case, gives back a probability of 2/3.
**Wrap Up**
This was only a very simple example. Using `applyQ` and `circuitQ` one can build and modify highly complex quantum circuits easily. `matrixBuild` does all the math of calculating the corresponding unitary transformation matrix for you. All that is left is for the user to pass an initial state and see the output. A good learning technique is to start with a very simple circuit and initial state, and slowly build up in complexity, performing measurements at each step, to build an intuition and working knowledge of any given quantum circuit.
An obvious next step for the project would be to add functionality that allows for the easy implementation of a general quantum oracle. I would also like to add more gates to the gate library, including: $\sqrt{SWAP}$, Tofolli, and QFT<sup>-1</sup> which were left out due to lack of time and are trivial to implement. These tools would make it significantly easier for researchers to model any given quantum circuit.
**Where is the NKS?**
Finding quantum algorithms that perform useful tasks faster than their classical counterparts is an open area of research. However, it is often quite difficult to design these algorithms to take advantage of interference, as well as the structure in a given computational problem that may be useful to exploit. As such, there are only a small number of important quantum algorithms that are currently known. Hopefully this tool will allow for NKS-style search experiments for interesting behavior in quantum circuits. Similar searches have been carried out for classical circuits, and the tools I built will make it easy to generate vast sets of random quantum circuits that follow certain rules. What remains is to build useful analytic tools for combing the space.
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=circuit.jpeg&userId=896802
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=circuit2.jpeg&userId=896802
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=unitar.jpeg&userId=896802
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=3114initialstate.jpeg&userId=896802
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=finalstate.jpeg&userId=896802Aaron Tohuvavohu2016-08-02T02:35:38Z[✓] Represent a vector moving on three mutually perpendicular circles?
http://community.wolfram.com/groups/-/m/t/1201063
Dear Friends,
I have three concentric circles in planes mutually perpendicular to each other (say, x2 + y2 = r2, z2 + y2 = r2, x2 + z2 = r2). There is a vector R (theta, phi), which is constrained to move only on the circumference of these circles (having its tail fixed at the common center of the three circles). How can I represent this vector mathematically in Mathematica, in order to find its dot product with another fixed vector F(theta_1, phi_1).
Will appreciate any suggestion regarding this.
ThanksS G2017-10-11T07:21:59ZSemanticImport fails for every file in Mathematica 11.0
http://community.wolfram.com/groups/-/m/t/904715
This is a follow up on this [post][1].
Using SemanticImport on any file, even those mentioned in the Documentation examples e.g. :
SemanticImport["ExampleData/RetailSales.tsv"]
Gives an error:
**SemanticImport::unexpinvaliderr: Unexpected invalid input was detected. Processing will not continue**
I came across an issue with the SemanticImport as my previous attempt to import a large csv file caused a crash of the Mathematica Kernel and took Windows 10 Pro 64-bit with it as it consumed all remaining 4GB RAM.
The work-around mentioned in the aforementioned post still works i.e. make sure you change the path to the temp directory i.e.
Block[{$TemporaryDirectory = "C:\\temp"}, SemanticImport["ExampleData/RetailSales.tsv"]]
Is this a known bug?
Cheers,
Dave
[1]: http://community.wolfram.com/groups/-/m/t/819494?_19_redirect=http://community.wolfram.com/dashboard?p_p_id=3&p_p_lifecycle=0&p_p_state=maximized&p_p_mode=view&_3_groupId=0&_3_keywords=semanticimport&_3_struts_action=%252Fsearch%252Fsearch&_3_redirect=%252Fweb%252Fcommunity%252F%253Fsource%253DnavDave Middleton2016-08-13T23:48:12ZWolfram Player for iOS
http://community.wolfram.com/groups/-/m/t/1197947
[![enter image description here][1]][2]
We are [**excited to announce**][2] the release of Wolfram Player for iOS! Now you can harness the power of the Computable Document Format (CDF) anytime, anywhere. Wolfram Player syncs up with other apps on your mobile device—allowing you to access documents from any source—including from the Wolfram Cloud, iTunes, Dropbox and more!
One of the biggest features of this app is the ability to sideload documents into Wolfram Player from other applications. Additionally, Demonstrations and other Manipulate figures look and feel a lot more like what we envision them to be. The intuitive tactile interface offered by Wolfram Player gives a true hands-on approach to interactive modeling in a way that's never been done before.
When integrated with the Wolfram Cloud app, you can seamlessly move between designing notebooks and pulling them down for testing, thereby paving the way for increased collaboration and efficiency for a variety of projects.
[**Check it out for yourself**][3].
[![enter image description here][4]][3]
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=player_image.jpg&userId=515558
[2]: http://blog.wolfram.com/2017/10/04/notebooks-in-your-pocket-wolfram-player-for-ios-is-now-shipping/
[3]: https://itunes.apple.com/us/app/wolfram-player/id1059014516
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=Wolfram_Notebooks_Timeline2.png&userId=11733Jesse Dohmann2017-10-04T16:21:05ZCreate and deploy your own paclets in the Workbench
http://community.wolfram.com/groups/-/m/t/961186
# References
[![enter image description here][7]][8]
- [GitLink for Wolfram Language][9]
- [What is a “Paclet”?][10]
- [What can I do with “Syntax Templates” section at start of Symbol Pages (in Workbench)?][11]
# Eclipse work flow
If necessary, install the Wolfram WorkBench Plugin for Eclipse.
http://support.wolfram.com/kb/27221
In Windows - Preferences - Wolfram - Special make the following changes
![enter image description here][1]
Apply and press OK. Then re-open preferences and go to Paclet Development. Enable function paclet support.
![enter image description here][2]
# Create a new application project
![enter image description here][3]
![enter image description here][4]
Open the ***PacletInfo.m*** file and useful buttons now appear.
![enter image description here][5]
Also edit your project properties or the nice buttons may vanish after a build or when you close the project.
![enter image description here][6]
# Build
Build your project and documentation as usual and then create your Paclet file and deploy.
# Install
You can install from a local file path, http or ftp as print definitions reveals.
PacletInstall[filepath]
Needs["GeneralUtilities`"]
PrintDefinitions["PacletInstall"]
PrintDefinitions["PacletManager`Manager`Private`installPacletFromFileOrURL"]
There is no current support for https but this can be patched or you can easily call PacletInstall after downloading and creating a new file name for the download. This could be handy if you wanted to install from GitHub.
[1]: http://community.wolfram.com//c/portal/getImageAttachment?filename=sdf34q5w6yethdgsdfa.png&userId=11733
[2]: http://community.wolfram.com//c/portal/getImageAttachment?filename=rthe567iteyrtq54htefadvs.png&userId=11733
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=345tjhgfsdase56eutyjhstdgas.png&userId=11733
[4]: http://community.wolfram.com//c/portal/getImageAttachment?filename=safd345q65uyhrtgfdasr43q5ega.png&userId=11733
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=asdf435657iifgshr54657eiutj.png&userId=11733
[6]: http://community.wolfram.com//c/portal/getImageAttachment?filename=fghu356rtgerfsgw6ejtrsa.png&userId=11733
[7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=logo.png&userId=11733
[8]: https://github.com/WolframResearch/GitLink
[9]: https://github.com/WolframResearch/GitLink
[10]: http://mathematica.stackexchange.com/questions/1660/what-is-a-paclet
[11]: http://mathematica.stackexchange.com/questions/66754Emerson Willard2016-11-11T13:22:20ZAnalysis of rates of murder by firearms in the US
http://community.wolfram.com/groups/-/m/t/1200009
## Data Collection ##
###Murder by firearms###
The FBI, through its criminal justice information services division, collects information on murders by types of weapon, at a state level. Statistics available are from 2011.
[https://www.fbi.gov/about-us/cjis/ucr/crime-in-the-u.s/2011/crime-in-the-u.s.-2011/tables/table-20][1]
murderData =
Import["https://www.fbi.gov/about-us/cjis/ucr/crime-in-the-u.s/2011/\
crime-in-the-u.s.-2011/tables/table-20", "Data"][[3, 2, 3,
2]]; murderLbl = First@murderData; murderData =
Most@First@Rest@murderData;
murderData[[All, 1]] =
Check[Interpreter["AdministrativeDivision"][#], #] & /@
murderData[[All, 1]];
murderData[[12, 1]] = Entity["AdministrativeDivision", {"Illinois", "UnitedStates"}]
MapIndexed[Sequence, murderLbl]
(*{"State", {1}, "Total murders 1", {2}, "Total firearms", {3}, "Handguns", {4}, "Rifles", {5}, "Shotguns", {6}, "Firearms (type unknown)", {7}, "Knives or cutting instruments", {8}, "Other \
weapons", {9}, "Hands, fists, feet, etc. 2", {10}}*)
###Population Data###
Population data is readily available in Wolfram Mathematica.
pop = EntityValue[murderData[[All, 1]], "Population"];
###Legislative Control###
State and legislative control data can be obtained from the National Conference of State Legislatures.
[http://www.ncsl.org/Portals/1/Documents/Elections/Legis_Control_ 2016_Apr20.pdf][2]
Data was scrubbed and placed in variable stateComposition that holds the information on which party holds the power for the state. Finally a dataset was created holding the political control of each state.
dComp = Dataset[
Association[(Thread[
Rule[stateComposition[[All,
1]], (AssociationThread[{"abbreviation", "party"}, #] & /@
stateComposition[[All, 2 ;; 3]])]])]]
GeoRegionValuePlot[(dComp[All, "party"] // Normal //
Normal) /. {"Dem" -> 1, "Rep" -> 2, "Divided" -> 3},
ColorRules -> {1 -> Blue, 2 -> Red, 3 -> Yellow},
PlotLegends ->
Placed[SwatchLegend[{Blue, Red, Yellow}, {"Democrat", "Republican",
"Divided"}, LegendFunction -> "Frame"], Bottom]]
![enter image description here][3]
###Gun Freedom Index###
Used Guns & Ammo Magazine data to rank states numerically based on the following categories.
1. Right to Carry: how restrictive each state are in prohibiting
carry in different locations, how readily can citizens obtain
permits, etc.
2. Modern Sporting Rifles: restrictions on
semiautomatic firearms not regulated by NFA and restrictions on
magazine capacity and/or accessories.
3. NFA: The National Firearms
Act (NFA) of 1934 has placed certain restrictions on the purchase of
certain categories of weaponry. States can further restrict and
regulate these weapons (machine guns, silencers, short-barrelled
rifles and shotguns, etc..
4. Castle Doctrine: English common law
established that a man's home is his castle and has a right to
defend it. Status and case law in each state can regulate and impose
restrictions in a citizen's ability for self defense.
5. Miscellaneous: issues such as purchase/registrations requirements,
gun ownership percentage, availability of ranges, etc.
[http://www.gunsandammo.com/network-topics/culture-politics-network/best-states-for-gun-owners-2014/][4]
SetDirectory[NotebookDirectory[]];
gunFreedomIndexData = SemanticImport["gunfreedomindex.xlsx"];
gfi[state_] :=
Flatten@Normal[
Normal[gunFreedomIndexData[
Select[#State == state &], {"Ranking", "total"}][Values]]]
gfi = gfi[#] & /@ murderData[[All, 1]];
(*data={#\[LeftDoubleBracket]1\[RightDoubleBracket],100000#\
\[LeftDoubleBracket]2\[RightDoubleBracket]/QuantityMagnitude[#\
\[LeftDoubleBracket]3\[RightDoubleBracket]]//N,#\[LeftDoubleBracket]4\
\[RightDoubleBracket],#\[LeftDoubleBracket]5\[RightDoubleBracket]}&/@(\
Flatten[#]&/@Transpose[{murderData[[All,{1,3}]],pop,gfi}])*)
ds = Dataset[Association[(Thread[Rule[data[[All, 1]], (AssociationThread[{"gunFreedomIndex",
"murderByFirearm"}, #] & /@ data[[All, {3, 2}]])]])]]
###Auxiliary functions for Data Visualization###
colorRules = {"Dem" -> (BaseStyle -> {FontColor -> White,
Background -> Blue}),
"Divided" -> (BaseStyle -> {FontColor -> Black,
Background -> Yellow}),
"Rep" -> (BaseStyle -> {FontColor -> White, Background -> Red})};
text[state_, function_] :=
Text[dComp[state, "abbreviation"], function[state],
dComp[state, "party"] /. colorRules]
##Data Visualization##
###Murder Rates by Firearms vs. Gun Control###
Let's chart the murder rates vs. the gun freedom ranking. This should give us an indication if the gun control restrictions have any influence on murder rates committed with firearms.
coords[state_] :=
ds[state][{"gunFreedomIndex", "murderByFirearm"}] // Values // Normal
lmf = LinearModelFit[coords /@ Normal[Keys[ds]], x, x];
Column[{Show[
ListPlot[coords /@ Normal[Keys[ds]], PlotTheme -> "Detailed",
FrameLabel -> {"Gun Freemdom Ranking",
"MurderByFireArmRate (per 100k)"},
Epilog ->
Inset[Style[
"\!\(\*SuperscriptBox[\(R\), \(2\)]\)=" <>
ToString@lmf["AdjustedRSquared"]], {5, 11}],
PlotRangePadding -> None, PlotRange -> {{0, 52}, {0, 12}},
ImageSize -> Large,
PlotLabel ->
Style["Murder Rate vs Gun Control Measures", Black, Bold]],
Plot[lmf[x], {x, 0, 52}],
Graphics[text[#, coords] & /@ Normal[Keys[ds]]]],
Row[{Text["Democrat",
BaseStyle -> {FontColor -> White, Background -> Blue}],
Text[" "],
Text["Divided", BaseStyle -> {Background -> Yellow}],
Text[" "],
Text["Republican",
BaseStyle -> {FontColor -> White, Background -> Red}]}]},
Alignment -> Center]
![enter image description here][5]
There seems to be no correlation between murders by firearms and the gun freedom index.
###Murder Rates by Firearms vs. Gun Ownership Rates###
The article by [Bindu Kalesan, et al "Gun Ownership and social culture"][6] provide some data points on the gun ownership rates by state.
gunOwnerShip = Import["GunOwnershipRate.xlsx", {"Data", 1}];
gunOwnerShip[[All, 1]] =
Interpreter["AdministrativeDivision"][#] & /@ gunOwnerShip[[All, 1]];
go = Dataset[Association[Rule[#1, #2] & @@@ gunOwnerShip]]
gof[state_] := {go[state], ds[state]["murderByFirearm"]}
lmf = LinearModelFit[gof /@ Normal[Keys[ds]], x, x];
Column[{Show[
ListPlot[gof /@ Normal[Keys[ds]], PlotTheme -> "Detailed",
FrameLabel -> {"Gun Ownership (%)",
"MurderByFireArmRate (per 100k)"},
Epilog ->
Inset[Style[
"\!\(\*SuperscriptBox[\(R\), \(2\)]\)=" <>
ToString@lmf["AdjustedRSquared"]], {60, 11}],
PlotRangePadding -> None, ImageSize -> Large,
PlotRange -> {{0, 70}, {0, 12}},
PlotLabel ->
Style["Murder Rate vs Gun Ownership (%)", Black, Bold]],
Plot[lmf[x], {x, 0, 70}],
Graphics[text[#, gof] & /@ Normal[Keys[ds]]]],
Row[{Text["Democrat",
BaseStyle -> {FontColor -> White, Background -> Blue}],
Text[" "],
Text["Divided", BaseStyle -> {Background -> Yellow}],
Text[" "],
Text["Republican",
BaseStyle -> {FontColor -> White, Background -> Red}]}]},
Alignment -> Center]
![enter image description here][7]
In this case, again, we don't see a correlation between citizen gun ownership and murder rates.
We can't say the same regarding the availability of guns to law abiding citizens.
gRestriction[state_] := {ds[state]["gunFreedomIndex"], go[state]};
lmf = LinearModelFit[gRestriction /@ Normal[Keys[ds]], x,
x]; Column[{Show[
ListPlot[gRestriction /@ Normal[Keys[ds]], PlotTheme -> "Detailed",
FrameLabel -> {"Gun Freedom Ranking", "Gun Ownership (%)"},
Epilog ->
Inset[Style[
"\!\(\*SuperscriptBox[\(R\), \(2\)]\)=" <>
ToString@lmf["AdjustedRSquared"]], {5, 48}],
PlotRangePadding -> None, ImageSize -> Large,
PlotRange -> {{0, 52}, {0, 70}},
PlotLabel ->
Style["Gun Ownership (%) vs. Gun Freedom Ranking", Black, Bold]],
Plot[lmf[x], {x, 0, 52}],
Graphics[text[#, gRestriction] & /@ Normal[Keys[ds]]]],
Row[{Text["Democrat",
BaseStyle -> {FontColor -> White, Background -> Blue}],
Text[" "],
Text["Divided", BaseStyle -> {Background -> Yellow}],
Text[" "],
Text["Republican",
BaseStyle -> {FontColor -> White, Background -> Red}]}]},
Alignment -> Center]
![enter image description here][8]
Let's explore the data against socioeconomic factors now.
###Murder Rates vs Income Inequality###
The Gini Index is a measure of income inequality:
gini[state_] := {EntityValue[state, "GiniIndex"],
ds[state]["murderByFirearm"]}
lmf = LinearModelFit[gini /@ Normal[Keys[ds]], x, x]
Column[{Show[
ListPlot[gini /@ Normal[Keys[ds]], PlotTheme -> "Detailed",
FrameLabel -> {"Gini Index", "MurderByFireArmRate (per 100k)"},
Epilog ->
Inset[Style[
"\!\(\*SuperscriptBox[\(R\), \(2\)]\)=" <>
ToString@lmf["AdjustedRSquared"]], {0.53, 8}],
PlotRangePadding -> None, ImageSize -> Large,
PlotRange -> {{0.4, 0.55}, {0, 12}},
PlotLabel -> Style["Murder Rate vs Gini Index", Black, Bold]],
Plot[lmf[x], {x, 0.4, 0.55}],
Graphics[text[#, gini] & /@ Normal[Keys[ds]]]],
Row[{Text["Democrat",
BaseStyle -> {FontColor -> White, Background -> Blue}],
Text[" "],
Text["Divided", BaseStyle -> {Background -> Yellow}],
Text[" "],
Text["Republican",
BaseStyle -> {FontColor -> White, Background -> Red}]}]},
Alignment -> Center]
![enter image description here][9]
###Murder Rate vs. Poverty Level###
Poverty level data was obtained from the Census Bureau. Numbers represent estimated number of individuals in 2009 living below the poverty level.
[(http://www2.census.gov/library/publications/2011/compendia/statab/131ed/tables/12s0709.xls)][10]
stateRules =
Thread[Rule[
EntityValue[
EntityList[
EntityClass["AdministrativeDivision", "AllUSStatesPlusDC"]],
"StateAbbreviation"],
EntityList[
EntityClass["AdministrativeDivision", "AllUSStatesPlusDC"]]]]
povertyLevel =
Dataset[Association[
Rule[#1, #2] & @@@ {{"AL", 17.5}, {"AK", 9.}, {"AZ", 16.5}, {"AR",
18.8}, {"CA", 14.2}, {"CO", 12.9}, {"CT", 9.4}, {"DE",
10.8}, {"DC", 18.4}, {"FL", 14.9}, {"GA", 16.5}, {"HI",
10.4}, {"ID", 14.3}, {"IL", 13.3}, {"IN", 14.4}, {"IA",
11.8}, {"KS", 13.4}, {"KY", 18.6}, {"LA", 17.3}, {"ME",
12.3}, {"MD", 9.1}, {"MA", 10.3}, {"MI", 16.2}, {"MN",
11.}, {"MS", 21.9}, {"MO", 14.6}, {"MT", 15.1}, {"NE",
12.3}, {"NV", 12.4}, {"NH", 8.5}, {"NJ", 9.4}, {"NM",
18.}, {"NY", 14.2}, {"NC", 16.3}, {"ND", 11.7}, {"OH",
15.2}, {"OK", 16.2}, {"OR", 14.3}, {"PA", 12.5}, {"RI",
11.5}, {"SC", 17.1}, {"SD", 14.2}, {"TN", 17.1}, {"TX",
17.2}, {"UT", 11.5}, {"VT", 11.4}, {"VA", 10.5}, {"WA",
12.3}, {"WV", 17.7}, {"WI", 12.4}, {"WY", 9.8}} /. stateRules]]
poverty[state_] := {povertyLevel[state], ds[state]["murderByFirearm"]}
lmf = LinearModelFit[poverty /@ Normal[Keys[ds]], x, x]
Column[{Show[
ListPlot[poverty /@ Normal[Keys[ds]], PlotTheme -> "Detailed",
FrameLabel -> {"Individuals under Poverty Line (%)",
"MurderByFireArmRate (per 100k)"},
Epilog ->
Inset[Style[
"\!\(\*SuperscriptBox[\(R\), \(2\)]\)=" <>
ToString@lmf["AdjustedRSquared"]], {23, 6}],
PlotRangePadding -> None, ImageSize -> Large,
PlotRange -> {{5, 25}, {0, 12}},
PlotLabel -> Style["Murder Rate vs Poverty Level", Black, Bold]],
Plot[lmf[x], {x, 5, 25}],
Graphics[text[#, poverty] & /@ Normal[Keys[ds]]]],
Row[{Text["Democrat",
BaseStyle -> {FontColor -> White, Background -> Blue}],
Text[" "],
Text["Divided", BaseStyle -> {Background -> Yellow}],
Text[" "],
Text["Republican",
BaseStyle -> {FontColor -> White, Background -> Red}]}]},
Alignment -> Center]
![enter image description here][11]
###Murder Rates vs Race Composition###
Population estimates by race were obtained from the US Census Bureau. (https://www.census.gov/popest/data/state/asrh/2014/index.html)
race = Import["PEP_2011_PEPSR5H.xls", {"Data", 1}];
racelbl = Rest@First@race; race = Rest@Rest@race;
race[[All, 1]] =
Interpreter["AdministrativeDivision"][#] & /@ race[[All, 1]];
dsRace = Dataset[
Association[
Thread[Rule[race[[All, 1]],
AssociationThread[racelbl, #] & /@ race[[All, 2 ;;]]]]]]
aaRate[state_] := {100 dsRace[state, "africanamericanRate"],
ds[state, "murderByFirearm"]}
lmf = LinearModelFit[aaRate /@ Normal[Keys[ds]], x, x]
Column[{Show[
ListPlot[aaRate /@ Normal[Keys[ds]], PlotTheme -> "Detailed",
FrameLabel -> {"African American Population (%)",
"MurderByFireArmRate (per 100k)"}, PlotRangePadding -> None,
ImageSize -> Large, PlotRange -> {{0, 60}, {0, 12}},
Epilog ->
Inset[Style[
"\!\(\*SuperscriptBox[\(R\), \(2\)]\)=" <>
ToString@lmf["AdjustedRSquared"]], {50, 10}],
PlotLabel ->
Style["Murder Rate vs African American Population(%)", Black,
Bold]], Plot[lmf[x], {x, 0, 60}],
Graphics[text[#, aaRate] & /@ Normal[Keys[ds]]]],
Row[{Text["Democrat",
BaseStyle -> {FontColor -> White, Background -> Blue}],
Text[" "],
Text["Divided", BaseStyle -> {Background -> Yellow}],
Text[" "],
Text["Republican",
BaseStyle -> {FontColor -> White, Background -> Red}]}]},
Alignment -> Center]
![enter image description here][12]
The Pew Hispanic center monitors the trends of hispanic population in the US. Breakout of the population population by states is availabe t their website.
[http://www.pewhispanic.org/states/][13]
hispanicData =
Import["http://www.pewhispanic.org/files/states/xls/ALL_11.xlsx", \
{"Data", 1}];
hispanicDataLbl = hispanicData[[5]];
hispanicData = hispanicData[[7 ;;]];
hispanicData[[All, 1]] =
Interpreter ["AdministrativeDivision"][#] & /@
hispanicData[[All, 1]];
dsHispanic =
Dataset[Association[
Thread[Rule[hispanicData[[All, 1]], hispanicData[[All, 3]]]]]];
hispanic[state_] := {100 dsHispanic[state],
ds[state, "murderByFirearm"]}
lmf = LinearModelFit[hispanic /@ Normal[Keys[ds]], x, x]
Column[{Show[
ListPlot[hispanic /@ Normal[Keys[ds]], PlotTheme -> "Detailed",
FrameLabel -> {"Hispanic Population (%)",
"MurderByFireArmRate (per 100k)"}, PlotRangePadding -> None,
ImageSize -> Large, PlotRange -> {{0, 60}, {0, 12}},
Epilog ->
Inset[Style[
"\!\(\*SuperscriptBox[\(R\), \(2\)]\)=" <>
ToString@lmf["AdjustedRSquared"]], {55, 3}],
PlotLabel ->
Style["Murder Rate vs Hispanic Population(%)", Black, Bold]],
Plot[lmf[x], {x, 0, 60}],
Graphics[text[#, hispanic] & /@ Normal[Keys[ds]]]],
Row[{Text["Democrat",
BaseStyle -> {FontColor -> White, Background -> Blue}],
Text[" "],
Text["Divided", BaseStyle -> {Background -> Yellow}],
Text[" "],
Text["Republican",
BaseStyle -> {FontColor -> White, Background -> Red}]}]},
Alignment -> Center]
![enter image description here][14]
[1]: https://www.fbi.gov/about-us/cjis/ucr/crime-in-the-u.s/2011/crime-in-the-u.s.-2011/tables/table-20
[2]: http://www.ncsl.org/Portals/1/Documents/Elections/Legis_Control_%202016_Apr20.pdf
[3]: http://community.wolfram.com//c/portal/getImageAttachment?filename=4951dComp.png&userId=78214
[4]: http://www.gunsandammo.com/network-topics/culture-politics-network/best-states-for-gun-owners-2014/
[5]: http://community.wolfram.com//c/portal/getImageAttachment?filename=mrvsgc.png&userId=78214
[6]: http://injuryprevention.bmj.com/content/early/2015/06/09/injuryprev-2015-041586.full.pdf?keytype=ref&ijkey=doj6vx0laFZMsQ2
[7]: http://community.wolfram.com//c/portal/getImageAttachment?filename=mrgo.png&userId=78214
[8]: http://community.wolfram.com//c/portal/getImageAttachment?filename=gogfr.png&userId=78214
[9]: http://community.wolfram.com//c/portal/getImageAttachment?filename=mrgini.png&userId=78214
[10]: http://www2.census.gov/library/publications/2011/compendia/statab/131ed/tables/12s0709.xls
[11]: http://community.wolfram.com//c/portal/getImageAttachment?filename=mrpl.png&userId=78214
[12]: http://community.wolfram.com//c/portal/getImageAttachment?filename=mraa.png&userId=78214
[13]: http://www.pewhispanic.org/states/
[14]: http://community.wolfram.com//c/portal/getImageAttachment?filename=mrhp.png&userId=78214William Playfair2017-10-09T04:06:31Z