10
Mathematica has written nice Documentation about shortening the output and its options.
Summary
In general change $OutputSizeLimit to increase the limit Mathematica shorten the output.
For specific cases, use InputForm.
but be aware in both cases you will have performance penalties.
9
Is this what you want?
First we write all equations that do not depend on i or j. Then we make a list with all equations that depend on i and j. Then we join the 2 lists. For a small example we choose n=m=2:
n = 2; m = 2;
eq1={P[_, _] == 0,
P[x1, y1] == t,
P[x2, y2] == -t,
b[x, n] == 0,
a[-1, x] == 0,
a[m, x] == 0,
b[x, -1] == ...
8
Update: Animation of fire-spreading:
ClearAll[initState, vNNeighbors, step, iterationList]
initState[b_, i_, j_, pos_: Automatic] := ReplacePart[
RandomChoice[{1/(1 + b), b/(1 + b)} -> {0, 1}, {i, j}],
(pos /. Automatic -> RandomChoice[Tuples[{Range@i, Range@j}]]) -> 2]
vNNeighbors[dim_: {30, 30}] := AdjacencyList[NearestNeighborGraph@Tuples@...
8
The nice thing about Mathematica is that one can (almost) always go back to the definitions if in doubt. For evaluating non-principal roots, one can just go back to the Jordan decomposition of a matrix and change square root signs accordingly. To wit,
{sm, jm} = JordanDecomposition[{{17, -16}, {-8, 9}}];
Table[sm.DiagonalMatrix[d].Sqrt[jm].Inverse[sm], {d, ...
8
I found your simulation idea interesting, so I decided to look into the problem. What I found was that your implementation of nextState is mostly where the fault lies. It simply does not do what it name advertises — it does not compute the next state of the simulated world. Here is the code I used to develop a working simulation. I use a more modular ...
7
In Mathematica, it is best to use list processing instead of explicit looping over elements:
P = Exp[-d/Mean[Flatten[d]]];
where d is your dism11. Notice that the size of the matrix is implicit and we don't need to specify it: all operations are done over the entire matrix.
Even more Mathematica-like would be to use a user-specific normalization operation:
...
6
With vectorized ops
Clip[
mat,
{-2, 1},
{0, 0}
] // Unitize
{
{1, 0, 1, 0, 0},
{1, 1, 0, 1, 0},
{0, 1, 0, 0, 0},
{0, 1, 0, 0, 1},
{0, 0, 1, 0, 0}
}
or as a function
adjMat[mat_, lb_, ub_] :=
Clip[
mat,
{lb, ub},
{0, 0}
] // Unitize
6
ClearAll[vNNPos, vNNVals]
vNNPos[mat_, pos_] := Transpose[Mod[pos + {{1, 0, -1, 0}, {0, 1, 0, -1}},
Dimensions @ mat, 1]]
vNNVals[mat_, pos_] := Extract[vNNPos[mat, pos]] @ mat
Examples:
mat1 = {{3, 6, 9}, {12, 15, 18}, {21, 24, 27}};
mat2 = {{4, 8, 12, 16}, {20, 24, 28, 32}, {36, 40, 44, 48}, {52, 56, 60, 64}};
vNNVals[#, {2, 2}] & /@ {mat1, ...
6
a = mat[[All, {1}]]
{{Subscript[m, 1, 1]}, {Subscript[m, 2, 1]}, {Subscript[m, 3, 1]},
{Subscript[m, 4, 1]}, {Subscript[m, 5, 1]}}
MatrixForm @ a
6
Update: Shorter variations:
ClearAll[taken, takem, takek]
taken[condition_, n_] := Apply[Join] @*
MapIndexed[Thread[{#2[[1]],
Select[Function[x, condition @ #[[x]]]] @ TakeLargest[# -> "Index", n]}] &]
takem[condition_, m_] := Apply[Join] @*
MapIndexed[Thread[{#2[[1]],
Select[Function[x, condition @ #[[x]]]] @ Ordering[#, -m]}]...
5
TakeLargest is the function you are looking for. And then Select to get the numbers above 1/2:
m = {{1, 2, 3}, {3, -2, 1/3}};
t = TakeLargest[#, 2] & /@ m
sel=Select[# > 1/2 &] /@ t
(*{{3, 2}, {3}}*)
And then finally the positions. We first determine the position inside sel and then prepend the row number:
pos = Flatten /@ MapThread[Function[{x, ...
5
ClearAll[adjMat2]
adjMat2[matrix_, lB_, uB_] := Map[Boole[lB <= # <= uB] &, matrix, {-1}]
adjMat2[mat, -2, 1] // MatrixForm
ClearAll[adjMat3]
adjMat3[matrix_, lB_, uB_] := UnitStep[matrix - lB] UnitStep[uB - matrix]
adjMat3[mat, -2, 1] // MatrixForm
And, for fun,
PrecedesTilde = Boole @* Map[Thread] @* Thread @* LessEqual;
-2 ≾ mat ≾ 1
{{1, ...
5
Total[D[A, {{a, b, c, d, e}}], {2}]
{{2, 3, 4, 0, 0}, {0, 0, 0, 4, 0}, {1, 0, 0, 0, 1}}
Also
Total[Transpose[Coefficient[A, #] & /@ {a, b, c, d, e}], {3}]
{{2, 3, 4, 0, 0}, {0, 0, 0, 4, 0}, {1, 0, 0, 0, 1}}
and
Transpose@Total[Coefficient[A, #] & /@ {a, b, c, d, e}, {3}]
{{2, 3, 4, 0, 0}, {0, 0, 0, 4, 0}, {1, 0, 0, 0, 1}}
4
I would use UnitBox[] for this:
adjMat[mat_, lb_, ub_] := UnitBox[(2 mat - (lb + ub))/(2 (ub - lb))]
Using OP's example:
BlockRandom[SeedRandom[3];
With[{n = 5}, mat = RandomReal[{-4, 4}, {n, n}]];
adjMat[mat, -2, 1]]
{{1, 0, 1, 0, 0}, {1, 1, 0, 1, 0}, {0, 1, 0, 0, 0}, {0, 1, 0, 0, 1}, {0, 0, 1, 0, 0}}
In a lot of cases, one ...
4
I don't have answer for using Sigma notation but in case of finding pattern, converting existing matrix cells to some graphic maybe become helpful.
For example instead of using this form:
Use these:
,
For power of 2, results are:
,
Here is the interface of the code to play:
Code:
Manipulate[
Module[{vars, shapes},
vars = Table[
Subscript[w, i, ...
4
Adapting my answer to Imposing a Periodic Boundary Condition in Nearest Neighbour Search:
dist[a_, b_, d0_] := Norm@Mod[a - b, d0, -d0/2];
vNN[mat_, pts_] := Rest@Nearest[
Tuples@Range@Dimensions@mat -> Flatten@mat,
pts, {All, 1 + $MachineEpsilon},
DistanceFunction -> (dist[##, Dimensions@mat] &)];
Example:
mat = Table[10 i + j, {...
4
I wrote the following code using the method of finding where the horse can go in the chess board:
matrix = {{3, 6, 9}, {12, 15, 18}, {21, 24,
27}};
value = 15;(*The value of the central element*)
{m, n} = Dimensions[matrix];
Board = Table[0, {m + 1}, {n + 1}];
Moves0 = {{0, 1}, {0, -1}, {1, 0}, {-1, 0}};
Moves = Nest[
DeleteDuplicates[Flatten[Outer[...
answered Feb 6 at 19:11
A little mouse on the pampas
4,9042 gold badges9 silver badges27 bronze badges
3
Try Partition[mat[[All, 1]], 1].
3
In MMA the rule for the dot product is: the last index of the left hand side is contracted with the first index of the right hand side. Therefore, no need for row and column vectors.
Let's define some matrix a and a matrix b with orthogonal eigenvectors:
SeedRandom[1];
a = RandomReal[{-1, 1}, {3, 3}];
b = RandomReal[{-1, 1}, {3, 3}]; b = b + Transpose[b];
...
3
I am still not sure of what the OP wants, so here is my best guess at the intent:
tugrul[l : {__?VectorQ}] := With[{fl = Flatten[l]},
Normal[SparseArray[Thread[Flatten[MapIndexed[PadRight[Transpose[{#}],
{Automatic, 2}, #2] &,
TakeList[Range[Length[fl]], ...
3
You compute the same sum again and again. Instead precompute the sum
nmx=1250;
sum=Sum[dism11[[i, j]], {i, nmx}, {j,nmx}]/nmx^2;
Then evaluate your function
Table[Exp[- dism11[[n, m]]/sum], {n, nmx}, {m,nmx}]
Notice, this is translation of your formula, admittedly it is a bit ambiguous.
3
ClearAll[sA]
sA = 1 + SparseArray`SparseBlockMatrix @ MapIndexed[#2[[{1, 1}]]-> Transpose@{#}&] @ # &
Examples:
sA @ {{x, x, x}, {y, y, y}, {z, z, z}} // MatrixForm
sA @ {{x, x, x}, {y, y}, {z, z, z}} // MatrixForm
sA @ {{x1, x3}, {y1, y2}, {z1, z2, z3}} // MatrixForm
3
If the numbers are machine floats (complex ones), this will be fast:
data3 = Compile[
{{m1, _Complex, 2}, {m2, _Complex, 2}, {m3, _Complex, 2}},
m1 . m2 . m3,
RuntimeAttributes -> {Listable},
Parallelization -> True][mat1, mat2, mat3];
(If d1 is changed to d1 =300, then the OP's Table[] runs in 0.34 sec. and the above in 0.012 sec.)
3
Another way.
A = {{2 a, 3 b, 4 c}, {4 d}, {a, e}};
(* Variables[A]=={a,b,c,d,e} *)
A /. Thread[{a, b, c, d, e} -> IdentityMatrix[5]]
% // Map[Total]
{{{2, 0, 0, 0, 0}, {0, 3, 0, 0, 0}, {0, 0, 4, 0, 0}}, {{0, 0, 0, 4, 0}}, {{1, 0, 0, 0, 0}, {0, 0, 0, 0, 1}}}
{{2, 3, 4, 0, 0}, {0, 0, 0, 4, 0}, {1, 0, 0, 0, 1}}
3
My method of solving this in a manner, that does not require loads of computation and with an acceptable number of terms is using a little bit of tensor algebra. The fundamental steps are:
Express $R, R'$ as tensors
Calculate $R^T \otimes R'$
Expand the expression
Take the traces between the 2nd and 3rd vector of each 4-tensor
Calculate the vector $\omega$ ...
2
SeedRandom[6];
mat = RandomInteger[5, {7, 7}];
If row/column headers are identical and duplicate-free you can use ReplaceAll:
mat /. Thread[ mat[[1, {2, 3, 4}]]-> {k0, k1, k2}] // MatrixForm
In general,
mat2 = mat;
mat2[[1, {2, 3, 4}]] = mat2[[{2, 3, 4}, 1]] = {k0, k1, k2};
mat2 // MatrixForm
2
I recommend that you review the Liu criterion for the Hopf bifurcation, since it is the most suitable for detecting limit cycles in systems with three or more equations.
It is more convenient to write your system and the Jacobian matrix as follows:
f1 = (a - δ) k - (h (2 - u) - λ a1);
f2 = s (1 - s) - γ a k;
f3 = ((ρ + θ) - (a - δ)) λ + μ γ a;
f4 = (ρ + θ) μ ...
2
ClearAll[vNNeighbors, nextStep]
vNNeighbors[dim_] := AdjacencyList[NearestNeighborGraph @ Tuples @ Range @ dim, #]&
nextStep = MapAt[Min[2, 2 #] &, #, vNNeighbors[Dimensions @ #][Position[#, 2]]] &;
Example :
SeedRandom[1]
mat = RandomChoice[{0, 1, 2}, {10, 10}];
Row[MapThread[Labeled[#, #2, Top] &,
{MatrixForm /@ {mat /. 2 -> ...
2
ClearAll[aggregationSumWithHeaders]
aggregationSumWithHeaders = Fold[Module[{m = Transpose @ #, x = 1 + #2},
ReplacePart[m, Join[#[[1, 1]] ->
ReplacePart[Total[m[[#[[1]]]]], 1 -> #[[2]] - 1] & /@ x,
{Alternatives @@ Flatten[x[[All, 1, 2 ;;]]] -> Sequence[]}]]] &, #, {##2}] &;
labRow = Highlighted /@ {r1, r2};
...
2
With minimal change in your code:
nonzerorows = Flatten@Position[Rest /@ mat1, Except@{0 ..}, 1, Heads -> False]
{1, 2, 3, 5, 6, 7, 8, 9, 11, 12, 14}
nonzerocols = Flatten@Position[Rest /@ Transpose@mat1, Except@{0 ..}, 1,
Heads -> False]
{1, 2, 3, 5, 6, 7, 8, 9, 11, 12, 13, 15, 16, 17}
{zerorows, zerocols} = MapThread[Complement[Range@#@...
Only top voted, non community-wiki answers of a minimum length are eligible
