4
$\begingroup$

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: enter image description here

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

Please Help

$\endgroup$

3 Answers 3

3
$\begingroup$

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]

enter image description here

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

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__}} :> 
Thread @@ Thread[{{x} == ConstantArray[y, 4]}] /. 
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:

enter image description here

$\endgroup$
2
$\begingroup$

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}]

enter image description here

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

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.