Re: Re: Picking out pieces of a list
- To: mathgroup at smc.vnet.net
- Subject: [mg76037] Re: [mg75973] Re: Picking out pieces of a list
- From: DrMajorBob <drmajorbob at bigfoot.com>
- Date: Tue, 15 May 2007 04:52:34 -0400 (EDT)
- References: <f26nc2$42l$1@smc.vnet.net> <33344123.1179134897225.JavaMail.root@m35>
- Reply-to: drmajorbob at bigfoot.com
How's this:
Clear[pt, setup]
setup[r1_, p1_, r2_, p2_, angles_List] :=
Module[{circle1, circle2, polygons},
circle1 = pt[r1, p1] /@ angles;
circle2 = pt[r2, p2] /@ angles;
polygons =
Replace[Transpose@{Partition[circle1, 2, 1],
Partition[circle2, 2, 1]}, {{x_List, y_List}, {a_, b_}} :>
Polygon@{x, y, b, a}, {1}];
{circle1, circle2, polygons}
]
pt[r_: 1.0, p_: {0, 0, 0}][\[Theta]_] :=
r {0, Cos@\[Theta], Sin@\[Theta]} + p
r1 = 1.0; p1 := {dx, 0, 0};
r2 = 0.8; p2 = {0, 0, 0};
(* with lines on the cone *)
dx = 0.5;
angles = Range[-\[Pi], \[Pi], \[Pi]/20];
{circle1, circle2, polygons} = setup[r1, p1, r2, p2, angles];
Graphics3D[{Opacity[.25], EdgeForm[], Line@circle1, Polygon@circle2,
Polygon@circle2, Line@Transpose@{circle1, circle2}, polygons}]
(* a different dx, more polygons, no lines on the cone, and partial =
circles *)
dx = 0.8;
angles = Range[-\[Pi], \[Pi]/2, \[Pi]/100];
{circle1, circle2, polygons} = setup[r1, p1, r2, p2, angles];
Graphics3D[{Opacity[.25], EdgeForm[], Line@circle1, Polygon@circle2,
Polygon@circle2, polygons}]
Bobby
On Mon, 14 May 2007 02:41:57 -0500, Jens-Peer Kuska =
<kuska at informatik.uni-leipzig.de> wrote:
> Hi,
>
> and
>
> Graphics3D[{Opacity[.3],
> EdgeForm[], {Line[#], Polygon[#]} &@pts[[All, 1]],
> Polygon[#] &@pts[[All, 2]],
> Polygon[Flatten[{#[[1]], Reverse[#[[2]]]}, 1] ] & /@
> Partition[pts, 2, 1]}]
>
> does not help ?
>
> Regards
> Jens
>
> Hatto von Aquitanien wrote:
>> Here's the motivation. I want to draw slice out of a cone. (I don't =
=
>> know
>> the proper mathematical term for this, but my meaning should be clear=
=
>> from
>> the code.) Note: See Feynman, Vol II, Page 1-8.
>>
>> (*A function that generates coordinates:*)
>>
>> R3[\[Theta]_, r_: 1.0, p_: {0, 0, 0}] :=
>> r {0, Cos@\[Theta], Sin@\[Theta]} + p
>>
>> (*Some "constant" values:*)
>>
>> r1 = 1.0;
>> r2 = 0.8;
>> \[CapitalDelta]x = 0.5;
>>
>> (*Points representing the centers of the circular faces:*)
>>
>> p1 = {\[CapitalDelta]x, 0, 0};
>> p2 = {0, 0, 0};
>>
>> (*A list of point pairs:*)
>>
>> pts = {R3[#, r1, p1], R3[#, r2, p2]} & /@Range[-\[Pi], \[Pi], \[Pi]=
/20];
>>
>> (*Draw the circular faces, and the reference curve:*)
>>
>> Graphics3D[{
>> Opacity[.3]
>> , EdgeForm[]
>> , {Line[#], Polygon[#]} &@pts[[All, 1]]
>> , Polygon[#] &@pts[[All, 2]]
>> }]
>>
>> Now, I know I can use table, or some kind of brute force manipulation=
=
>> with
>> (...)&/Range[Length@pts] to extract the points in the correct order t=
o =
>> draw
>> the polygons for the sides. What I want to know is whether there is =
a =
>> way
>> to use Part[] to get the four points in one statement.
>>
>> Here's a little scratch-pad code I created to explore the problem.
>>
>> c = CharacterRange["1", "9"]
>> (lst = Table[
>> DisplayForm[
>> SubscriptBox["P", c[[i]] <> c[[j]] <> c[[k]]]]
>> , {i, 1, Length@c}
>> , {j, 1, 2}
>> , {k, 1, 2}]) // MatrixForm
>>
>> (*Get the points of the first ring*)
>>
>> lst[[All, 1]] // MatrixForm
>>
>> (*Get the points of the second ring*)
>>
>> lst[[All, 2]] // MatrixForm
>>
>> (*Here is /a/ solution to the problem:*)
>>
>> m[n_, lst_] := lst[[Mod[n + 1, Length@lst, 1]]]
>>
>> Join[lst[[#]][[{1, 2}]], m[#, lst][[{2, 1}]]] & /@ Range@len // =
>> MatrixForm
>>
>> Is there a "tighter" way to accomplish the same thing?
>>
>
>
-- =
DrMajorBob at bigfoot.com