1
$\begingroup$

I have some code will test an equation and finds values for (n,j,k,l) in which the expression is true and puts them in the matrix - here is the code.

m = Table[
If[(n)^2 + (j)^4 + (k)^3 + (l) == 0, {n, j, k, l}, Nothing], {n, 
 0, 10, 1}, {j, 0, 10, 1}, {k, -10, 0, 1}, {l, -10, 0, 1}] // 
   Flatten[#, 3] & // Select[Length@# > 0 &]; m // MatrixForm

Here is the output

image of the matrix

So the columns of the matrix correspond to the values of (n,j,k,l). Now I want to create a new matrix, where I introduce a counter value that starts at say 0.01 and increments by 0.01 with each iteration, call it a++.

The new 3 column matrix will take the value of (n,j,a) and put it into the matrix as the first row, and also (while keeping the same a value) will also add (k,l,a) as the second row and then move the next row of the original matrix and so the same process, with the counter a incremented.

The code I made for this (although it does not work) is as follows

For[i = 1, i < 20, i++, m2[[i]] = {{m[[i, 1]]}, {m[[i, 2]]}, {i}}; 
m2[[i + 1]] = {{m[[i, 3]]}, {m[[i, 4]]}, {i}}]

Lastly, I want to use the 3 column matrix as (x,y,z) points to plot 3D point plot of surface in Mathematica

$\endgroup$
2
$\begingroup$

Something like this?

Join @@ MapIndexed[Partition[#1, 2] /. x_?VectorQ :> Join[x, 0.01 #2] &, m]
ListPlot3D[%, PlotStyle -> PointSize[0.02]]

{{0, 0, 0.01}, {0, 0, 0.01}, {0, 1, 0.02}, {-1, 0, 0.02}, {0, 1, 0.03}, {0, -1, 0.03}, {0, 2, 0.04}, {-2, -8, 0.04}, {1, 0, 0.05}, {-1, 0, 0.05}, {1, 0, 0.06}, {0, -1, 0.06}, {1, 1, 0.07}, {-1, -1, 0.07}, {1, 1, 0.08}, {0, -2, 0.08}, {1, 2, 0.09}, {-2, -9, 0.09}, {2, 0, 0.1}, {-1, -3, 0.1}, {2, 0, 0.11}, {0, -4, 0.11}, {2, 1, 0.12}, {-1, -4, 0.12}, {2, 1, 0.13}, {0, -5, 0.13}, {3, 0, 0.14}, {-2, -1, 0.14}, {3, 0, 0.15}, {-1, -8, 0.15}, {3, 0, 0.16}, {0, -9, 0.16}, {3, 1, 0.17}, {-2, -2, 0.17}, {3, 1, 0.18}, {-1, -9, 0.18}, {3, 1, 0.19}, {0, -10, 0.19}, {4, 0, 0.2}, {-2, -8, 0.2}, {4, 1, 0.21}, {-2, -9, 0.21}, {4, 2, 0.22}, {-3, -5, 0.22}, {6, 0, 0.23}, {-3, -9, 0.23}, {6, 1, 0.24}, {-3, -10, 0.24}, {7, 2, 0.25}, {-4, -1, 0.25}, {7, 3, 0.26}, {-5, -5, 0.26}, {8, 0, 0.27}, {-4, 0, 0.27}, {8, 1, 0.28}, {-4, -1, 0.28}}

enter image description here

$\endgroup$
  • $\begingroup$ This looks good, but can the plot be a 3D surface plot instead? $\endgroup$ – Betty Jan 29 at 1:24
  • $\begingroup$ Very nice thank you! $\endgroup$ – Betty Jan 29 at 1:54
0
$\begingroup$

If I understand correctly this is what you want. Not elegant though.

list = Flatten[ Outer[List, Range[0, 10], Range[0, 10], Range[-10, 0], Range[-10, 0]], 3];
m = Pick[list, #1^2 + #2^4 + #3^3 + #4 & @@@ list, 0]   

a = 0.01 Range[Length@m];
new = ArrayReshape[Transpose@Insert[Transpose@m, a, {{3}, {5}}], {2 Length@m, 3}]
ListPointPlot3D[new]

enter image description here

$\endgroup$
  • $\begingroup$ I do not think it is right really. I am not seeing how it uses this: The new 3 column matrix will take the value of (n,j,a) and put it into the matrix as the first row, and also (while keeping the same a value) will also add (k,l,a) as the second row and then move the next row of the original matrix and so the same process, with the counter a incremented. $\endgroup$ – Betty Jan 29 at 0:59
  • $\begingroup$ It appears to only get the first two values... $\endgroup$ – Betty Jan 29 at 1:01
  • $\begingroup$ Can you write 4 rows of desired result please? $\endgroup$ – OkkesDulgerci Jan 29 at 1:03
  • $\begingroup$ This is what the first few rows of the new matrix (which is plot from) should look like: {{0,0,1}, {0,0,1}, {0,1,2}, {-1,0,2}, {0,2,3}, {-2,-8,3}, ...} $\endgroup$ – Betty Jan 29 at 1:08
  • $\begingroup$ You could be right, I am checking the output of it... $\endgroup$ – Betty Jan 29 at 1:11
0
$\begingroup$

An alternative way to generate m (seems to be faster than so-far-posted alternatives):

ClearAll[l, n, k, j]
m2 = Values @ Solve[{Total[{l, n, k, j}^Range[4]] == 0,
       -10 <= l <= 0 && -10 <= k <= 0 && 0 <= n <= 10 && 0 <= j <= 10},
      {n, j, k, l}, Integers]

m2 == m

True

new2 = ArrayReshape[MapIndexed[Riffle[#, .01 #2[[1]], {3, -1, 3}] &, m2],
   {2 Length @ m2, 3}]; 

Alternatively,

new2b = MapIndexed[## & @@ Partition[Riffle[#, .01 #2[[1]], {3, -1, 3}], 3] &] @ m2;
new2b == new2

True

ListPlot3D[new2]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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