0
$\begingroup$

I am having difficulty with the error "is not a list of numbers with dimensions..." when using FindRoot (and other numerical routines in Mathematica) to solve equations numerically when the argument of FindRoot is a function of the variable being chosen to solve the equation.

Here is simple code illustrating the behavior:

ClearAll["Global`*"]
rV = Table[r[i], {i, 2}];
pV = Table[p[i], {i, 2}];
aV = Table[a[i], {i, 2}];
aV0 = {1, 2}; 
f[aV_, rV_, pV_] := Table[aV[[i]] + rV[[i]] - pV[[i]], {i, 2}]
pVStar[aV_, rV_] := 
  pV /. FindRoot[f[aV, rV, pV] == 0, {{p[1], 1}, {p[2], 1}}]
g[aV_, rV_, pV_] := 2 aV + rV - pV
h[aV_, rV_] := g[aV, rV, pVStar[aV, rV]]
FindRoot[Table[h[aV0, rV][[i]] == 0, {i, 2}], {{r[1], 1}, {r[2], 1}}]

Here is the error:

During evaluation of In[1]:= FindRoot::nlnum: The function value {0. +r[1.],1. +r[2.]}
is not a list of numbers with dimensions {2} at {p[1],p[2]} = {1.,1.}. >>

I tried putting ?(VectorQ[#,NumericQ]&) after the rV_ in the definition of pVStar, as suggested in another thread about applying ?NumericQ to vectors:

pVStar[aV_, rV_?(VectorQ[#,NumericQ]&)] := 
 pV /. FindRoot[f[aV, rV, pV] == 0, {{p[1], 1}, {p[2], 1}}]

That gives the error

FindRoot::nveq: "The number of equations does not match the number of variables in
FindRoot[Table[h[aV0,rV][[i]]==0,{i,2}],{{r[1],1},{r[2],1}}]. 

Thoughts?

$\endgroup$
5
  • $\begingroup$ That's a typo. I fixed it. $\endgroup$
    – Dan
    Jan 28, 2015 at 15:57
  • $\begingroup$ Please add a MINIMAL code example showing the behavior. $\endgroup$ Jan 28, 2015 at 16:06
  • $\begingroup$ Have you tried using a pattern which matches a vector of numeric values? rV_/;VectorQ[rV, NumericQ] $\endgroup$ Jan 28, 2015 at 20:55
  • $\begingroup$ Often FindRoot::nlnum is related to mathematica.stackexchange.com/a/26037. $\endgroup$
    – Michael E2
    Jan 29, 2015 at 0:47
  • $\begingroup$ Simon, I tried your suggestion just now. No joy. $\endgroup$
    – Dan
    Jan 29, 2015 at 17:31

1 Answer 1

2
$\begingroup$

This is a way:

rV = Array[r, 2];    pV = Array[p, 2];    aV = Array[a, 2];
aV0 = {1, 2};

f[aV_, rV_, pV_] := aV + rV - pV
pVStar[aV_, rV_] := pV /. FindRoot[f[aV, rV, pV] == 0, Thread[{pV, 1}]]
g[aV_, rV_, pV_] := 2 aV + rV - pV
h[aV_?(VectorQ[#, NumericQ] &), rV_?(VectorQ[#, NumericQ] &)] := 
                                                        g[aV, rV, pVStar[aV, rV]]
h[aV_, rV_?(VectorQ[#, ! NumericQ@# &] &)] := {1, 1}

However:

FindRoot[h[aV0, rV], Thread[{rV, 1}]]

FindRoot::jsing: Encountered a singular Jacobian at the point {r[1],r[2]} = {1.,1.}. Try perturbing the initial point(s). >> h[aV_, rV_?(VectorQ[#, ! NumericQ@# &] &)] := {1, 1}

Because effectively your system has no solutions:

Plot3D[h[aV0, {x, y}], {x, -1, 1}, {y, -1, 1}]

Mathematica graphics

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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