Skip to main content

Plotting three-dimensional plot with Interpolating functions

I want to plot my functions, but I can't seem to figure out what's going wrong. I want to be able to animate it as well.

N0 = 4; μ = 2; ϵ = 5
crazy = Flatten[
Join[
Table[x[i, j]''[t] == ϵ*(1 - x[i, j][t]^2)*x[i, j]'[t] - 
  x[i, j][t] + μ*(x[i + 1, j][t] + x[i, j + 1][t] - 
     4*x[i, j][t] + x[i - 1, j][t] + x[i, j - 1][t]), {i, 1, 
 N0 - 1}, {j, 1, N0 - 1}],

{Table[
 x[i, 0]''[t] == -x[i, 0][t] + ϵ*(1 - x[i, 0][t]^2)*
    x[i, 0]'[
     t] + μ*(x[i, 1][t] + x[i + 1, 0][t] - 4*x[i, 0][t] + 
      x[i - 1, 0][t] + x[i, N0][t]), {i, 1, N0 - 1}],

Table[
 x[i, N0]''[t] == ϵ*(1 - x[i, N0][t]^2)*x[i, N0]'[t] - 
   x[i, N0][
    t] + μ*(x[i + 1, N0][t] + x[i, 0][t] - 4*x[i, N0][t] + 
      x[i - 1, N0][t] + x[i, N0 - 1][t]), {i, 1, N0 - 1}],

Table[
 x[0, j]''[t] == ϵ*(1 - x[0, j][t]^2)*x[0, j]'[t] - 
   x[0, j][t] + μ*(x[1, j][t] + x[0, j + 1][t] - 
      4*x[0, j][t] + x[N0, j][t] + x[0, j - 1][t]), {j, 1, 
  N0 - 1}],

Table[
 x[N0, j]''[t] == ϵ*(1 - x[N0, j][t]^2)*x[N0, j]'[t] - 
   x[N0, j][
    t] + μ*(x[0, j][t] + x[N0, j + 1][t] - 4*x[N0, j][t] + 
      x[N0 - 1, j][t] + x[N0, j - 1][t]), {j, 1, N0 - 1}],

x[0, 0]''[t] == ϵ*(1 - x[0, 0][t]^2)*x[0, 0]'[t] - 
  x[0, 0][t] + μ*(x[1, 0][t] + x[0, 1][t] - 4*x[0, 0][t] + 
     x[N0, 0][t] + x[0, N0][t]),

x[N0, 0]''[t] == ϵ*(1 - x[N0, 0][t]^2)*x[N0, 0]'[t] - 
  x[N0, 0][
   t] + μ*(x[0, 0][t] + x[N0, 1][t] - 4*x[N0, 0][t] + 
     x[N0 - 1, 0][t] + x[N0, N0][t]),

x[0, N0]''[t] == ϵ*(1 - x[0, N0][t]^2)*x[0, N0]'[t] - 
  x[0, N0][
   t] + μ*(x[1, N0][t] + x[0, 0][t] - 4*x[0, N0][t] + 
     x[N0, N0][t] + x[0, N0 - 1][t]),

x[N0, N0]''[t] == ϵ*(1 - x[N0, N0][t]^2)*x[N0, N0]'[t] - 
  x[N0, N0][
   t] + \[Mu]*(x[0, N0][t] + x[N0, 0][t] - 4*x[N0, N0][t] + 
     x[N0 - 1, N0][t] + x[N0, N0 - 1][t]),


    x[0, 0][0] == 1, x[0, 0]'[0] == .5, x[N0/2, N0/2][0] == 0, 
x[N0/2, N0/2]'[0] == 0},
Table[x[i, j]'[0] == 0, {i, 1, N0/2 - 1}, {j, 0, N0}], 
Table[x[i, j][0] == 0, {i, 1, N0/2 - 1}, {j, 0, N0}],
Table[x[i, j]'[0] == 0, {i, N0/2 + 1, N0}, {j, 0, N0}], 
Table[x[i, j][0] == 0, {i, N0/2 + 1, N0}, {j, 0, N0}],
Table[x[N0/2, j]'[0] == 0, {j, 0, N0/2 - 1}], 
Table[x[N0/2, j][0] == 0, {j, 0, N0/2 - 1}],
Table[x[N0/2, j]'[0] == 0, {j, N0/2 + 1, N0}], 
Table[x[N0/2, j][0] == 0, {j, N0/2 + 1, N0}],
Table[x[0, j][0] == 0, {j, 1, N0}], 
Table[x[0, j]'[0] == 0, {j, 1, N0}]]];


moo = NDSolve[crazy, Table[x[i, j], {i, 0, N0}, {j, 0, N0}], {t, 100}]


points = Table[{i, j, x[i, j][t]} /. moo, {i, 0, N0}, {j, 0, 
N0}], {t, 0, 100}

Animate[ListPointPlot3D[points], {t, 0, 100
}, AnimationRate -> 2, AnimationRepetitions -> 2, 
AnimationRunning -> False]
Slightly
  • 321
  • 1
  • 2
  • 11