# Tag Info

17

We calculate the tangent vector of parametric curve {t^2,t} and the ArcLength from 0 to t0 so that we get the point {0,s[t0]} in y-axis. c[t_] = {t^2, t}; s[t_] = ArcLength[c[τ], {τ, 0, t}]; t0 = .6; Show[ParametricPlot[c[t], {t, 0, 1}, Mesh -> {{t0}}, MeshStyle -> {PointSize[Large], Red}, MeshFunctions -> (#3 &), MeshShading -> {Red, ...

14

Since $(\vec{e},\vec{q},\vec{r})$ is an orthonormal triad, and assuming it is right-handed, we should use the identities $\vec{e}=\vec{q}\times\vec{r}\,$; $\hspace{5mm}\vec{e}\cdot(\vec{q}\times\vec{r})=1$, etc. In particular we have that ve = Table[Indexed[e, n], {n, 3}]; vq = Table[Indexed[q, n], {n, 3}]; vr = Table[Indexed[r, n], {n, 3}]; ve.Cross[vr, ...

14

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, ...

14

Here's an approach using ArrayPad. It's not a lot faster, but doesn't need the dimension to be explicitly determined: ArraySpread2[a_] := ArrayPad[a, {{1, -1}, 0}] + ArrayPad[a, {{-1, 1}, 0}] + ArrayPad[a, {0, {1, -1}}] + ArrayPad[a, {0, {-1, 1}}] an = RandomReal[{0., 1.}, {201, 201}]; RepeatedTiming[...

13

Update 2020-01-07 At this point there is a Wolfram Function Repository (WFR) RandomScribble. Here is matrix representation with "midriff" random scribbles based WFR's RandomScribble: matrix = {{1, -1, 1, 1, -1}, {-1, -1, -1, 1, 1}, {1, 1, 1, -1, 1}, {-1, 1, -1, 1, -1}, {1, 1, 1, -1, -1}}; SeedRandom; Magnify[Grid[ ...

13

Assuming you mean roll as in the way a circle rolls across the floor, you need a unit speed arc-length parameterization of the curve $(t^2,t)$. Why? Becuase the key behavior of rolling is no slippage. If a point $(t_0^2,t_0)$ is tangent to the $y$-axis at $(0,l(t_0))$, then the arc length from $(0,0)$ to $(t_0^2,t_0)$ along the curve should be equal to $l(... 12 As Dot is a special case of Inner with Dot[##] == Inner[Times,##, Plus], we can just tell Mathematica to use NonCommutativeMultiply in the first slot to take the place of regular multiplication. ncdot[ten1_, ten2_] := Inner[NonCommutativeMultiply, ten1, ten2, Plus] ncdot[{x, y}, {u, v}] ncdot[{{x, y}, {z, w}}, {{a, b}, {c, d}}] Tr@% x ** u + y ** v {{x ** ... 11 RandomVariate[CircularRealMatrixDistribution[n]] should do the trick for$n \times n$matrices. Very obscure name IMHO. 10 A = Array[a, {10, 10}]; i = 4; b = ReplacePart[A, {i, _} -> 0]; b // MatrixForm You can also do c = A; c[[i, ;;]] = 0; d = MapAt[0 & /@ # &, A, {i}]; e = MapAt[0 &, A, {i, All}]; b == c == d == e True 10 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] == ... 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.

10

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$ ...

10

Your question seems to miss some points in What topics can I ask about here?. This answer is for helping you to write the code by yourself and if you encounter any problem, feel free to post another question. In Mathematica use: (* comment *) syntax for commenting your code LowerTriangularize function for accessing the lower triangular part of a matrix ...

10

Edit 03 Here's a function to wrap all this up and answer the latest questions in the comments. Some utility functions: makePeriodicLattice2D[pts_, {sizeH_, sizeV_}] := With[{d = ArrayDepth[pts]}, Transpose[ MapThread[ Mod[#1, #2, -#2/2] &, {Transpose[pts, RotateLeft[Range[d]]], {sizeH, sizeV}}], RotateRight[Range[d]]]] ...

9

Using an actual SparseArray and machine precision this evaluates almost immediately with negligible memory footprint. s = 1; n = 10; b1 = N@Table[s - n, {n, 0, 2 s}]; σx = SparseArray@DiagonalMatrix[b1]; σI = IdentityMatrix[2 s + 1, SparseArray, WorkingPrecision -> MachinePrecision]; σxx[j_] := KroneckerProduct[## & @@ ConstantArray[σI, j - 1], σx, ## ...

9

A slick way is to compute the Cholesky decomposition of the starting matrix, and then impose conditions on the diagonal of the resulting upper triangular matrix: Diagonal[CholeskyDecomposition[{{a, f, g}, {f, b, h}, {g, h, c}}]]^2 /. Conjugate -> Identity {a, b - f^2/a, c - g^2/a - (-((f g)/a) + h)^2/(b - f^2/a)} Reduce[Thread[% > 0], {a, b, c, f, ...

9

rm = RotationMatrix[θ, {0, 0, 1}]; rm2 = RotationMatrix[I θ, {0, 0, 1}]; 1. ArrayFlatten ArrayFlatten[{{1, 0}, {0, rm}}] // MatrixForm ArrayFlatten[{{rm2, 0}, {0, 1}}] // MatrixForm 2. PadRight + PadLeft PadRight[{{1}}, {4, 4}] + PadLeft[rm, {4, 4}] // MatrixForm PadLeft[{{1}}, {4, 4}] + PadRight[rm2, {4, 4}] // MatrixForm You can also do MatrixForm /@ ...

9

The bottleneck is in evaluating u. Compare: Map[Eigenvalues[u[#]] &, N@w]; // AbsoluteTiming (* Out= {11.4827, Null} *) Map[u, N@w]; // AbsoluteTiming (* Out= {9.57558, Null} *) Compiling u can remove that bottleneck. u2 = Compile[{{x, _Real}}, Evaluate[u[x]]]; Map[u2, N@w]; // AbsoluteTiming Map[Eigenvalues[u2[#]] &, N@w]; // ...

9

The 0. does not disappear from an expression such as 0. + 1.5 x because it is an inexact zero. Anything in Mathematica containing a decimal point is considered "inexact", meaning that it is interpreted as "known only up to a certain number of digits", thus potentially not precisely zero. See here for details: http://reference.wolfram.com/...

8

nondiags = {{0, 0, -1}, {0, 0, -1}, {-1, -1, 0}}; diags = {5, 4, 6}; DiagonalMatrix[diags] + nondiags

8

The issue here is that AdjacencyMatrix returns a non-real valued matrix g = GridGraph[{20, 20}]; amg = AdjacencyMatrix[A1]; meaning the elements are all integers: In[]:= Map[Head,Normal@amg,{2}]//Flatten//Union Out[]= {Integer} and the kernel is trying to find an answer in terms of integers, rational numbers, and roots. Numericizing before computation ...

8

Perhaps either of these: Drop[A, {#}, {#}]&@ RandomInteger[{1, Length@A}] With[{i = RandomInteger[{1, Length@A}]}, Drop[A, {i}, {i}]]

8

ClearAll[r1, t, u, a, b, c, abc] r1 = {Cos[t], Sin[t]}; a = {r1, Cross[r1]}; b = IdentityMatrix; c = a /. t -> u; abc = SparseArray[Band[{1, 1}] -> {a, b, c}]; abc // MatrixForm // TeXForm \$\left( \begin{array}{cccccc} \cos (t) & \sin (t) & 0 & 0 & 0 & 0 \\ -\sin (t) & \cos (t) & 0 & 0 & 0 & 0 \\ 0 &...

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

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 ...

8

There seems to be a pattern between the size of input matrix (m) and the sum of elements in MatrixPower[m, 12] that can be discovered cheaply using FindSequenceFunction on a short list of small sizes: (list = With[{mm = ArrayReshape[Range[#^2], {#, #}]}, Total[MatrixPower[mm, 12], 2]] & /@ Range;) // RepeatedTiming // First 0.11 ClearAll[...

8

mA = {{-4, 1, 5, 0}, {1, -1, 1, 2}, {-1, 0, 1, 0}, {1, 17, 0, 1}}; mB = {{-4, 7, 10}, {2, -1, 1}, {1, 0, 1}}; mC = {{1, 2, 2}, {0, -1, 0}, {1, 0, 1}, {0, 0, 0}}; mD = {{1, 2, 3}, {0, 0, 0}, {1, 0, 2}, {0, 0, -1}}; mX = Inverse[mA] . (mD - mC) . Inverse[mB] (* {{-4/7, -141/35, 202/35}, {0, 1/35, -2/35}, {-3/7, -106/35, 152/35}, {...

8

mattest = SparseArray@{{1, 2} -> 1, {4, 2} -> 2} MatrixForm@mattest If you just hate SparseArray without any reasonable reason, here's another possibility: tomatrix[a_] := Replace[DownValues@a, (_[a[i__]] :> v_) :> {i} -> v, {1}] // SparseArray // Normal mattest[1, 2] = 1; mattest[4, 2] = 2; normalmat = tomatrix@mattest (* {{0, 1}, {0, ...

8

Just cleaning up your code a little: matrix[p_, q_] := SparseArray[{Band[{1, 1}] -> 2*Cos[2π*p*Range[q]/q], Band[{1, 2}] -> 1, Band[{2, 1}] -> 1}] matrix[σ_] := matrix[Numerator[σ], Denominator[σ]] fracs[qmax_] := Table[p/q, {q, 1, qmax}, {p, 0, q}] // Flatten // DeleteDuplicates ...

8

We can add a second argument to TorusGraph to specify the number of segments between nodes with integer coordinates in each dimension: ClearAll[torusGraph] torusGraph[dims : {__Integer}, segs: {__Integer} : {1, 1}, opts : OptionsPattern[Graph]] := Module[{m = Length[dims], tg}, tg = Graph[Flatten[Array[Table[Rule @@@ Partition[Function[x, Mod[{##}...

Only top voted, non community-wiki answers of a minimum length are eligible