Re: Sphere formula
- To: mathgroup at smc.vnet.net
- Subject: [mg109538] Re: Sphere formula
- From: Ray Koopman <koopman at sfu.ca>
- Date: Tue, 4 May 2010 06:29:42 -0400 (EDT)
- References: <hr65rj$jq6$1@smc.vnet.net> <hrbach$hq9$1@smc.vnet.net>
On May 3, 3:10 am, "Alexander Elkins" <alexander_elk... at hotmail.com>
wrote:
> "Ray Koopman" <koop... at sfu.ca> wrote in message
[...]
>> The fix is simple: just change the definition of p.
>>
>> Block[{p1 = {0.018473,-1.1359,-0.768653},
>> p2 = {2.51514,5.25315,6.48158},
>> p3 = {0.818313,-0.881007,-1.0825}, b,c,p},
>> p = (1-b-c)p1 + b*p2 + c*p3;
>> p /. Flatten@Solve[{(p-p1).(p-p1)==(p-p2).(p-p2),
>> (p-p1).(p-p1)==(=
p-p3).(p-p3)},{b,c}]]
>>
>> {1.,2.,3.}
>
> As shown, Solve complains and gives no result:
>
> In[1]:=Block[{p1={0.018473,-1.1359,-0.768653},
> p2={2.51514,5.25315,6.48158},
> p3={0.818313,-0.881007,-1.0825},b,c,p},
> p=(1-b-c)p1+b*p2+c*p3;
> p/.Flatten@Solve[{(p-p1).(p-p1)==(p-p2).(p-p2),
> (p-p1).(p-p1)==(p-p3).(p-p3)},{b,c}]]
>
> During evaluation of In[1]:= Solve::tdep: The equations appear to \
> involve the variables to be solved for in an essentially \
> non-algebraic way. >>
>
> During evaluation of In[1]:= Solve::tdep: The equations appear to \
> involve the variables to be solved for in an essentially \
> non-algebraic way. >>
>
> During evaluation of In[1]:= ReplaceAll::reps: {Solve[<<1>>,{b,c}]} \
> is neither a list of replacement rules nor a valid dispatch table, \
> and so cannot be used for replacing. >>
>
> During evaluation of In[1]:= Solve::tdep: The equations appear to \
> involve the variables to be solved for in an essentially \
> non-algebraic way. >>
>
> During evaluation of In[1]:= General::stop: Further output of \
> Solve::tdep will be suppressed during this calculation. >>
>
> During evaluation of In[1]:= ReplaceAll::reps: {Solve[<<1>>,{b,c}]} \
> is neither a list of replacement rules nor a valid dispatch table, \
> and so cannot be used for replacing. >>
>
> Out[1]= {2.51514 b + 0.018473 (1 - b - c) + 0.818313 c,
> 5.25315 b - 1.1359 (1 - b - c) - 0.881007 c,
> 6.48158 b - 0.768653 (1 - b - c) -
> 1.0825 c} /.Solve[{(0.768653+ 6.48158 b - 0.768653 (1 - b - c) -
> 1.0825 c)^2 + (1.1359+ 5.25315 b - 1.1359 (1 - b - c) -
> 0.881007 c)^2 + (-0.018473 + 2.51514 b +
> 0.018473 (1 - b - c) + 0.818313 c)^2 == (-6.48158 +
> 6.48158 b - 0.768653 (1 - b - c) - 1.0825 c)^2 + (-5.25315=
+
> 5.25315 b - 1.1359 (1 - b - c) - 0.881007 c)^2 + (-2.51514=
+
> 2.51514 b + 0.018473 (1 - b - c) + 0.818313 c)^2, (0.76865=
3+
> 6.48158 b - 0.768653 (1 - b - c) - 1.0825 c)^2 + (1.1359+
> 5.25315 b - 1.1359 (1 - b - c) - 0.881007 c)^2 + (-0.01847=
3 +
> 2.51514 b + 0.018473 (1 - b - c) + 0.818313 c)^2 == (1=
.0825+
> 6.48158 b - 0.768653 (1 - b - c) - 1.0825 c)^2 + (0.881007=
+
> 5.25315 b - 1.1359 (1 - b - c) - 0.881007 c)^2 + (-0.81831=
3 +
> 2.51514 b + 0.018473 (1 - b - c) + 0.818313 c)^2}, {b, c}]
>
> If Solve is changed to NSolve the correct result is returned:
>
> In[2]:=Block[{p1={0.018473,-1.1359,-0.768653},
> p2={2.51514,5.25315,6.48158},
> p3={0.818313,-0.881007,-1.0825},b,c,p},
> p=(1-b-c)p1+b*p2+c*p3;
> p/.Flatten@NSolve[{(p-p1).(p-p1)==(p-p2).(p-p2),
> (p-p1).(p-p1)==(p-p3).(p-p3)},{b,c}]]
>
> Out[2]={1.,2.,3.}
The code I posted works nicely in v5.2, which is what I usually use.
It will also give a symbolic solution if the points are defined as
p1 = {x1,y1,z1}, etc., but the result is quite long.