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)}]]
Related
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?
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 am trying to parametrize a 3D geometry for shape optimization. The structure looks like the following. Another real example is here.
Currently I am using BSplines to create the lower part and using symmetry to create the whole down part of the foil. Here is what I get.
Now I have many control points to take care in order to run a shape optimization. I also don't know how to join the upper part with the bottom hydrofoil part in a sensible way. I don't know how to design a good middle part of the foil (fat nose part of the foil) where the upper part is linked to. I also need to accompany a flap with in the geometry.
Please offer some suggestion for parametrization of such a surface so that we can manipulate the geometry from MMA. The less control points are there better the situation is for optimization. May be combination of some analytic function in 3D. But I doubt if that is possible.
BR
I think you have two choices: 1) create the second part of the geometry and then write a face-face intersection algorithm to merge them. 2) create the second part of the geometry and write two functions that return -1 if a query point is inside the geometry and +1 if it is out side (other values will do). Then use RegionPlot3D[ f1[x,y,z]<0 || f2[x,y,z]<0,....]. The idea is the to extract the GraphicsComplex and use that. The question is going to be how well you can approximate the corners with that. Here is an illustration of what I mean.
if1[x_, y_, z_] := If[x^2 + y^2 + z^2 <= 1, -1, 1]
if2[x_, y_, z_] := If[(x - 1)^2 + y^2 <= 1 && -1.5 <= z <= 1.5, -1, 1]
res = RegionPlot3D[
if1[x, y, z] < 0 || if2[x, y, z] < 0, {x, -2, 2}, {y, -2,
2}, {z, -2, 2}, PlotPoints -> 100, Boxed -> False, Axes -> False]
Then extract the coords and the polygons.
coords = res[[1, 1]];
poly = Cases[res[[1]], _Polygon, Infinity];
Graphics3D[GraphicsComplex[coords, poly], Boxed -> False]
Hope this helps.
For an experiment, we generated in Matlab some images made out of 8 Disks. We constrained, the minimum distance between the disks and between the disks and the frame as well as the location of the Disks Center Of Gravity (COG). Bellow an example of a composition with the COG on the upper lift "third"
FraXYs = {{4.32, 3.23}, {35.68, 26.75}}
stiDisks = {{{8, 11}, 1}, {{10, 17}, 1}, {{16, 24}, 1}, {{25, 22},1},
{{31, 22}, 1}, {{7, 21}, 2}, {{16, 12}, 2}, {{19, 22}, 2}}
Graphics[{White, EdgeForm[Thick],
Rectangle ## FraXYs,
Red, Disk[{14.77, 18.91}, 1],
Blue, Opacity[.6], EdgeForm[Black],
Blue, Thickness[0.003],
Opacity[1],
Black,
Disk[#[[1]], #[[2]]] & /# stiDisks}, ImageSize -> {400, 300}]
I would like to generate those stimuli in Mathematica. Below are the element (features and constraints) I am dealing with. The measures are in Cm. The Center Of Gravity (COG) of the shapes is defined as the area weihtgted location of the disks.
The Features :
Stimuli Frame : {{xMin,xMin},{xMax,yMax}}
FraXYs = {{4.32, 3.23}, {35.68, 26.75}}
5 Small Disks : with radius
rSmall=1
3 Large Disks : with radius
rLarge=2
The Constraints :
Minimum distance between the shapes edges :
minDistSha=1
Minimum distance between the shapes edges and the frame border :
minDistFra=1
Distance of shapes COG from the center :
minDistCogCenter=2
Potentially, I will need to constraint the COG of the disks to be on a certain angle from the center (theta coordinate in a polar system?). So I could select the disks coordinates constraining their COGs to be located every 22.5 degree in a polar coordinate
angleBin=22.5
Is there useful Functions in Mathematica to achieve the selection under constraints aside of Selct.
I would be curious to know if a closed formula to generate 1 composition with a particular COG location is possible.
Indicatively, I will need to get a pool of 1000 compositions. Using the "theta constraints"of 36 degrees, I should extract 10*100 composition with their COG located on the 10 different theta bars at a minimum or fixed distance from the center.
Please tell me if clarifications are needed. Thank You for your attention.
This might get you started. It is a simple rejection method to generate circles at random, throwing away ensembles that do not meet requirements.
Arguments are the box size, numbers and radii of small and large circles, and a minimum separation. That last is used both for distances to boundary and distances between circles. I double it for the center of gravity to center of frame constraint. Clearly this usage could be generalized by adding more arguments.
For purposes of assessing how likely this is to find viable ensembles, I print the number of times through the loop. Also I use a Catch/Throw mechanism that is not really necessary (artifact of some experimentation that I did not bother to remove).
--- edit ---
The code below has modest changes from what I originally posted. It separates the center of gravity circle as the red one.
To handle the constraint that it lie at some specified angle, one might generate as below, rotate to put into the correct angular position, and recheck distances from circles to frame boundary. Possibly there is something smarter that will be less likely to give a rejection, while still maintaining uniformity. Actually I'm not at all certain that what I coded gives a uniform distribution from the space of allowable configurations. If it does, the influence of rotating will very likely destroy that property.
--- end edit ---
randomConfiguration[{xlo_, ylo_}, {xhi_, yhi_}, nsmall_, nlarge_,
rsmall_, rlarge_, minsep_] := Catch[Module[
{found = False, xsmall, ysmall, xlarge, ylarge, smallsep, largesep,
smallcircs, largecircs, cog, cen, indx = 0},
smallsep = {rsmall + minsep, -rsmall - minsep};
largesep = {rlarge + minsep, -rlarge - minsep};
cen = {xhi - xlo, yhi - ylo};
While[! found,
found = True;
indx++;
xsmall = RandomReal[{xlo, xhi} + smallsep, nsmall];
ysmall = RandomReal[{ylo, yhi} + smallsep, nsmall];
xlarge = RandomReal[{xlo, xhi} + largesep, nlarge];
ylarge = RandomReal[{ylo, yhi} + largesep, nlarge];
smallcircs = Transpose[{xsmall, ysmall}];
Do[If[
Norm[smallcircs[[i]] - smallcircs[[j]]] <= 2*rsmall + minsep,
found = False; Break[]], {i, nsmall - 1}, {j, i + 1, nsmall}];
largecircs = Transpose[{xlarge, ylarge}];
Do[If[
Norm[largecircs[[i]] - largecircs[[j]]] <= 2*rlarge + minsep,
found = False; Break[]], {i, nlarge - 1}, {j, i + 1, nlarge}];
Do[If[
Norm[smallcircs[[i]] - largecircs[[j]]] <=
rsmall + rlarge + minsep, found = False; Break[]], {i,
nsmall}, {j, nlarge}];
cog = (rsmall^2*Total[smallcircs] +
rlarge^2*Total[largecircs])/(nsmall*rsmall^2 +
nlarge*rlarge^2);
If[Norm[cog - cen] <= 2*minsep, found = False;];
];
Print[indx];
Throw[{{cog, rsmall},Map[{#, rsmall} &, smallcircs],
Map[{#, rlarge} &, largecircs]}]
]]
Example:
{smallc, largec} =
randomConfiguration[{4.32, 3.23}, {35.68, 26.75}, 5, 3, 1, 2, 1];
13
FraXYs = {{4.32, 3.23}, {35.68, 26.75}};
{cog, smallc, largec} =
randomConfiguration[{4.32, 3.23}, {35.68, 26.75}, 5, 3, 1, 2, 1];
Graphics[{White, EdgeForm[Thick], Rectangle ## FraXYs, Red,
Apply[Disk, cog], Blue, Opacity[.6], EdgeForm[Black], Blue,
Thickness[0.003], Opacity[1], Black,
Disk[#[[1]], #[[2]]] & /# Join[smallc, largec]},
ImageSize -> {400, 300}]
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]