# Getting error Solve::ivar when solving a large system of equations

I'm trying to solve the first part of a Quantal Response Equilibrium (QRE).

I'm the situation of needing analytical solutions to a large system of equations (Logit-type). Solution will be up to a single parameter: I have, say, $n$ variables and $n-1$ equations.

Variables are in the form a[h]a[q], for example a1a3, plus the parameter d.

Each equation of the system of equations to be solved is in the following form:

a1a3 == Exp[d*pay[1, 3]]/Sum[Exp[d*pay[1, s]], {s, 0, qmax}]


where pay[h, q] and qmax[h] are functions that I have previously defined.

My code appears to work up to the last line, where I receive an error message:

Solve::ivar: {a1a0,a1a1,a1a2....} is not a valid variable. >>

Here the code.

qmax[h_] := Floor[8 Sqrt Sqrt[h]]
pay[h_, q_] :=
(32 - q^2/(4h))*(1/10)*
Sum[Sum[Symbol["a" <> ToString[t] <> "a" <> ToString[s]], {s, 0, (q-1)}]+
0.5*Symbol["a"<>ToString[t]<>"a" <>ToString[q]], {t, 1, 10}]
equations =
Table[
Table[
Symbol["a" <> ToString[h] <> "a" <> ToString[q]] ==
Exp[d*pay[h, q]]/Sum[Exp[d*pay[h, s]], {s, 0, qmax[h]}],
{q, 0, qmax[h]}],
{h, 1, 10}]
vars =
Table[Symbol["a" <> ToString[h] <> "a" <> ToString[q]], {h, 1, 10}, {q, 0,qmax[h]}]

Solve[{equations}, vars]


### Edit

Setting a value for d and using FindRoot is perfectly fine for me, but I'm still not able to solve the problem.

• Your first problem is that the vars list generate by your Table is nested, whereas Solve wants a flat list of variables. That's an easy fix: vars = Flatten @ Table[... rest of your code ...]. You might have the same problem with your equations too. More in general, your problem seems like a challenge for Solve to generate analytical solutions. Do you know that analytical solutions must exist for your equations? Jun 26, 2018 at 13:55
• Thanks, the "is not a valid variable" error has disappeared. Unfortunately, there is a new error: "[equations].. is not a quantified system of equations and inequalities". EDIT: the variables a1a3 ecc.. are probabilities; with d that goes to zero, then all probabilities goes to 0 except one; with d that goes to infinite, all probabilities become equal. For positive values of d a solution should exist. Jun 26, 2018 at 14:05
• 1) I think the equations problem is what I meant when I said "You might have the same problem with your equations too" previously. Try out a much smaller example to start, and inspect your equations variable to see that it is correct and shaped as you expect; now it is a nested list, which you nest further by wrapping it in {} within Solve, which I don't think you need. 2) A solution might exist, but it may not be possible to express it analytically, i.e. with a formula or equation, in which case you should use numerical solvers (e.g. FindRoot) to get its value. Jun 26, 2018 at 14:22
• Thanks, I will try. Findroot is fine for me. At the end of the day, I will generate many solutions (for many d) and - via maximum likelihood - I will find the "d" that best fit my observed data. Jun 26, 2018 at 14:34
• I still receive an error message. I have add vars = Flatten[ Table[{Symbol["a" <> ToString[[Theta]] <> "a" <> ToString[q]], 0.01}, {[Theta], 1, 2}, {q, 0, qmax[[Theta]]}], 1] and FindRoot[equations, vars] Jun 26, 2018 at 14:59

You appear to have 103 more variables than show up in your vars list.

qmax[h_] := Floor[8 Sqrt Sqrt[h]];
varpay[h_, q_] := Table[{
Table[Symbol["a" <> ToString[t] <> "a" <> ToString[s]], {s, 0, (q - 1)}],
Symbol["a" <> ToString[t] <> "a" <> ToString[q]]}, {t, 1, 10}];
vars = Union[Flatten[Table[
Table[{Symbol["a" <> ToString[h] <> "a" <> ToString[q]],
Table[{d, varpay[h, s]}, {s, 0, qmax[h]}], {d, varpay[h, q]}},
{q, 0, qmax[h]}], {h, 1, 10}]]];
pay[h_, q_] := (32 - q^2/(4 h))*(1/10)*
Sum[Sum[Symbol["a" <> ToString[t] <> "a" <> ToString[s]], {s, 0, (q - 1)}] +
0.5*Symbol["a" <> ToString[t] <> "a" <> ToString[q]], {t, 1, 10}];
equations = Total[Flatten[Table[Table[
Norm[Symbol["a" <> ToString[h] <> "a" <> ToString[q]]*
Sum[Exp[d*pay[h, s]], {s, 0, qmax[h]}] -
Exp[d*pay[h, q]]], {q, 0, qmax[h]}], {h, 1, 10}]]];
NMinimize[equations, vars]


I used a modified version of your equations to generate the vars list.

I multiplied both sides of your equations by your denominator and you should verify that does not give you an incorrect result.

I used Norm[lhs-rhs] and added all the equations together so that NMinimize could look for a solution.

I solved my problem. There were three problems with my code: 1) What I was asking was too challenging for Solve; I used FindRoot and a numeric value for "d". 2) Add Flatten 3) There was an error in the way the function "pay" was defined. As a result, the function created additional (and non-defined) variables.

The code works, but it requires 11 minutes to run. I will ask, in a separate question, if there is a way to make my code more efficient. Reasons because more efficiency is required: 1) The code need to run for 100 (at least) values of the parameter "d" 2) I have a different "pay" function which will generate much more equations to be solved (around 10.000).

Marco, thank you very much. Flatten was the key!

Bill, I do not entirely understand your solution strategy. Maybe it's more efficient?

Here the code. I also changed some notation.

 ClearAll["Global*"];
qmax[h_] := Floor[8 Sqrt Sqrt[h]];
qmax2[h_, q_] := Min[qmax[h], (q - 1)];
pay[h_, q_] := (32 - q^2/(4 h))*(1/10)*Sum[
Sum[
Symbol["t" <> ToString[t] <> "q" <> ToString[s]], {s, 0,
qmax2[t, q]}] +
If[q <= qmax[t],
0.5*Symbol["t" <> ToString[t] <> "q" <> ToString[q]], 0], {t, 1,
10}];
equations = Flatten@Table[
Table[
Symbol[
"t" <> ToString[h] <> "q" <> ToString[q]] ==
Exp[d*pay[h, q]]/Sum[Exp[d*pay[h, s]], {s, 0, qmax[h]}],
{q, 0, qmax[h]}],
{h, 1, 10}];
vars = Flatten[
Table[{Symbol["t" <> ToString[h] <> "q" <> ToString[q]], 0.01}, {h,
1, 10}, {q, 0, qmax[h]}], 1];
d = 1;
FindRoot[equations, vars]
`

And here the link for the follow-up question: FindRoot, large system of equations. Improving Efficiency, loop around many parameter and exporting results