# Arrange solutions of equations in column form in a table

If we have the following system of equations:

Subscript[S, 1] = E^(-a (2 Subscript[t, n] + 3 (Subscript[t, n])^2))
Subscript[S, 2] = E^(-a (3 Subscript[t, n] + 5 (Subscript[t, n])^2))
Subscript[S, 3] = E^(-a (7 Subscript[t, n] + 2 (Subscript[t, n])^2))
Subscript[S, 4] = E^(-a (Subscript[t, n] + 6 (Subscript[t, n])^2))


And we have the values for variables $$n$$ and $$t_n$$ in order

n = {1, 2, 3, ..., 9}
Subscript[t, n] = {1.2, 1.4, 1.5, 1.1, 1.7, 1.6, 0.9, 1.8, 2}


What is required is to solve the system of equations at each value of $$n$$ in order and put it in a table.

My attempts were to find the solution manually in each case separately, but when the values of $$n$$ increase, the order of the data becomes very stressful.

An example of finding a solution to the first case:(n=1)

n = 1;
Subscript[t, n] = 1.2;
NSolve[Subscript[S, 1] == n/10 && 0 < a < 10, a, Reals]
NSolve[Subscript[S, 2] == n/10 && 0 < a < 10, a, Reals]
NSolve[Subscript[S, 3] == n/10 && 0 < a < 10, a, Reals]
NSolve[Subscript[S, 4] == n/10 && 0 < a < 10, a, Reals]


We get solutions

{{a -> 0.342647}}
{{a -> 0.213202}}
{{a -> 0.20413}}
{{a -> 0.234003}}


An example of finding a solution to the second case:(n=2)

n = 2;
Subscript[t, n] = 1.4;
NSolve[Subscript[S, 1] == n/10 && 0 < a < 10, a, Reals]
NSolve[Subscript[S, 2] == n/10 && 0 < a < 10, a, Reals]
NSolve[Subscript[S, 3] == n/10 && 0 < a < 10, a, Reals]
NSolve[Subscript[S, 4] == n/10 && 0 < a < 10, a, Reals]


We get solutions

{{a -> 0.185419}}
{{a -> 0.11496}}
{{a -> 0.117306}}
{{a -> 0.122298}}


Then we complete the solution for each value of $$n$$ sequentially to (n=9) in form a table of solutions.

The table should be as follows:

I hope the code will be more general with increasing the values of $$n$$ and increasing the number of equations.

This is an example of how you can automate your process. Please run this with a fresh kernel (Quit[]).

eqs = {
S[1] == E^(-a (2 t + 3 t^2)),
S[2] == E^(-a (3 t + 5 t^2)),
S[3] == E^(-a (7 t + 2 t^2)),
S[4] == E^(-a (t + 6 t^2))
};
ts = {1.2, 1.4, 1.5, 1.1, 1.7, 1.6, 0.9, 1.8, 2};

res = Catenate[Table[
With[{eqs = eqs /. {t -> ts[[n]], S[_] :> n/10}},
Table[{n, Subscript[S, m],
a /. First@NSolve[eqs[[m]] && 0 < a < 10, a, Reals]}, {m, 1, 4}]],
{n, 1, 9}]];

Grid[Prepend[res, {n, Subscript[S, m], a}], Frame -> All]


• NSolveValues is Undefined Jul 21, 2023 at 12:50
• Function NSolveValues is not defined in my version of the program. I used this First[a /. NSolve[eqs[[m]] && 0 < a < 10, a, Reals]] Jul 21, 2023 at 14:02
• For the record, NSolveValues was introduced in v12.3 of Mathematica. Jul 21, 2023 at 14:46
• @Emadkareem, I have replaced NSolveValues with NSolve which should be available in your version. Jul 21, 2023 at 16:15

My attempt:

eqns = {Subscript[S, 1], Subscript[S, 2], Subscript[S, 3], Subscript[S, 4]};
ns = Range[9];
nslabels = ns /. n_List :> ConstantArray[n, Length[eqns]] // Transpose;
Slabels = {{Subscript["S", "1"], Subscript["S", "2"],
Subscript["S", "3"], Subscript["S", "4"]}} /.
n_ :> ConstantArray[n, Length[ns]] /. {s_} :> Flatten[s];
tnvals = {1.2, 1.4, 1.5, 1.1, 1.7, 1.6, 0.9, 1.8, 2};


The calculation of each a for each n:

data = Map[Rationalize,
Table[eqns /. Subscript[t, n] -> tnvals[[i]], {i, 1, Length[tnvals]}], {2}];

data2 = Map[Catenate,
Partition[Riffle[data, List /@ ns], {2}] /. {{x__}, {y__}} :>
Equal[x__, y__] :> NSolveValues[x == y/10 && 0 < a < 10, a, Reals]]


Using the documentation for Grid:

  Text@Grid[
Prepend[Catenate@
Table[Transpose@{nslabels[[i]], Slabels[[i]], data2[[i]]}, {i, 1,
Length[ns]}], {"n", Subscript["S", "m"], "a"}],
Background -> {None, {Lighter[Yellow, .9], {White,
Lighter[Blend[{Blue, Green}], .8]}}},
Dividers -> {{Darker[Gray, .6], {Lighter[Gray, .5]},
Darker[Gray, .6]}, {Darker[Gray, .6], Darker[Gray, .6], {False},
Darker[Gray, .6]}}, ItemSize -> {{10, 10, 10, 10}},
Frame -> Darker[Gray, .6], ItemStyle -> 14,
Spacings -> {Automatic, .8}, Alignment -> Center]


The table looks as follows:

Subscripted variables often give troubles, do not use them. If necessary, use indexed variables. Further, do not use capitalized variable names, they are reserved for the system.

You may define a helper function that does most of the work:

Clear["Global*"];
s1 = E^(-a (2  tn + 3  tn^2));
s2 = E^(-a (3  tn + 5  tn^2));
s3 = E^(-a (7 tn + 2  tn^2));
s4 = E^(-a (tn + 6  tn^2));

getSol[n_, val_] := Module[{tab, i = 1},
tab = a /. {
NSolve[(s1 /. tn -> val) == n/10 && 0 < a < 10, a, Reals][[1]],
NSolve[(s2 /. tn -> val) == n/10 && 0 < a < 10, a, Reals][[1]],
NSolve[(s3 /. tn -> val) == n/10 && 0 < a < 10, a, Reals][[1]],
NSolve[(s4 /. tn -> val) == n/10 && 0 < a < 10, a,
Reals][[1]]};
tab = {n, ss[[i++]], #} & /@ tab];

ss = Table[Subscript["S", i], {i, 9}];
tns = {1.2, 1.4, 1.5, 1.1, 1.7, 1.6, 0.9, 1.8, 2};
sols = Flatten[MapThread[getSol, {Range[9], tns}], 1];
PrependTo[sols, {"n", "\!$$\*SubscriptBox[\(S$$, $$m$$]\)", "a"}];

Grid[sols, Frame -> All, Spacings -> {2, 1}]
`

• Note that your solutions for $a$ seem to be different than the table provided by OP (and results in other answers). Jul 21, 2023 at 11:07
• Thank you, was a problem with subscripted variables. rewrote the code without subscripted variables. Jul 21, 2023 at 12:10