0
$\begingroup$

I have a code to replace the z coordinate of one point A(x,y,0) on the xy plane:

g[x_, y_, z_] := Piecewise[{{(x - 1/2)^2 + y^2 + z^2 - 1/16, (x - 1/2)^2 + y^2 - 1/16 <= 0 && z >= 0}}, z];
center = {0, 0, 1}; (* point O*)
a = {0.76, 0, 0}; (* one point A on xy plane*)
line = Line[{a, center}]; (* connecting line of OA *)
surface = ImplicitRegion[g[x, y, z] == 0, {x, y, z}]; (* A surface described by g[x,y,z] *)

(* intersection points of OA and the surface, there maybe more than one intersection points*)
intersection = MeshCoordinates@DiscretizeRegion@RegionIntersection[line, surface]
(*{{0.76, 0., 0.}, {0.579987, 0., 0.236859}, {0.749627, 0., 0.0136485}}*)

(* find the nearest intersection point to O *)
interPoint = Nearest[intersection, center][[1]]
(* {0.579987, 0., 0.236859}*)

(* calculate the distance between O and the nearest intersection point*)
d = EuclideanDistance[center, point]
(* 0.958525*)

(*produce a coordinate with replacing a[[3]] with d *)
data = {a[[1]], a[[2]], d}
(* {0.76, 0, 0.958525}*)

Then I want to do the same calculation for 100 (for example) points on xoy plane between -1<=x<=1 and -1<=y<=1, like (-1,0,0),(-0.9,0,0),...(-1,0.1,0),(-1,0.2,0)...... Then I can have a group of coordinats like (a[1],a[2],d).

For loop in other programming languages can do this. In Mathematica, it seems that I should use Table to achieve it, but I am not familiar with Table. Is there anybody can help me to finish this code?

And then I want to make a contour plot, with x,y-coordinates as position and z-coordinate as color. Like this one:

data = Table[t[x,y], {y, -1, 1, 0.1}, {x, -1, 1, 0.1}];
plot = ListDensityPlot[data, DataRange -> {{-1, 1}, {-1, 1}}

enter image description here

And another contour plot lines look like this(This maybe need 100*100 points):

enter image description here

$\endgroup$
3
$\begingroup$

There are several ways, including For and Do loops. But you can pack all your calculation work in a Module (a function) and then fill it with the table command:

produceOutput[x1_, x2_, x3_] := 
 Module[{center = {0, 0, 1}, line, surface, intersection,
   interPoint, d, data},
  center = {0., 0., 1.};
  line = Line[{{x1, x2, x3}, center}];
  surface = ImplicitRegion[g[x, y, z] == 0., {x, y, z}];
  intersection = 
   MeshCoordinates@
    DiscretizeRegion@RegionIntersection[line, surface];
  interPoint = Nearest[intersection, center][[1]];
  d = EuclideanDistance[center, interPoint];
  data = {x1, x2, d};
  data
  ]

(the last line of module is just to keep your notation) and then:

    out = Table[produceOutput[x, y, 0.], {x, 0.0, 1.0, 0.2}, {y, 0.0, 1.0, 0.2}]

delivers the coordinates (data) you desire (I do not know whether my data makes any sense, they are just an example).

$\endgroup$
  • $\begingroup$ Thank you. I make a small change of your code: data={x1,x2,d} -> data=d . Otherwise, The data format is not correct when plot = ListDensityPlot[out, DataRange -> {{0, 1}, {0, 1}}]. $\endgroup$ – Qi Zhong May 2 '16 at 13:53
  • $\begingroup$ @QiZhong: I see, but you can also use "my" form of output and then ListDensityPlot[Flatten[out, 1]] $\endgroup$ – mgamer May 2 '16 at 17:36

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.