I am using RegionPlot to display a system of linear inequalities in two variables to help me find parameter values for which they can all be satisfied, or if there don't exist any, to get a feel for them to understand why. But when I graph them, RegionPlot very literally cuts corners. How can I get a more accurate graph of regions bounded by linear inequalities?
Here is a minimal example (actual code much hairier):
RegionPlot[{y > 0 && x > 0 && x - y > 0,
y < .1 && x < .1 && x - y < .1}, {x, -10, 10}, {y, -10, 10}]
Output plot here.
In this example, Mathematica cuts off the bottom-left quarter of the first-quadrant region, which makes it appear as if the two regions don't intersect. But they do.
Things I've considered but rejected:
Using FindInstance to find the intersection of the regions. So far, FindInstance has failed to find any intersection, but I'm not sure if that is due to specific choices of parameter values. More importantly, if there is no intersection, I want to get a sense of which conditions are likely to be contradictory by playing with the parameters (via Manipulate).
Changing the scale of the graph. In my actual code, there are several such intersecting regions, and I'd like to see them all on one plot. So I'd really like to improve corner rendering given a plot scale.
The problem is that RegionPlot samples some initial points and then refine the areas with changes to improve the plot without affecting the performance by sampling unchanged areas. In this case, it is missing the central detail, I think.
Try increasing the MaxRecursion option or the initial number of points with PlotPoints, for example, these two examples will give good results but the performance will suffer. Which one is better will depend on the real case, I think.
RegionPlot[{y > 0 && x > 0 && x - y > 0,
y < .1 && x < .1 && x - y < .1}, {x, -10, 10}, {y, -10, 10},
PlotPoints -> 100]
RegionPlot[{y > 0 && x > 0 && x - y > 0,
y < .1 && x < .1 && x - y < .1}, {x, -10, 10}, {y, -10, 10},
MaxRecursion-> 6]
Related
I'm trying to solve a problem: I have to find the trajectory of an electron in a graphene lattice using Mathematica. I've tried to solve the Coulomb Force equation with NDSolve and to plot the result for each direction, but i obtain a white plot. Could someone help me please? Thank you in advance. Here's the code for the x direction:
coordx = {0.6327, 1.88058, 3.03927, 4.28716, 5.44584, 6.69373,
7.85241, 9.10029, 1.9728, 3.22069, 4.37937, 5.62726, 6.78594,
8.03382, 9.19251, 10.4404, 3.3129, 4.56079, 5.71947, 6.96736,
8.12604, 9.37393, 10.53261, 11.7805, 4.653, 5.90089, 7.05956,
8.30746, 9.46614, 10.71403, 11.87271, 13.1206};
me = 9.01*10^-31;
pi = 3.14159;
epsilon0 = 8.854*10^-12;
q = -1.6*10^-19;
Q = 1.6*10^-19;
step = 0.01;
Forzax[p_, r_] :=
Sum[(Q*q)/(4 pi*epsilon0*Norm[r - p[[i]]]^2), {i, Length[p]}]
Forzax[coordx, {x[t]}];
NDSolve[{x''[t] == Forzax[coordx, {x[t]}]/me , x[0] == 0,
x'[0] == 0}, {x[t]}, {t, 0, 1500}]
Show[ParametricPlot[Evaluate[{x[t]} /. %], {t, 0, 1500},
PlotRange -> All]]
I don't know what you're trying to plot, but these few modifications seem to plot your function.
sol = NDSolve[{x''[t] == Forzax[coordx, {x[t]}]/me,
x[0] == 0, x'[0] == 0}, {x}, {t, 0, 1500}];
f = sol[[1, 1, 2]];
Plot[f[t], {t, 0, 1500}, PlotRange -> All]
From what I can tell, your code is running fine but the plot is empty because you're calling ParametricPlot with just one function. From the documentation, this is how you call ParametricPlot:
ParametricPlot[{fx[t], fy[t]}, {t, tmin, tmax}]
Since you're still solving the 1D problem and only have x[t], ParametricPlot cannot draw anything; it's missing the y coordinate of the trajectory. Once you do a 2D calculation, ParamatricPlot should be able to give you to figure you want. If you want to do a 3D calculation, you should use ParamatricPlot3D.
A question though: how do you intend to to a 3D calculation of an electron in graphene? The motion of the electron in the 3rd dimension will not follow Newtonian mechanics at all because it is confined so much in that direction. In fact, I'd be kind of cautious about using Newton's 2nd law in graphene no matter what, since electrons in graphene behave like massless particles. I leave the interpretation of the results up to you, but the physicist in me cannot resist adding this word of caution.
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]