Related
I wanted to calculate the probability associated to a given chi-squared value for any given number of degrees of freedom k. I could easily come up with this code:
P[chisquare_, k_] = Manipulate[NIntegrate[PDF[ChiSquareDistribution[k], x], {x, chisquare, Infinity}], {chisquare, 0, 10}, {k, 1, 10}]
but I was wondering: is there any way to do the opposite? I mean having the probability P as an input and getting the associated chi squared value? like if I wanted to compile a chi-squared table such as this https://www.medcalc.org/manual/chi-square-table.php
I tried using Solve but did not accomplish anything, is there an easy way around this?
You can do the integration with CFD and reverse with Quantile, e.g.
NIntegrate[PDF[ChiSquareDistribution[2], a], {a, 0, 3.0}]
0.77687
p = CDF[ChiSquareDistribution[2], 3.0]
0.77687
Quantile[ChiSquareDistribution[2], p]
Re. your link
Quantile[ChiSquareDistribution[2], 1 - #] & /# {0.995, 0.975, 0.20, 0.10, 0.05};
SetPrecision[#, If[# < 1, 3, 4]] & /# %
{0.0100, 0.0506, 3.219, 4.605, 5.991}
Here is an example 3D geometry.
dat=Import["ExampleData/747.3ds.gz", ImageSize -> Medium]
Now if one wants to get a BSplineFunction for this 3D geometry what is the easiest way to do it?
I can see the parts in Mathematica using the following command.
parts = Length[(dat // First // Last)];
and here comes the 3D points after extraction.
ListPointPlot3D[Flatten[Map[((dat // First // Last)[[#]] /.
GraphicsComplex[a_, b_] -> List[a]) &, Range[parts]], 1]]
I hope there is a general method so that we can form a BSpline function from any 3D graphics complex.
I suppose the general method will be able to convert Mathematica 3D representations in continuous BSplines representation.
Now we will elaborate according to the example given by belisarius.
v={{0,0,0},{2,0,0},{2,2,0},{0,2,0},{1,1,2}};
i={{1,2,5},{2,3,5},{3,4,5},{4,1,5}};
Graphics3D[{Opacity[.5],GraphicsComplex[v,Polygon[i]]}]
We can simply form the input for the BSpline surface for this example.
dat = Table[Map[v[[#]] &, i[[j]]], {j, 1, Length[i]}];
Now let's see the surface that comes out if we consider the underlying vertices.
Show[
(* Vertices *)
ListPointPlot3D[v,PlotStyle->{{Black,PointSize[.03]}}],
(* The 3D solid *)
Graphics3D[{Opacity[.4],GraphicsComplex[v,Polygon[i]]}],
(* The BSpline surface *)
Graphics3D[{Opacity[.9],FaceForm[Red,Yellow],
BSplineSurface[dat, SplineDegree-> {1,2},SplineClosed->{True,False}]}
],
Boxed-> False,Axes-> None
]
Once this surface is formed I thought it will be possible to make a BSplineFunction in some way. But what I get is completely different from the above surface.
func = BSplineFunction[dat, SplineDegree -> {1, 2},SplineClosed -> {True, False}];
Plot3D[func[x, y], {x, 0, 1}, {y, 0, 1}, Mesh -> None,PlotRange -> All]
So am I making some conceptual mistake here?
I think your question needs further clarification.
The .3DS are mainly Polygon sets like this one:
v = {{0, 0, 0}, {2, 0, 0}, {2, 2, 0}, {0, 2, 0}, {1, 1, 2}};
i = {{1, 2, 5}, {2, 3, 5}, {3, 4, 5}, {4, 1, 5}};
Graphics3D[{Opacity[.5], GraphicsComplex[v, Polygon[i]]}]
So, it is not obvious how to get Spline surfaces to model this.
Perhaps you can elaborate a little with this example.
HTH!
Minor detail: Your spline is a bit warped and that's because of your choice of SplineDegree. For the pyramid case I'd choose {2,1} instead of {1,2}.
That will give you a cone instead of the soft-ice cone you now have. Of course, that's all rather arbitrary and beauty is in the eye of the beholder.
Now for your question why a 3D plot of the BSplineFunction doesn't give the same results as a Graphics3D of a BSplineSurface with the same control points. The problem is that you assume that the two parameters in the BSplineFunction correspond to x and y of a Cartesian coordinate system. Well, they don't. Those parameters are part of an internal parametric description of the surface, in which varying these two parameters yields a set of 3D points, so you have to use ParametricPlot3D here.
So, if you change your Plot3D into ParametricPlot3D you'll see all is fine.
I hope this answers you final question. Does this also answer your question how to convert a 3D polygon based model to a spline based model? One of the problems you face is that a spline doesn't usually go through its control points, as a kind of interpolating function.
When plotting a function using Plot, I would like to obtain the set of data points plotted by the Plot command.
For instance, how can I obtain the list of points {t,f} Plot uses in the following simple example?
f = Sin[t]
Plot[f, {t, 0, 10}]
I tried using a method of appending values to a list, shown on page 4 of Numerical1.ps (Numerical Computation in Mathematica) by Jerry B. Keiper, http://library.wolfram.com/infocenter/Conferences/4687/ as follows:
f = Sin[t]
flist={}
Plot[f, {t, 0, 10}, AppendTo[flist,{t,f[t]}]]
but generate error messages no matter what I try.
Any suggestions would be greatly appreciated.
f = Sin[t];
plot = Plot[f, {t, 0, 10}]
One way to extract points is as follows:
points = Cases[
Cases[InputForm[plot], Line[___],
Infinity], {_?NumericQ, _?NumericQ}, Infinity];
ListPlot to 'take a look'
ListPlot[points]
giving the following:
EDIT
Brett Champion has pointed out that InputForm is superfluous.
ListPlot#Cases[
Cases[plot, Line[___], Infinity], {_?NumericQ, _?NumericQ},
Infinity]
will work.
It is also possible to paste in the plot graphic, and this is sometimes useful. If,say, I create a ListPlot of external data and then mislay the data file (so that I only have access to the generated graphic), I may regenerate the data by selecting the graphic cell bracket,copy and paste:
ListPlot#Transpose[{Range[10], 4 Range[10]}]
points = Cases[
Cases[** Paste_Grphic _Here **, Point[___],
Infinity], {_?NumericQ, _?NumericQ}, Infinity]
Edit 2.
I should also have cross-referenced and acknowledged this very nice answer by Yaroslav Bulatov.
Edit 3
Brett Champion has not only pointed out that FullForm is superfluous, but that in cases where a GraphicsComplex is generated, applying Normal will convert the complex into primitives. This can be very useful.
For example:
lp = ListPlot[Transpose[{Range[10], Range[10]}],
Filling -> Bottom]; Cases[
Cases[Normal#lp, Point[___],
Infinity], {_?NumericQ, _?NumericQ}, Infinity]
gives (correctly)
{{1., 1.}, {2., 2.}, {3., 3.}, {4., 4.}, {5., 5.}, {6., 6.}, {7.,
7.}, {8., 8.}, {9., 9.}, {10., 10.}}
Thanks to Brett Champion.
Finally, a neater way of using the general approach given in this answer, which I found here
The OP problem, in terms of a ListPlot, may be obtained as follows:
ListPlot#Cases[g, x_Line :> First#x, Infinity]
Edit 4
Even simpler
ListPlot#Cases[plot, Line[{x__}] -> x, Infinity]
or
ListPlot#Cases[** Paste_Grphic _Here **, Line[{x__}] -> x, Infinity]
or
ListPlot#plot[[1, 1, 3, 2, 1]]
This evaluates to True
plot[[1, 1, 3, 2, 1]] == Cases[plot, Line[{x__}] -> x, Infinity]
One way is to use EvaluationMonitor option with Reap and Sow, for example
In[4]:=
(points = Reap[Plot[Sin[x],{x,0,4Pi},EvaluationMonitor:>Sow[{x,Sin[x]}]]][[2,1]])//Short
Out[4]//Short= {{2.56457*10^-7,2.56457*10^-7},<<699>>,{12.5621,-<<21>>}}
In addition to the methods mentioned in Leonid's answer and my follow-up comment, to track plotting progress of slow functions in real time to see what's happening you could do the following (using the example of this recent question):
(* CPU intensive function *)
LogNormalStableCDF[{alpha_, beta_, gamma_, sigma_, delta_}, x_] :=
Block[{u},
NExpectation[
CDF[StableDistribution[alpha, beta, gamma, sigma], (x - delta)/u],
u \[Distributed] LogNormalDistribution[Log[gamma], sigma]]]
(* real time tracking of plot process *)
res = {};
ListLinePlot[res // Sort, Mesh -> All] // Dynamic
Plot[(AppendTo[res, {x, #}]; #) &#
LogNormalStableCDF[{1.5, 1, 1, 0.5, 1}, x], {x, -4, 6},
PlotRange -> All, PlotPoints -> 10, MaxRecursion -> 4]
etc.
Here is a very efficient way to get all the data points:
{plot, {points}} = Reap # Plot[Last#Sow#{x, Sin[x]}, {x, 0, 4 Pi}]
Based on the answer of Sjoerd C. de Vries, I've now written the following code which automates a plot preview (tested on Mathematica 8):
pairs[x_, y_List]:={x, #}& /# y
pairs[x_, y_]:={x, y}
condtranspose[x:{{_List ..}..}]:=Transpose # x
condtranspose[x_]:=x
Protect[SaveData]
MonitorPlot[f_, range_, options: OptionsPattern[]]:=
Module[{data={}, plot},
Module[{tmp=#},
If[FilterRules[{options},SaveData]!={},
ReleaseHold[Hold[SaveData=condtranspose[data]]/.FilterRules[{options},SaveData]];tmp]]&#
Monitor[Plot[(data=Union[data, {pairs[range[[1]], #]}]; #)& # f, range,
Evaluate[FilterRules[{options}, Options[Plot]]]],
plot=ListLinePlot[condtranspose[data], Mesh->All,
FilterRules[{options}, Options[ListLinePlot]]];
Show[plot, Module[{yrange=Options[plot, PlotRange][[1,2,2]]},
Graphics[Line[{{range[[1]], yrange[[1]]}, {range[[1]], yrange[[2]]}}]]]]]]
SetAttributes[MonitorPlot, HoldAll]
In addition to showing the progress of the plot, it also marks the x position where it currently calculates.
The main problem is that for multiple plots, Mathematica applies the same plot style for all curves in the final plot (interestingly, it doesn't on the temporary plots).
To get the data produced into the variable dest, use the option SaveData:>dest
Just another way, possibly implementation dependent:
ListPlot#Flatten[
Plot[Tan#t, {t, 0, 10}] /. Graphics[{{___, {_, y__}}}, ___] -> {y} /. Line -> List
, 2]
Just look into structure of plot (for different type of plots there would be a little bit different structure) and use something like that:
plt = Plot[Sin[x], {x, 0, 1}];
lstpoint = plt[[1, 1, 3, 2, 1]];
When manipulating matrices it is often convenient to change their shape. For instance, to turn an N x M sized matrix into a vector of length N X M. In MATLAB a reshape function exists:
RESHAPE(X,M,N) returns the M-by-N matrix whose elements are taken columnwise from X. An error results if X does not have M*N elements.
In the case of converting between a matrix and vector I can use the Mathematica function Flatten which takes advantage of Mathematica's nested list representation for matrices. As a quick example, suppose I have a matrix X:
With Flatten[X] I can get the vector {1,2,3,...,16}. But what would be far more useful is something akin to applying Matlab's reshape(X,2,8) which would result in the following Matrix:
This would allow creation of arbitrary matrices as long as the dimensions equal N*M. As far as I can tell, there isn't anything built in which makes me wonder if someone hasn't coded up a Reshape function of their own.
Reshape[mtx_, _, n_] := Partition[Flatten[mtx], n]
ArrayReshape does exactly that.
Reshape[list_, dimensions_] :=
First[Fold[Partition[#1, #2] &, Flatten[list], Reverse[dimensions]]]
Example Usage:
In: Reshape[{1,2,3,4,5,6},{2,3}]
Out: {{1,2,3},{4,5,6}}
This works with arrays of arbitrary depth.
I know this is an old thread but for the sake of the archives and google searches I've got a more general way that allows a length m*n*... list to be turned into an m*n*... array:
Reshape[list_, shape__] := Module[{i = 1},
NestWhile[Partition[#, shape[[i]]] &, list, ++i <= Length[shape] &]
]
Eg:
In:= Reshape[Range[8], {2, 2, 2}]
Out:= {{{1, 2}, {3, 4}}, {{5, 6}, {7, 8}}}
There is now also a new function ArrayReshape[].
Example:
{{1, 2, 3}, {4, 5, 6}} // MatrixForm
ArrayReshape[{{1, 2, 3}, {4, 5, 6}}, {3, 2}] // MatrixForm
I've encountered a problem while trying to use the answer from a NDSolve in two separate plot commands. To illustrate the problem, I'll use a simple differential equation and only one plot command. If I write something like this:
{Plot[x[t], {t, 0, 10}], x[4]}
/. NDSolve[{x'[s] == - x[s], x[0] == 1}, x, {s, 0, 10}]
It solves the equation and calculates x[4] with no problem, but the plot turns empty, and I have no idea why.
In my actual problem, my equation is a quite complicated system for several functions, and instead of x[4] I draw a parametric plot of the solved functions. I ultimately intend to include all this in a Manipulate statement so I don't want the NDSolve statement to appear more than once (takes too long) and I can't just calculate it in advance (since it has a lot of parameters).
Edit: I would like to clarify and expand my question: What I actually want to do is to include my plotting statement in a Manipulate statement in the following way:
Manipulate[{Plot[x[t], {t, 0, 10}], x[4]}
/. NDSolve[{x'[s] == - a*x[s], x[0] == 1}, x, {s, 0, 10}]
,{{a,1},0,5}]
Since only the Manipulate statement gives value to the parameter a, I can't calculate the answer to the NDSolve beforehand. Also, since my actual equation system is very complicated and non-linear, I can't use the symbolic function DSolve.
Sorry if it wasn't clear before.
Your problem is that Plot[] does some funny things to make plotting more convenient, and one of the things it does is just not plot things it can't evaluate numerically. So in the expression you posted,
Plot[x[t], {t, 0, 10}]
just goes ahead and evaluates before doing the rule substitution with the solution from NDSolve, producing a graphics object of an empty plot. That graphics object contains no reference to x, so there's nothing to substitute for.
You want to make sure the substitution is done before the plotting. If you also want to make sure the substitution can be done in multiple places, you want to store the solution into a variable.
sol = NDSolve[{x'[s] == - x[s], x[0] == 1}, x, {s, 0, 10}];
{Plot[Evaluate[x[t] /. sol], {t, 0, 10}], x[4] /. sol}
The Evaluate[] in the Plot makes sure that Mathematica only does the substitution once, instead of once for each plot point. It's not important for a simple rule substitution like this, but it's a good habit to use it in case you ever want to plot something more complicated.
In order to make this work in a Manipulate, the simple way is to use With[], which is one of Mathematica's scoping constructs; it's the one to use where you just want to substitute something in without using it as variable you can mutate.
For example,
Manipulate[
With[{sol = NDSolve[{x'[s] == - x[s], x[0] == 1}, x, {s, 0, 10}]},
{Plot[x[t] /. sol // Evaluate, {t, 0, 10}, PlotRange -> {0, 1}],
x[4] /. sol}],
{{a, 1}, {0, 5}}]
Use the PlotRange option to keep the y-axis fixed; otherwise things will jump around in an ugly way as the value of a changes. When you do more complex things with Manipulate, there are a number of options for controlling the speed of updates, which can be important if your ODE is complicated enough that it takes a while to solve.
Meanwhile, I found another way to do this. It's less elegant, but it only uses one substitution so I've thought I'll post it here also.
The idea is to use Hold on the Plot so it wouldn't get evaluated, do the rule substitution and then ReleaseHold, just before the Manipulate.
Manipulate[ReleaseHold[
Hold[ {Plot[x[t], {t, 0, 10}, PlotRange -> {0, 1}], x[4]} ]
/.NDSolve[{x'[s] == -a x[s], x[0] == 1}, x, {s, 0, 10}]
], {{a, 1}, 0, 5}]