This question might seem a little strange but for my purposes is not that crazy.
Its easy but I need you to follow me.
The aim
My aim is plotting a tridimensional graph.
The problem
The problem is the material I have in my hands to start building this graph. Actually I have a collection of points in the 2D space (thus tuples of two real ordered values). Consider a moment to have these collection of points stored into an array and now consider to plot them on a 2D diagram. You will just have a nice sparse view of these points.
Well, the second step is this: consider the surface with these points and create a third axis orthogonal to the plane where those points are drawn. The aim is assigning to every point a numerical scalar value (using a function that accepts the couple and returns a numerical value). So the graph should show bars starting from every point and having a specific value according to the assignment function.
How can I achieve this in Mathematica?
A little note
Basically my points in the 2d space are also connected by a graph. Is it possible to connect the top of the bars to the top of other bars whose base point are connected together in the 2d graph?
Some other notes
My graph doesn`t have to be a surface but just a collection of bars placed on a plane in the exact place where the correspondent point they refer to is located. But if you have a good hint how to draw a surface other than bars, it will be gladly accepted.
I hope I was clear. I would like to point that I have Mathematica 8 so all functionalities are available. Thank you.
This can be done using Graphics3D primitives. Lets start with some data
(* a list of 2D coordinates *)
points2D = RandomReal[{0, Pi}, {50, 2}];
(* some edges as a list of pairs of vertex indices *)
edges = Union[Flatten[MapIndexed[Sort /# Thread[{#2[[1]],
Nearest[points2D -> Automatic, #, 4]}] &, points2D], 1]];
(* constructing list of 3D coordinates *)
f[{x_, y_}] := 2 + Sin[x y]
points3D = {##, f[{##}]} & ### points2D;
The actual plot can then be constructed as follows (width is half the width of the bars)
With[{width = .02},
Graphics3D[{{LightBlue, EdgeForm[None],
Cuboid[{#1, #2, 0} - width {1, 1, 0}, {##} + width {1, 1, 0}] & ### points3D},
{Orange,
GraphicsComplex[points3D, Line[edges]]}},
Lighting -> "Neutral",
BoxRatios -> {1, 1, .6}]]
Here is a tricky problem (or at least so I think). I need to create a histogram, but instead of having the data and it's frequency, I have repeated data (i.e. not binned) and some weight for each data.
One example:
Angle | Weight
90 .... 3/10
93 .... 2/10
180 .... 2/10
180 .... 1/10
95 .... 2/10
I want to create a histogram with bin size 10. The y-values should be the sum of weighted frequencies for angles within a range. How can I do it? Preferably Mathematica or pseudocode...
In Mathematica 9, you can do it using the WeightedData function like this:
Histogram[WeightedData[{90, 93, 180, 180, 95}, {3/10, 2/10, 2/10, 1/10, 2/10}], {10}]
You should then get a graphic like this one:
Since the expected output is not forthcoming I shall adopt Verbeia's interpretation. You might use something like this:
dat = {{90, 3/10}, {93, 1/5}, {180, 1/5}, {180, 1/10}, {95, 1/5}};
bars =
Reap[
Sow[#2, Floor[#, 10]] & ### dat,
_,
{#, Tr##2} &
][[2]]
Graphics[
Rectangle[{#, 0}, {# + 10, #2}] & ### bars,
AspectRatio -> 1/GoldenRatio,
Axes -> True,
AxesOrigin -> {Min#bars[[All, 1]], 0}
]
I did something similar for a different kind of question recently (weighting by balance sheet size).
Assuming your data is in an N * 2 matrix list, I would do something like:
{numbers,weights} = {data[[All,1]], data[[All,2]]*10};
weightednumbers = Flatten# MapThread[
Table[#1, {#2}] &, {numbers, Ceiling[weights]}];
And then use Histogram to draw the histogram on this transformed data.
There might be other ways but this works.
An important point is to make sure the weights are integers, so the Table as the correct iterator. This might require defining weights as data[[All,2]]*Min[data[[All,2]].
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.
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 trying to use computer to show some planar geometry plots. I donot know what software can do this, or whether mathematica can produce such plots easily.
For example, I have the following plot to show.
Given any triangle ABC, let AD be the line bisecting angle BAC and intersecting BC at D. Let M be the midpoint of AD. Let the circle whose diameter is AB intersects CM at F.
How to produce these plots and show the relevant labeling of the points in mma? Is it easy to do? Could someone please give an example, or give some recommendation as to what software is best suited for this purposes?
Many thanks.
Here you have your graph done with Geometry Expressions in two minutes. It has many nice features, including elemental geometry calculations and an interface for exporting formulas to Mathematica.
The formula in the drawing was calculated by the program.
Free to use, $79 - $99 to be able to save.
Here's a very quick solution using GeoGebra to the problem you described.
It is the first time I've used GeoGebra and this took me about 20mins to make - so the program is quite well made and intuitive.
What's more, it can export to dynamic, java based, webpages. Here's the one for the problem you specified: TriangleCircle.
Edit
For Mathematica demonstrations, there are lots of good examples at Plane Geometry.
From this page, I found other software such as Cabri Geometry and The Geometer's Sketchpad.
I thought I'd show how one might approach this in Mathematica. While not the simplest thing to code, it does have flexibility. Also bear in mind that the author is fairly inept when it comes to graphics, so there might be easier and/or better ways to go about it.
offset[pt_, center_, eps_] := center + (1 + eps)*(pt - center);
pointfunc[{pt_List, center_List, ptname_String}, siz_,
eps_] := {PointSize[siz], Point[pt],
Inset[ptname, offset[pt, center, eps]]};
Manipulate[Module[
{plot1, plot2, plot3, siz = .02, ab = bb - aa, bc = cc - bb,
ac = cc - aa, cen = (aa + bb)/2., x, y, soln, dd, mm, ff, lens,
pts, eps = .15},
plot1 = ListLinePlot[{aa, bb, cc, aa}];
plot2 = Graphics[Circle[cen, Norm[ab]/2.]];
soln = NSolve[{Norm[ac]*({x, y} - aa).ab -
Norm[ab]*({x, y} - aa).ac ==
0, ({x, y} - cc).({-1, 1}*Reverse[bc]) == 0}, {x, y}];
dd = {x, y} /. soln[[1]];
mm = (dd + aa)/2;
soln = NSolve[{({x, y} - cen).({x, y} - cen) - ab.ab/4 ==
0, ({x, y} - cc).({-1, 1}*Reverse[mm - cc]) == 0}, {x, y}];
ff = {x, y} /. soln;
lens = Map[Norm[# - cc] &, ff];
ff = If[OrderedQ[lens], ff[[1]], ff[[2]]];
pts = {{aa, cen, "A"}, {bb, cen, "B"}, {cc, cen, "C"}, {dd, cen,
"D"}, {ff, cen, "F"}, {mm, cen, "M"}, {cen, ff, "O"}};
pts = Map[pointfunc[#, siz, eps] &, pts];
plot3 = Graphics[Join[pts, {Line[{aa, dd}], Line[{cc, mm}]}]];
Show[plot1, plot2, plot3, PlotRange -> {{-.2, 1.1}, {-.2, 1.2}},
AspectRatio -> Full, Axes -> False]],
{{aa, {0, 0}}, {0, 0}, {1, 1}, Locator},
{{bb, {.8, .7}}, {0, 0}, {1, 1}, Locator},
{{cc, {.1, 1}}, {0, 0}, {1, 1}, Locator},
TrackedSymbols :> None]
Here is a screen shot.
Daniel Lichtblau
Wolfram Research
Mathematica isn't the best software for this, although it will work out.
http://demonstrations.wolfram.com/DrawingATriangle/ has source code for a really nice triangle, and following that example you can add a bisecting line to the code.
As already stated, Mathematica is not the best software for this. There are several better options that you can use, depending on your exact purpose. To generate such figures programatically, there are several languages especially adapted for such tasks. I would recommend to try eukleides or GCLC. If you have any experience with TeX/LaTeX, you may want to look at metapost or asymptote, or even a LaTeX package such as tkz-euklide.
If you on the other hand prefer to create you drawings in an interactive way, there are number of programs available. Search the web for "dynamic geometry software", you should get a number of hits. Of those I would most recommend geogebra.
I thought that I should really attempt this problem in Mathematica (only once I finished did I see Daniel's solution). It took me about half an hour - which is longer than my GeoGebra solution, despite the fact that I'd never used GeoGebra before.
The code is not as fast as it could be. This is because I was too lazy to code up proper code for finding intersections of lines and circles, so I just used the slower but more general FindInstance.
A quite comprehensive plane geometry package can be found as part of Eric Weinstein's MathWorld packages. It includes all the intersection, bisection etc... code that you could possibly want, but it would take a little bit of time to learn it all.
angleBisector[A_,{B_,C_}]:=Module[{ba=Norm[B-A],ca=Norm[C-A],m},
m=A+((B-A)/ba+(C-A)/ca)]
intersect[Line[{A_,B_}],Line[{C_,D_}]]:=Module[{s,t},
A + s(B-A)/.First#FindInstance[A + s(B-A) == C + t(D-C), {s,t}]]
intersect[Line[{A_,B_}],Circle[p0:{x0_,y0_},r_]]:=Module[{s,x,y},
A + s(B-A)/.FindInstance[A + s(B-A) == {x,y}
&& Norm[p0-{x,y}] == r, {s,x,y}, Reals, 2]]
Manipulate[Module[{OO,circ,tri,angB,int,mid,FF},
OO=(AA+BB)/2;
circ=Circle[OO,Norm[AA-BB]/2];
tri=Line[{AA,BB,CC,AA}];
angB=angleBisector[AA,{BB,CC}];
int=intersect[Line[{BB,CC}],Line[{AA,angB}]];
mid=(AA+int)/2;
FF=intersect[Line[{CC,mid}],Circle[OO,Norm[AA-BB]/2]];
Graphics[{PointSize[Large],Point[{OO,int,mid}],Point[FF],tri,circ,
Line[{AA,AA+3(angB-AA)}],Line[{CC,CC+3(mid-CC)}],
Text["A",AA,{2,-2}],Text["B",BB,{-2,-2}],Text["C",CC,{2,2}],
Text["O",OO,{0,-2}],Text["D",int,{-2,-1}],Text["M",mid,{-2,-1}]},
PlotRange->{{-2,2},{-2,2}}]],
{{AA,{-1,1}},Locator},
{{BB,{1,1}},Locator},
{{CC,{0,-1}},Locator}]