0
$\begingroup$

enter image description hereI would be very grateful if you could help me to construct this matrix in Mathematica.

This is the code I have so far:

m = 10;
a = 0;
b = 1;
h = (b - a)/(m);

x[1] = 0;
x[m] = 1;

For[
  n = 2, n <= m, n++, 
  x[n] = x[1] + n h;
]

xvalues = Table[x[i], {i, 1, m}]; 
subs = Subsets[xvalues, {Length@xvalues - 1}]; 
complements = Flatten[Complement[xvalues, #] & /@ subs]; 

d = Table[ Times @@ (1/(subs[[i]] - complements[[i]])), {i, 1, Length@subs}]; 
For[
  n = 1, n <= m, n++,
  w[n] = d[[n]];
]

aa = Table[Delete[Table[w[i]/w[n]/(x[n] - x[i]), {n, 1, m}], i], {i, 1, m}] 
$\endgroup$
7
  • $\begingroup$ Welcome to the Mathematica Stack Exchange. Please edit the question further and review it before submitting to the forum. Thanks. $\endgroup$
    – Syed
    Sep 23, 2022 at 13:54
  • $\begingroup$ I will do it, Thanks $\endgroup$
    – Osama
    Sep 23, 2022 at 13:55
  • $\begingroup$ What have you tried so far? Have you tried at least defining your relationships as Mathematica functions? Can you include those as text code so it can be copy-pasted? $\endgroup$
    – MarcoB
    Sep 23, 2022 at 13:55
  • $\begingroup$ m = 10; a = 0; b = 1; h = (b - a)/(m); x[1] = 0; x[m] = 1; For[n = 2, n <= m, n++, x[n] = x[1] + n h; ] xvalues = Table[x[i], {i, 1, m}]; subs = Subsets[xvalues, {Length@xvalues - 1}]; complements = Flatten[Complement[xvalues, #] & /@ subs]; $\endgroup$
    – Osama
    Sep 23, 2022 at 14:04
  • $\begingroup$ d = Table[ Times @@ (1/(subs[[i]] - complements[[i]])), {i, 1, Length@subs}]; For[n = 1, n <= m, n++, w[n] = d[[n]]; ] In[20]:= aa = Table[Delete[Table[w[i]/w[n]/(x[n] - x[i]), {n, 1, m}], i], {i, 1, m}] $\endgroup$
    – Osama
    Sep 23, 2022 at 14:05

1 Answer 1

0
$\begingroup$

I'd write it like this. I use the trick that if I have the product over all values except $k$, I just replace the $k$th term with $1$; if I have the sum over all values except $k$, I just replace the $k$th term with $0$.

I left x as is, but check out Range and Subdivide; you might find something like Clear[x]; Evaluate@Array[x, {m}] = Subdivide[a, b, m - 1] useful, which sets all x's at once.

Note: I assume there was a typo in the definition of w, and that it should have been $\prod_{k\neq j}$. If not, the code might need modification.

I also can't help but wonder: is there a typo in $L''$? The sum over $k$ includes a (relatively) constant term, $\frac{1}{x_i-x_j}$, which does not depend on $k$ and thus can come out of the sum with a factor of $n-1$ attached (m in the code). In any case, I translated the expressions "verbatim", matching the code to the expression as closely as possible, with the exception of using Total or Times and Array instead of Sum or Product for some speed.

I also use a trick for memoization, to remember explicit values: f[x_] := (f[x] = ...) will e.g. calculate f[1] only when it is first called, but then remember that explicit calculated value for later. See here.

m = 10;
a = 0;
b = 1;
h = (b - a)/(m);

x[1] = 0;
Do[x[i] = x[1] + i h, {i, 2, m}];

Do[w[j] = 1/(Times @@ Array[If[j == #, 1, x[j] - x[#]] &, {m}]), {j, 
  1, m}]

Lpp[j_][i_] := (Lpp[j][i] = If[j == i,
    -Total @ Array[If[i == #, 0, Lpp[#][i]] &, {m}],
    -2 (w[j]/w[i])/(x[i] - x[j])
     (Total @ Array[
         If[i == #, 
          0, (w[#]/w[i])/(x[i] - x[#]) + 1/(x[i] - x[j])] &, {m}])
    ])

D2 = Array[Lpp[#2][#1] &, {m, m}]

Hope this helps! Let me know if there's any unfamiliar syntax.

$\endgroup$
4
  • $\begingroup$ I am grateful for your help. Unfortunately, when I run the code, I get this message "Syntax::sntxf: "k|" cannot be followed by "->If[i==k,0,(w[k]/w[i])/(x[i]-x[k])+1/(x[i]-x[j])]"." what does it means? $\endgroup$
    – Osama
    Sep 26, 2022 at 8:37
  • 1
    $\begingroup$ @Osama I suspect you're running an older version of Mathematica from before |-> syntax for functions was introduced; I've edited the answer. Hopefully it's compatible now? $\endgroup$
    – thorimur
    Sep 26, 2022 at 18:58
  • $\begingroup$ I am grateful for your help Dr. thorimur $\endgroup$
    – Osama
    Sep 30, 2022 at 12:29
  • $\begingroup$ Thank you Dr. thorimur for your help, your code is fantastic. Unfortunately, I got the number 9 in the numerator of some fractions but I don't know from where. can you please run this part of your code, m = 10; a = 0; b = 1; Lpp[j_][i_] := (Lpp[j][i] = If[j == i, -Total@ Array[If[i == #, 0, Lpp[#][i]] &, {m}], -2 (w[j]/w[i])/(x[i] - x[j]) (Total@ Array[If[i == #, 0, (w[#]/w[i])/(x[i] - x[#]) + 1/(x[i] - x[j])] &, {m}])]) D2 = Array[Lpp[#2][#1] &, {m, m}] @ Thorimur $\endgroup$
    – Osama
    Oct 5, 2022 at 18:00

Your Answer

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

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