Group Abstract Group Abstract

Message Boards Message Boards

0
|
6.7K Views
|
6 Replies
|
2 Total Likes
View groups...
Share
Share this post:

Solve a system of equations

Posted 10 years ago

A Mathematica file is attached here.

In this file, I am unable to solve a system of equations.

Kindly some one help me solve this system.

Attachments:
POSTED BY: Imran Khan
6 Replies

I would add that it appears to me to be a set of linear equations. I suspect that LinearSolve would handle this much more efficient

POSTED BY: Kay Herbert
Posted 10 years ago

Imran,

What are you actually trying to solve? Variable t7 contains expressions like

w[1, 2] == 0.001 w[0, 1] + 0.998 w[1, 1] + 0.001 w[2, 1]
w[9, 10001] == 0.001 w[8, 10000] + 0.998 w[9, 10000] + 0.001 w[10, 10000]

Are you really trying to solve tens of thousands of equations simultaneously?

Also, your general approach is kind of hard to follow. While you do want a Table of equations at the end to pass to Solve, you don't need to laboriously create a bunch of intermediate Tables. It might be clearer to create a function that outputs an equation, and then create a Table based on that function.

But if t7 really does look like you want it too, then I'd say you've exceeded what Solve can do. You might have to look for other Mathematica functions or change your approach.

POSTED BY: Eric Rimbey
Posted 10 years ago

Actually I am trying to implement an explicit fininte difference scheme given in a research paper. This time mathematica is solving system of equations but the answer is incorrect.

v = 1; m = 10; h = 0.1; t = 0.1; k = 0.00001; jj = 10000; r = 0.001;

t = Table[w[i, 0] = Exp[(Cos[Pi*i*h] - 1)/(2 Pi*v)], {i, 0, m}] // N;

t1 = Table[w[0, j + 1] == (1 - 2 r) w[0, j] + 2 r*w[1, j], {j, 0, jj}];

t2 = Table[
   w[m, j + 1] == (1 - 2 r) w[m, j] + 2 r*w[m - 1, j], {j, 0, jj}];

t3 = Table[
   w[i, j + 1] == (1 - 2 r) w[i, j] + r*w[i + 1, j] + 
     r*w[i - 1, j], {i, 1, m - 1}, {j, 0, jj}];

t4 = Flatten[{t1, t2, t3}];

s = Solve[t4];

vv = Table[w[i, 1000], {i, 0, m}]; ss = vv /. s // Flatten

{0.985501, 0.978726, 0.959284, 0.929645, 0.893389, 0.854581, \
0.817182, 0.784618, 0.759545, 0.743798, 0.738435}

Table[-((ss[[i + 1]] - ss[[i - 1]])/ss[[i]])/h, {i, 2, 10}]

{0.267864, 0.511634, 0.70882, 0.840226, 0.891744, 0.856148, 0.734593, \
0.537418, 0.283805}
POSTED BY: Imran Khan

You didn't test the result correctly. The solution is actually fine. Check the residuals (as below).

exprs = Apply[Subtract, t4, {1}];
exprs[[1 ;; 3]]

(* Out[398]= {-0.999984481326 + w[0, 1], -0.998 w[0, 1] + w[0, 2] - 
  0.002 w[1, 1], -0.998 w[0, 2] + w[0, 3] - 0.002 w[1, 2]} *)

s = Solve[t4];
s2 = Dispatch[s[[1]]];
Max[Abs[exprs /. s2]]

(* Out[405]= 2.22044604925*10^-16 *)

The largest is on the order of a machine double ULP. That's as good as it gets.

POSTED BY: Daniel Lichtblau

Looks like your problem is too big for Mathematica to solve.

POSTED BY: Frank Kampas
Posted 10 years ago

Sir , this time Mathematica is solving the system, but the answer is incorrect

v = 1; m = 10; h = 0.1; t = 0.1; k = 0.00001; jj = 10000; r = 0.001;

t = Table[w[i, 0] = Exp[(Cos[Pi*i*h] - 1)/(2 Pi*v)], {i, 0, m}] // N;

t1 = Table[w[0, j + 1] == (1 - 2 r) w[0, j] + 2 r*w[1, j], {j, 0, jj}];

t2 = Table[
   w[m, j + 1] == (1 - 2 r) w[m, j] + 2 r*w[m - 1, j], {j, 0, jj}];

t3 = Table[
   w[i, j + 1] == (1 - 2 r) w[i, j] + r*w[i + 1, j] + 
     r*w[i - 1, j], {i, 1, m - 1}, {j, 0, jj}];

t4 = Flatten[{t1, t2, t3}];

s = Solve[t4];

vv = Table[w[i, 1000], {i, 0, m}]; ss = vv /. s // Flatten

{0.985501, 0.978726, 0.959284, 0.929645, 0.893389, 0.854581, \
0.817182, 0.784618, 0.759545, 0.743798, 0.738435}

Table[-((ss[[i + 1]] - ss[[i - 1]])/ss[[i]])/h, {i, 2, 10}]

{0.267864, 0.511634, 0.70882, 0.840226, 0.891744, 0.856148, 0.734593, \
0.537418, 0.283805}
POSTED BY: Imran Khan
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard