I have a dataset
d = {{0., 0.}, {0.5, 6.31267}, {0.75, 7.95463},
{1., 8.91956}, {1.5, 9.49294}, {2., 9.01877},
{3., 6.95413}, {5., 3.20838}, {7., 1.31298}}
where the first values of each observation correspond to a value of time-t and the second to concentration-c.
With FindFit, I've been able to obtain the an approximation to a gaussian curve. Nevertheless, I wanted to obtain an approximation with the mean value depending on t, with preference to a solution like mu(t)=ae^(-b1t)- ae^(-b2t).
Which comand should i use in order to do that?
Related
I have an arbitrary function of f(x) with each discrete x value. The value of the function is circularly symmetrical. I want to plot those circles in mathematica using x as radius and values of f(x) as the height of this plot. Can you help me with that please? Also I don't know how to use lists of numbers as an input to plot discrete circles in 3D.
I tried
Plot3D[f*Exp[I*phi], {x, 0, 10}, {phi, 0, 2*Pi}]
or
ContourPlot[f*Exp[I*phi], {x, 0, 10}, {phi, 0, 2*Pi}]
Nothing shows up!
Try this
f[x_]:=x^2;
Show[
Map[(x=#;ParametricPlot3D[{x*Cos[phi],x*Sin[phi],f[x]},{phi,0,2Pi}])&,Range[1,10]],
PlotRange->All
]
where I arbitrarily picked an f[x] and used a list of {1,2,3,...10} for discrete x values. You could replace that Range[1,10] with something like {5,7,3/2,1.8} if you had a specific list of numbers that you wanted to use for x.
The Map function created a ParametricPlot3D for each of the discrete values of x and then the Show combined all those into a single plot.
Context: Two sets of data, one is the radius, r, and the other is the velocity, v. v can be positive and negative. The following code
p1=ListLogLogPlot[Table[{r[[i]],v[[i]]},{i,1,number_of_data}]];
p2=ListLogLogPlot[Table[{r[[i]],-v[[i]]},{i,1,number_of_data}],PlotStyle->{Red}];
Show[p1,p2]
is used to give a curve, with positive and negative v both plotted in log-log coordinates.
Question: How to draw a circular, contour-like plot, with Log[r] as the distance to the center of the circle, and the velocities (Log[v]) shown as different, but continuously varying colors, according to v's sign and magnitude?
You may use a DensityPlot function:
v[r_] := Sin[r]*r^2
DensityPlot[v[Norm[{x, y}]], {x, -5, 5}, {y, -5, 5}]
You can deal with the tabular data in two ways. You can either interpolate and use the interpolating function as above or you may use a ListDensityPlot function:
ListDensityPlot[Table[With[{r = RandomReal[{0, 4}], t = RandomReal[{0, 2 Pi}]},
{r Cos[t], r Sin[t], v[r]}], {10^4}]]
I hope this helps.
I would like to compute the Covariance Matrix of the image below. Pixel based. That is considering each Black Pixel of the Disks as vectors.
While the units below are in centimeter, there are 32 pixels per cm on the screen I am using.
Ahead of the Covariance Matrix computation itself, I can`t figure out the way to obtain all the pixels vector.
frmXY = {{6.59, 1.59}, {33.41, 28.41}};
stim = {{10.85, 21.91, 0.97}, {16.8, 5.26, 0.97}, {11.78, 7.11, 0.97},
{12.64, 14.13, 0.97`}, {20.24, 16.16, 0.97}, {29.51, 8.06,1.53},
{22.42, 5.78, 1.53}, {27.13, 16.47, 1.53}}
Graphics[{EdgeForm[Thick],White, Rectangle ## frmXY, Black,
Disk ### (stim /. {a_, b_, c_} :> {{a, b}, c})}, ImageSize -> 300]
It is not clear from your question as to what constitutes the random variable that describes your model/system and I don't understand what it is that you're trying to take the covariance matrix of.
However, here's a simple example showing how to obtain the covariance matrix and compute the eigenvalues and eigenvectors (basically, reproduce your first plot).
list = RandomReal[
MultinormalDistribution[{0, 0}, {{6, 3}, {3, 3}}], {5000}];
sampleCov = Covariance#list;
{eigValues, eigVectors} = Eigensystem#sampleCov;
Show[ListPlot#list,
Graphics[{Red, Arrowheads[0.03],
Arrow[{{0, 0}, #}] & /# (eigValues eigVectors)}]]
I have a problem which I try to solve with mathematica.
I am having a list with x and y coordinates from a position measurement (and also with z values of the quantity which was measured at each point). So, my list starts with
list={{-762.369,109.998,0.915951},{-772.412,109.993,0.923894},{-777.39, 109.998, 0.918108},...} (x,y,z).
Out of some reasons, I have to fill all these x,y, and z-values into a matrix. That would be easy if I have for each y-coordinate the same amount of x-coordinates (lets say 80), then I could use Partition[list,80] which produces a matrix with 80 columns (and some rows whose number is given by the number of y-coordinates with the same value).
Unfortunately, it is not so easy, the number of x-coordinates for each y is not strictly constant, as can be seen from the attached ListPlot.
Can anybody give me some suggestions, how I could fill each point of this plot / each x-y-(and z-) coordinate of my list into a matrix?
To explain better what I want to have, I indicated in the attached picture a matrix. There one can see that almost every point of my plot would fall into a cell of a matrix, only some cells would stay empty.
I used in the plot the color red for the points whose x coordinates are ascending in my list and blue for the points whose x coordinate are descending in my list (the positions are measured along a meander line). Perhaps this kind of order can be useful to solve to problem...
Here a link to my coordinates, perhaps this helps.
Well, I hope I explained my question well enough. I would appreciate every help much!
The basic idea behind this solution is:
all points seem to lie on a lattice, but it's not precisely a square lattice (it's slanted)
so let's find the basis vectors of the lattice, then all (most?) points will be approximate integer linear combinations of the basis vectors
the integer "coordinates" of the points along the basis vectors will be the matrix indices for the OP's matrix
(The OP emailed me the datafile. It consists of {x,y} point coordinates.)
Read in the data:
data = Import["xy.txt", "Table"];
Find the nearest 4 points to each point, and notice that they lie about distance 5 away both horizontally and vertically:
nf = Nearest[data];
In:= # - data[[100]] & /# nf[data[[100]], 5]
Out= {{0., 0.}, {-4.995, 0.}, {5.003, 0.001}, {-0.021, 5.003}, {0.204, -4.999}}
ListPlot[nf[data[[100]], 5], PlotStyle -> Red,
PlotMarkers -> Automatic, AspectRatio -> Automatic]
Generate the difference vectors between close points and keep only those that are about length 5:
vv = Select[
Join ## Table[(# - data[[k]] & /# nf[data[[k]], 5]), {k, 1, Length[data]}],
4.9 < Norm[#] < 5.1 &
];
Average the vectors out by directions they can point to, and keep two "good" ones (pointing "up" or to the "right").
In:= Mean /# GatherBy[vv, Round[ArcTan ## #, 0.25] &]
Out= {{0.0701994, -4.99814}, {-5.00094, 0.000923234}, {5.00061, -4.51807*10^-6},
{-4.99907, -0.004153}, {-0.0667469, 4.9983}, {-0.29147, 4.98216}}
In:= {u1, u2} = %[[{3, 5}]]
Out= {{5.00061, -4.51807*10^-6}, {-0.0667469, 4.9983}}
Use one random point as the point of origin, so the coordinates along the basis vectors u1 and u2 will be integers:
translatedData = data[[100]] - # & /# data;
Let's find the integer coordinates and see how good they are (how far they are from actual integers):
In:= integerIndices = LinearSolve[Transpose[{u1, u2}], #] & /# translatedData ;
In:= Max[Abs[integerIndices - Round[integerIndices]]]
Out= 0.104237
In:= ListPlot[{integerIndices, Round[integerIndices]}, PlotStyle -> {Black, Red}]
All points lie close to the integer approximations.
Offset the integer coordinates so they're all positive and can be used as matrix indices, then gather the elements into a matrix. I put the coordinates in a point object in order not to confuse SparseArray:
offset = Min /# Transpose[Round[integerIndices]]
offset = {1, 1} - offset
result =
SparseArray[
Thread[(# + offset & /# Round[integerIndices]) -> point ### data]]
result = Normal[result] /. {point -> List, 0 -> Null}
And we finally have a matrix result where each element is a coordinate-pair! (I was sloppy doing 0 -> Null here to mark missing elements: it's important that data contained no exact 0s.)
MatrixForm[result[[1 ;; 10, 1 ;; 5]]]
EDIT
Just for fun, let's look at the deviations of points from the precise integer lattice sites:
lattice = #1 u1 + #2 u2 & ### Round[integerIndices];
delta = translatedData - lattice;
delta = # - Mean[delta] & /# delta;
ListVectorPlot[Transpose[{lattice, delta}, {2, 1, 3}], VectorPoints -> 30]
I am doing this:
ClearAll[matrix];
matrix[p_,q_,nu_:0]:=Module[{sigma},
sigma=p/q;
N#SparseArray[
{{m_,m_}\[Rule]2Cos[2\[Pi]*m*p/q+nu],{i_,j_}/;
Abs[i-j]\[Equal]1\[Rule]1},{q,q}]]
ClearAll[attachsigma]
attachsigma[sigma_,lst_]:={sigma,#}&/#lst
and then execute
fracs = Table[p/q, {q, 2, 30}, {p, 2, q}] // Flatten // DeleteDuplicates;
pq = {Numerator##, Denominator##} & /# fracs;
(ens = Eigenvalues[#] & /#
Normal /# (matrix[#[[1]], #[[2]]] & /# pq);) // Timing
pts = Flatten[#, 1] &#MapThread[attachsigma, {fracs, ens}];
and finally I plot the points as follows (here is the real point of the question):
plot = ListPlot[pts,
PlotMarkers \[Rule] Graphics[{PointSize[Tiny], Point[{0, 0}]}]]
Calculating all the points takes around around 2.6s on my machine, but the plot takes around 25s. If, on the other hand, I plot it like this
ListPlot[pts]
then it is almost instantaneous, as it should (it's just 5256 points). So, it seems PlotMarkers slows things down immensely.
Could anybody
a) explain why (this much I vaguely understand, in analogy with what happens to Sort if you give it custom ordering function) and, more importantly,
b) explain how to avoid this slowdown? I am trying to create plots with quite a bit more points than this so they're really slow; in addition, I am creating lots of them (a movie actually).
One solution would be to not plot all of them, but as I vary parameters it becomes nontrivial to find out which I should include and which not (this would of course work if I only needed this one frame). So, I'd like to speed up the plot creation without removing points.
EDIT: Answered after hints from Sjoerd:
ListPlot[pts] /. Point[List[x___]] \[RuleDelayed] {PointSize[Tiny], Point[List[x]]}
produces the right thing instantaneously. This simply replaces the Points inside the Graphics structure by smaller points by hand.
Now one can increase the upper limit in the table in fracs = Table[p/q, {q, 2, 30}, {p, 2, q}] // Flatten // DeleteDuplicates to 80 or so to get many more points (this thing is the Hofstadter butterfly, and it's a fractal):
PlotMarkers is meant for data plots that contain relatively few points. It is very useful in plots in which you use the markers to identify various conditions. Each individual marker is an Inset as follows:
Inset[Graphics[List[Hue[0.67`,0.6,0.6`],PointSize[Tiny],Point[List[0, 0]]]],10512].
You can imagine this takes up some time and memory.
I also found what seems to be a bug. The plot with PlotMarkers is structured as GraphicsComplex[pointlist,graphicsinstructions]. This point list seems to contain the points in the plot twice!
In[69]:= pts // Length
Out[69]= 5256
In[66]:= plot[[1, 1]] // Length
Out[66]= 10512
In[64]:= Union[plot[[1, 1]]] == Union[pts]
Out[64]= True
In[68]:= Tally[plot[[1, 1]]][[All, 2]] // Mean (*the average number each point occurs*)
Out[68]= 2
Personally, I prefer Graphics to ListPlot, especially when the number of points is large.
Graphics[{Hue[{2/3, 1, 1, .5}], AbsolutePointSize[1.5], Point#pts},
PlotRange -> {{0, 1}, {-4, 4}}, Axes -> False,
AspectRatio -> 1/GoldenRatio]
gives, for example:
Length#pts
102969
I believe the solution you appended to your question can be simplified:
ListPlot[pts] /. x_Point :> {PointSize[Tiny], x}
I voted for both prior answers, but I agree with TomD on the direct use of Graphics.