Analyzing Eye-movements on a screen, I set my origin to the bottom left corner of it
(Hard to modify at that point).
Trying to compute distance between some points and the center of the screen I use the simple formula displayed below.
Problem is that using this in conditional statement, it gets ugly.
Sqrt[
(
(fixationX - centerX)^2 + (fixationY - centerY)^2
)
]
Is there a way to customize Norm to compute distance between points and not between a point and the origin ?
Or in my case, set the origin to be at the "center" of the current coordinate system ?
A slight variation of Simon's method is to use a default value in the function, rather than a global variable ($Center).
Suppose your default origin is (5, 5), then:
myNorm[pos:{_, _}, center_:{5, 5}] := EuclideanDistance[pos, center]
Notice the use of _:{5, 5} to define the default value.
Now you can do:
myNorm[{5, 7}]
(* Out[]= 2 *)
Or temporarily use a different the center with:
myNorm[{5, 7}, {8, 8}]
(* Out[]= Sqrt[10] *)
For this simple function, you could use EuclideanDistance in the second case instead, but I hope you can see the utility of this method were the definition of myNorm more complex.
The downside to this method is that you cannot easily change the default center.
Another variation that does allow one to easily change the default center, but is more verbose, is to use Options:
Options[myNorm2] = {Center -> {5, 5}};
myNorm2[pos : {_, _}, OptionsPattern[]] :=
EuclideanDistance[pos, OptionValue[Center]]
Syntax is:
myNorm2[{5, 7}]
myNorm2[{5, 7}, Center -> {8, 8}]
2
Sqrt[10]
Changing the default center:
SetOptions[myNorm2, Center -> {8, 8}];
myNorm2[{5, 7}]
Sqrt[10]
Can you just use EuclideanDistance
In[1]:= EuclideanDistance[{x,y}, {cx,cy}]
Out[1]= Sqrt[Abs[-cx +x ]^2 + Abs[-cy + y]^2]
Or define a $Center and a new CNorm, e.g.
$Center = {cx, cy};
CNorm[pos:{x_, y_}] := EuclideanDistance[pos, $Center]
Related
I have drawn a figure with Mathematica, and want to read data from the figure. For example, there exists a Square Wave with the following code, and I want the value of the third turning point:
R[t_] := 10 UnitStep[-Sin[0.4 Pi t]];
Plot[R[t], {t, 0, 20}, Exclusions -> None, PlotStyle -> Thick]
yui = Flatten[Table[{t, (R[t] /. sol)}, {t, 5, 10, 1.2}]]
Partition[yui, 2] // TableForm
I make efford to read the value of the function wave. Due to the continuity of the curve, the value I read in this way may not be the right one.
Then, I use the command "Solve" with the following code:
Solve[R[t] = 5, {t, 5, 10, 1.2}]
But it does not work!
I really want to obtain the coordination, but with the wanted y value to get the exact x value.
Hence I need your help!
How can I label each of these lines separately :
Plot[{{5 + 2 x}, {6 + x}}, {x, 0, 10}]
There's some nice code that allows you to do this dynamically in an answer to How to annotate multiple datasets in ListPlots.
There's also a LabelPlot command defined in the Technical Note Labeling Curves in Plots
Of course, if you don't have too many images to make,
then it's not hard to manually add the labels in using Epilog, for example
fns[x_] := {5 + 2 x, 6 + x};
len := Length[fns[x]];
Plot[Evaluate[fns[x]], {x, 0, 10},
Epilog -> Table[Inset[
Framed[DisplayForm[fns[x][[i]]], RoundingRadius -> 5],
{5, fns[5][[i]]}, Background -> White], {i, len}]]
In fact, you can do something similar with Locators that allows you to move the labels wherever you want:
DynamicModule[{pos = Table[{1, fns[1][[i]]}, {i, len}]},
LocatorPane[Dynamic[pos], Plot[Evaluate[fns[x]], {x, 0, 10}],
Appearance -> Table[Framed[Text#TraditionalForm[fns[x][[i]]],
RoundingRadius -> 5, Background -> White], {i, len}]]]
In the above I made the locators take the form of the labels, although it is also possible to keep an Epilog like that above and have invisible locators that control the positions.
The locators could also be constrained (using the 2nd argument of Dynamic) to the appropriate curves... but that's not really necessary.
As an example of the above code with the functions with the labels moved by hand:
fns[x_] := {Log[x], Exp[x], Sin[x], Cos[x]};
Mathematica 9 now provides easy ways to include legends.
Plot[{{5 + 2 x}, {6 + x}}, {x, 0, 10}, PlotLegends -> "Expressions"]
You can insert legends in your plot by loading the PlotLegends package
<<PlotLegends`;
Plot[{5+2 x,6+x},{x,0,10},
PlotLegend->{"5+2x","6+x"},LegendShadow->None,
LegendPosition->{0.3,-0.5},LegendSpacing->-0,LegendSize->0.5]
However, let me also note my dislike of this package, primarily because it's extremely counterintuitive, laden with too many options and does not provide a clean experience right out of the box like most of Mathematica's functions. You will have some fiddling around to do with the options to get what you want. However, in plots and charts where you do want a legend, this can be handy. Also see the comments to this answer and this question.
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]];
I am trying to plot multiple lists in the same plot in Mathematica (ListLinePlot) and use PlotMarkers and the PlotLegend Package to get the final figure. The issue is that Mathematica puts a marker for every point and this makes it hard to tell which marker is where in the plot. Is it possible to have a plot marker appear every n sample (e.g. every 10 points for a 100 point plot).
The Directive at the moment is PlotMarkers->{Automatic, Small}.
I think adding something like Mesh->10 should work for you:
data = Accumulate /# RandomReal[{-1/2, 1}, {3, 100}];
ListLinePlot[data, PlotMarkers -> {Automatic, Small}, Mesh -> 10]
If you want more control over the location of the plot markers than Brett's answer gives you, then you probably have to place the markers manually. Eg (modifying Brett's example)
data = Accumulate /# RandomReal[{-1/2, 1}, {3, 100}];
col = {Red, Blue, Green};
decimate[i_] := {col[[i]], PointSize -> Medium,
Point /# Transpose[{Range[1, 100, 10], data[[i, 1 ;; -1 ;; 10]]}]}
ListLinePlot[data, PlotStyle -> col, Epilog -> Table[decimate[i], {i, 3}]]
Of course Point can be replaced with any graphics object you want - eg Text, Inset etc...
Also remember you can use Tooltip to cause the marker coordinates to pop up when you pass the mouse pointer over it:
The example of what I was describing in the comment. The markers don't behave properly.
Apparently I cannot post images yet, but running the following code
data = Accumulate /# RandomReal[{-1/2, 1}, {3, 100}];
ListLinePlot[data, PlotMarkers -> {Automatic, Small}, Mesh -> 5]
should give improper results. Also the number of data and plots in the same figure is quite large to individually select which points and I would like to keep the same Directives for different plots and data ranges as they tend to vary between 100 to around 300 in each case and I have to save them in different tables as they are used in other calculations along the way.
Plot Posted by belisarius, running the code above