Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2006
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2006

[Date Index] [Thread Index] [Author Index]

Search the Archive

RE: Resolve/Reduce is taking forever

  • To: mathgroup at smc.vnet.net
  • Subject: [mg67261] RE: [mg67217] Resolve/Reduce is taking forever
  • From: "David Park" <djmp at earthlink.net>
  • Date: Wed, 14 Jun 2006 06:29:49 -0400 (EDT)
  • Sender: owner-wri-mathgroup at wolfram.com

Bonny,

The following uses the Ted Ersek RootSearch package, which you can obtain
from MathSource at WRI. I have done three specific cases and will leave it
to you to work out a general routine.

Needs["Ersek`RootSearch`"]

Here is a curve definition and three curves.

curve[{a0_, a1_, a2_, a3_}, {b0_, b1_}][t_] :=
  {a3*t^3 + a2*t^2 + a1*t + a0, b1*t + b0}

curve1 = curve[{8, -2, 3, -4}, {0, 1}][t]
curve2 = curve[{1, 3, 3, 2}, {1, -3}][t]
curve3 = curve[{1, -4, 0, 4}, {0, 4}][t]
{8 - 2*t + 3*t^2 - 4*t^3, t}
{1 + 3*t + 3*t^2 + 2*t^3, 1 - 3*t}
{1 - 4*t + 4*t^3, 4*t}

Here is a line, which is oriented from the first point to the second point..

Line[{{2, -3}, {6, 5}}];

We want to know if the curve segments 0 <= t <= 1 is to the left of the
line. One approach to solving this problem is to translate and rotate the
plane so that the line segment lies along the positive y axis. Then the
curve segment is on the left if the x coordinate is always less than zero. I
find that the easiest method for doing this is to use complex algebra. Let
z1 and z2 be the end points of the line in the complex plane.

z1 = 2 - 3I;
z2 = 6 + 5I;

Shift and rotate objects in the plane so that the line is along the
imaginary axis. We want the solution that gives a positive value.

Re[Exp[I phi](z2 - z1)] == 0;
ComplexExpand[%]
phisols = RootSearch[%, {phi, 0, 2Pi}]
Im[Exp[I phi](z2 - z1)] /. phisols
phi0 = phi /. First@phisols
giving..
4 Cos[phi] - 8 Sin[phi] == 0
{{phi -> 0.463648}, {phi -> 3.60524}}
{8.94427, -8.94427}
0.463648

To check if the curve segment is on the left we can check that the maximum
real value is negative. To check that it is on the right we can check that
the minimum real value is positive. If the maximum and minimum real values
are of opposite sign the curve segment crosses the line, The first curve
segment is entirely on the right.

curve1 /. {x_, y_} -> x + I y
Re[Exp[I phi0](% - z1)] // ComplexExpand
NMaximize[{%, 0 <= t <= 1}, t]
NMinimize[{%%, 0 <= t <= 1}, t]

giving...
8 - (2 - I)*t + 3*t^2 - 4*t^3
4.024922359499621 - 2.23606797749979*t + 2.6832815729997477*t^2 -
  3.5777087639996634*t^3
{4.024922359499621, {t -> 0.}}
{0.894427, {t -> 1.}}

The second curve segment cuts across the line.

curve2 /. {x_, y_} -> x + I y
Re[Exp[I phi0](% - z1)] // ComplexExpand
NMaximize[{%, 0 <= t <= 1}, t]
NMinimize[{%%, 0 <= t <= 1}, t]

giving...
1 + I*(1 - 3*t) + 3*t + 3*t^2 + 2*t^3
-2.6832815729997477 + 4.024922359499621*t +
  2.6832815729997477*t^2 + 1.7888543819998317*t^3
{5.81378, {t -> 1.}}
{-2.68328, {t -> 0.}}

The third curve segment is entirely on the left.

curve3 /. {x_, y_} -> x + I y
Re[Exp[I phi0](% - z1)] // ComplexExpand
NMaximize[{%, 0 <= t <= 1}, t]
NMinimize[{%%, 0 <= t <= 1}, t]

giving...
1 - (4 - 4*I)*t + 4*t^3
-2.23606797749979 - 5.366563145999495*t + 3.5777087639996634*t^3
{-2.23607, {t -> 0.}}
{-4.76589, {t -> 0.707107}}

David Park
djmp at earthlink.net
http://home.earthlink.net/~djmp/


From: Bonny Banerjee [mailto:banerjee at cse.ohio-state.edu]
To: mathgroup at smc.vnet.net

I am trying to write a simple function that determines the conditions for a
curve to be on the left of a straight line. A curve is to the left of a
straight line if each point on the curve is to the left of the straight
line. The curve is specified using parametric equations:

x -> a3×t^3 + a2×t^2 + a1×t + a0
y -> b1×t + b0

where t is the parameter, 0<=t<=1, and {a0, a1, a2, a3, b0, b1} are real
coefficients. The straight line is specified using two points {x1,y1} and
{x2,y2}.

Here is the function:

isLeftofLine[{x1_, y1_}, {x2_, y2_}, {a0_, a1_, a2_, a3_, b0_, b1_}] =
Resolve[
      ForAll[t, 0 <= t <= 1 => fxy[{x1, y1}, {x2, y2}, {a3×t^3 + a2×t^2 +
     a1×t + a0, b1×t + b0}] <= 0],
{a0, a1, a2, a3, b0, b1}, Reals]

where

fxy[{x1_, y1_}, {x2_, y2_}, {x_, y_}] =
(x - x1)×(y2 - y1) - (y - y1)×(x2 - x1)

I tried Resolve and Reduce but both are taking forever. I waited for more
than 4 hours but could not get any result from any of them. Considering this
is a simple logical expression with only one universal quantifier, I am
surprised at what might be taking so long.

Any insights would be very helpful. Also, any alternative method for solving
the same problem, such as using any other function in place of
Reduce/Resolve or using a different representation for the curve or straight
line, would be nice to know. I preferred using parametric equations for
representing the curve as the curve is finite.

Thanks,
Bonny.





  • Prev by Date: Re: New Analytical Functions - Mathematica Verified
  • Next by Date: Re: Package writing
  • Previous by thread: Re: Resolve/Reduce is taking forever
  • Next by thread: Package writing