2

I cannot figure out why FindRoot doesn't work and returns this error: The number of equations does not match the number of variables in ...

My problem: drawing ground g, putting a bigger circle on it.

g = With[{
   p = {
     {-1.088, -0.395}, {-0.572, 0.235},
     {-0.138, -0.28}, {0.404, 0.145},
     {0.854, -0.405}, {1.204, -0.07}}},
  BSplineFunction[p]]

pr = N@With[{h = 1/GoldenRatio},
   {{-1, 1}, {-h, h}}]

perp[{x_?NumericQ, y_?NumericQ}] := Normalize[{-y, x}]

Module[{R = .1, t = .2, p1},
 p1 = g[t] + R perp[g'[t]];
 Graphics[{
   LightGray, Rectangle @@ Transpose@pr,
   Gray, Line[g /@ Range[0, 1, .01]],
   Black, Circle[p1, R]},
  PlotRange -> pr,
  ImageSize -> 300]]

pic1

Now I would like to draw a smaller circle which touches the ground and the bigger circle to its left. But this produces the error:

FindRoot[
 EuclideanDistance[
   g[.2] + .1 perp[g'[.2]],
   g[u] + .05 perp[g'[u]]] == .1 + .05, {u, .1}]
BoLe
  • 5,819
  • 15
  • 33
  • I'm using a bisection routine now. I'd rather use FindRoot for elegance and accuracy. – BoLe Jul 18 '13 at 09:51

1 Answers1

3

I'm sure this sort of thing appears in other answer, but I can't find a closely related right now. The issue has to do with when EuclideanDistance and g[u] are evaluated. EuclideanDistance is evaluated too soon, before a numeric value for u is passed to g[u], that is, while g[u] still looks like a single numeric expression. When FindRoot finally plugs a number in for u, EuclideanDistance has already evaluated to

Mathematica graphics

Since the BSplineFunctions evaluate to a vector, the whole expression becomes a vector. Thus there are more components (2) that need to satisfy the equation than variables (1).

To fix this, one might create one's own function with a ?NumericQ pattern test:

dist[u_?NumericQ] := EuclideanDistance[g[.2] + .1 perp[g'[.2]], g[u] + .05 perp[g'[u]]];

FindRoot[dist[u] - (.1 + .05), {u, .1}]
(* {u -> 0.152871} *)

Touching circles:

Module[{R = .1, r = 0.05, t = .2, p1, p2},
 p1 = g[t] + R perp[g'[t]]; 
 p2 = g[u] + r perp[g'[u]] /. FindRoot[dist[u] - (.1 + .05), {u, .1}];
 Graphics[{LightGray, Rectangle @@ Transpose @ pr, Gray, 
   Line[g /@ Range[0, 1, .01]], Black, Circle[p1, R], Circle[p2, r]}, 
  PlotRange -> pr, ImageSize -> 300]]

Mathematica graphics

Michael E2
  • 235,386
  • 17
  • 334
  • 747