We’re rewarding the question askers & reputations are being recalculated! Read more.

# Tag Info

4

There are plenty of optimization opportunities. For starters, here a way to compute all relevant values of V to 12 digits accuracy in one go -- and 100 times faster: c = 40.; L = 200; a = Sort@RandomReal[{-\[Pi], \[Pi]}, L]; b = Sort@RandomReal[{-\[Pi], \[Pi]}, L]; Vvector = Table[V[j, c, {a, b}], {j, 1, L}]; // AbsoluteTiming // First Vvectorfast = With[{...

7

ClearAll[f] f[x0_, y0_] := D[{Sqrt[x^2 + y^2], ArcTan[x, y]}, {{x, y}}] /. {x -> x0, y -> y0} f[0.3, 0.5] // MatrixForm I would caution you against using MatrixForm in the definition, as that would leave you with results that cannot be easily used in further computation.

1

You can write something like f[{r_, θ_}] := Module[{M = D[{Sqrt[x^2 + y^2], ArcTan[x, y]}, {{x, y}}]}, Block[{x = r Cos[θ], y = r Sin[θ]}, M]] I wouldn't be surprised if this has a slightly simpler formulation. The symbolic result agrees with what I expect: Assuming[r > 0, Simplify[f[{r, θ}]]] (* {{Cos[θ], Sin[θ]}, {-(Sin[θ]/r), Cos[θ]/r}} *) ...

3

Clear["Global`*"] Format[a[n__]] := Subscript[a, n]; Format[x[n_]] := Subscript[x, n]; Format[c[n_]] := Subscript[c, n]; coef[n_Integer?Positive] := Array[a, {n, n}]; var[n_Integer?Positive] := Array[x, n]; val[n_Integer?Positive] := Array[c, n]; eqns[n_Integer?Positive] := Thread[coef[n].var[n] == val[n]]; For example, with n == 3 n = 3; eqns[n] // ...

4

MapThread[WeightedAdjacencyMatrix[Graph[Range@10, #, EdgeWeight -> #2]] &, {list1, list2}] TeXForm[Row[MatrixForm /@ %]] \small\left( \begin{array}{cccccccccc} 0 & 0 & 0 & 0.1 & 0 & 0 & 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 & 0 \\ 0 & 0 & 0 & 0 &... 3 Ok, here we go. Let's start with a relatively simple system: a = 20; b = 4; Also, my equations above are slightly off. The first transformation should have been: AB[m,n] + B --> AB[m-1,n+(b-1)] which changes the differential equations somewhat. First, let's put in our definitions for the rate constants. k1[m_, n_] = (m/a) k3 k2[m_, n_] = k4 n m/(n m +... 1 KalmanEstiamtor only works with numeric values, because the underlying RiccatiSolve is a numeric solver. Regarding computing the covariance matrix from the power spectrum matrix or vice versa, they are the same because it is assumed to be white noise. See eqs (10.27), (10.28) and (10.29) on pp.386-387 of Friedland. Quoting below: White noise is simply a ... 1 From the answers above I learned that, unlike sympy, Mathematica does not keep track of assumptions and some functions simply ignore assumptions even if given explicitly. Thus I thought some more about how to make a symbol n∈ℝ in the first place and that's surprisingly simple. Just define n as the real part of some new and otherwise unused symbol nComplex: ... 4 SeedRandom[1] mt = RandomInteger[1, {20, 50}]; gg = GridGraph[Dimensions[mt]]; An alternative approach to align the GridGraph and MatrixPlot outputs is to use the options DataRange and DataReversed with MatrixPlot: Show[MatrixPlot[mt, DataReversed -> True, DataRange -> Thread[{1, Reverse@ Dimensions[mt]}]], gg] We can remove from gg the vertices ... 4 The essential problem is that simplifiedmat is {{n, a}, {Conjugate[a], n}} Note that this expression contains no hint about the nature of n. You told Simplify that n was an integer, so it naturally simplified Re[n] to n. One way to fix this is to restore the Re after simplifying: HermitianMatrixQ[simplifiedmat /. n -> Re[n]] (* True *) 6 expr = Exp[I*2*π*Re[n]]; mat = {{Re[n], a*expr}, {Conjugate[a]*Conjugate[expr], Re[n]}}; HermitianMatrixQ[mat] (* True *) simplifiedmat = Assuming[n ∈ Integers, Simplify[mat]]; Use the SameTest option to HermitianMatrixQ to make use of Assumptions HermitianMatrixQ[simplifiedmat, SameTest -> (Simplify[#1 - #2 == 0, Element[n, Integers]] &)] (* ... 8 There are two issues here. The first is that HermitianMatrixQ (in line with other Q functions) only applies quick checks that the matrix is Hermitian. It is acceptable for it to fail to recognise a matrix as Hermitian, but it must not say that a matrix is Hermitian when it is not. Secondly, when you apply the test, your assumption for n is no longer ... 2 dims = {4, 4}; (* e.g. 16 nodes *) grid = GridGraph[dims]; xyNodes = AbsoluteOptions[grid, VertexCoordinates][[1, 2]] - 0.5 g = GridGraph[dims, VertexCoordinates -> xyNodes, EdgeStyle -> Gray]; info = RandomChoice[{0, 1}, dims]; (* fake data for bipartite graph *) Show[{MatrixPlot[info], g}] For more illustrative fake data and deleted edges: ... 0 You could check if the Eigenvalues of both matrices are the same, and if both matrices are Diagonalizable . To do so you could create two functions that does this and combine them like this: l[x_, y_] := (If[Length[Eigenvalues[x]] == Length[Eigenvalues[y]], If[Sort[Eigenvalues[x]] == Sort[Eigenvalues[y]], True, False], False]); r[x_, y_] := (If[Det[... 3 Here is an example of what I had suggested in a comment. We will work with a 100x100 symmetric sparse matrix, and make it diagonally dominant (or close enough to that) so that all eigenvalues are positive. rng = 100; nonzerocount = 3*rng; SeedRandom[1111] mat0 = SparseArray[ Thread[RandomInteger[{1, rng}, {nonzerocount, 2}] -> RandomReal[{0, 1},... 1 Another possibility is to use MatrixRank of pairs of flattened matrices. For example: scaledQ[m1_, m2_] := MatrixRank[{Flatten @ m1, Flatten @ m2}] == 1 An example matrix: SeedRandom[1] m = RandomInteger[10, {3,3}] {{1, 4, 0}, {7, 0, 0}, {8, 6, 0}} Check trivial example: scaledQ[m, Exp[Pi I/3] m] True A more complicated example: SeedRandom[1] ... 4 This is what I get with Mathematica: logdet[x_, prec_] := - Log @ Det @ N[Array[BesselI[#1-#2, x]&, {100, 100}], prec] Presumably due to subtractive cancellation, a high precision is needed to get an accurate result, so: r500 = logdet[200, 500] -9033.801557200126884639983232381821638986208454697027595029420498495859730519\ ... 6 To generate the correlated pairs you could use the BinormalDistribution function: dist = BinormalDistribution[{0, 0}, {1/Sqrt[n], 1/Sqrt[n]}, τ]; Expectation[n x1 x2 , {x1, x2} \[Distributed] dist] (* τ *) To put this all together to obtain a realization of the random matrix\boldsymbol{A}$, the following brute force approach could work. (Only$n(n+1)/2$... 6 To generate two Gaussian random numbers that both have zero mean and unit variance, and that have a covariance of$\tau\in[-1,1]$, you can do twoCorrelatedGaussianRandoms[τ_] := ({{Sqrt[1+τ]+Sqrt[1-τ], Sqrt[1+τ]-Sqrt[1-τ]}, {Sqrt[1+τ]-Sqrt[1-τ], Sqrt[1+τ]+Sqrt[1-τ]}}/2) . RandomVariate[NormalDistribution[], 2] Try it out by generating a million pairs ... 1 @Artes is right, but I have to mention also that if contracting with the Levi-Civitta tensor is something you are going to do many times, it is way more computationally efficient to use the direct summation over the coordinates. Also, it is usefull to calculate the tensor once and then use it without calling the LeveCivittaTensor[3] function: a = RandomReal[... 3 Probably not what you are asking for but RowReduce performs the Gauss-Jordan elimination. A = RandomReal[{-1, 1}, {1, 1} 3]; Ainv = RowReduce[ Join[A, IdentityMatrix[Length[A]], 2] ][[All, Length[A] + 1 ;;]]; Test: Max[Abs[Ainv - Inverse[A]]] 1.11022*10^-16 4 We can also use SparseArrays. m1 = {{{{1, 2}, {3, 4}}, {{5, 6}, {7, 8}}}, {{{9, 10}, {11, 12}}, {{13, 14}, {15, 16}}}}; v1 = {{{11, 3}, {7, 5}}, {{13, 97}, {3, 16}}}; res = {{{{11, 3}, {7, 5}}, {{5, 6}, {7, 8}}}, {{{9, 10}, {11, 12}}, {{13, 97}, {3, 16}}}}; blockmatrixreplace[mat_, rep_] := Block[ { diagonalmatrixindices = Flatten[Table[{i, i, j, k}, ##]... 5 Let's generate sample data: array = ConstantArray[ RandomInteger[{0, 10}, {100, 100}], {100, 100}]; replace = ConstantArray[RandomInteger[{0, 10}, {100, 100}], 100]; array1 = array2 = array3 = array4 = array; and apply different methods: RepeatedTiming[ Table[array1[[i, i]] = replace[[i]], {i, Length@replace}];] {0.0064, Null} RepeatedTiming[(... 3 As yarchik says in the comments, you can use the "Arnoldi" method. However, the "Arnoldi" method doesn't work well for finding the smallest real eigenvalues (perhaps a bug), but you can instead find the largest real eigenvalues after changing the sign of the matrix. Here is an example Hermitian matrix (so eigenvalues are real): SeedRandom[1]; m = (... 5 Here is another solution that performs similarly to Total: v = ConstantArray[1, 10000]; m = RandomReal[1, {10000, 10000}]; v.m.v // AbsoluteTiming {0.040816, 4.99968*10^7} Total[m, 2] // AbsoluteTiming {0.041774, 4.99968*10^7} The reason that these solutions are fast is that they use vectorization. Using Compile is not quite as fast, especially not ... 7 You can use Total. Here's a matrix of the given size: m = RandomReal[1, {10000, 10000}]; And here's the output of Total: Total[m, 2] // AbsoluteTiming {0.041005, 4.99984*10^7} 3 You can use Array or SparseArray to define a function that generates an array with desired dimensions and desired entries below and above the main diagonal: mf1[dims_, a_, b_: 0] := Array[If[# >= #2, a, b] &, dims]; mf1[{13, 13}, "✓", "x"] // Grid mf2[dims_, a_, b_: 0] := SparseArray[{i_, j_} /; i >= j -> a, dims, b] mf2[{13, 13}, "✓", "x"] /... 2 For 1. matrix1[13] /. 0 -> "x" For 2. colors = Table[{i, 2} -> If[matrix1[13][[i, 2]] == "\[Checkmark]", Pink, None], {i, 13}]; Grid[matrix1[13] /. 0 -> "x", Background -> {None, None, Flatten@colors}] 2 An alternative to Henrik solution: Generate data: dim = 50; sparse = Table[ KroneckerProduct[RandomReal[{-10, 10}, {dim, dim}], IdentityMatrix[dim, SparseArray]], {ii, 1, 5}, {jj, 1, 5}]; My method: n = 3; AbsoluteTiming[ sp = SparseArray[ Drop[ArrayRules[IdentityMatrix[dim^2, SparseArray]], {1, -n, n}], {dim^2, dim^2}]; sparse1 = sp.# ... 4 Besides this, how could I impose that$F$is a symmetric integer-random matrix? Here is one way to do it. SeedRandom@2 n = 5; H = PadRight[ TakeList[RandomInteger[{1, 9}, n^2], Range[n - 1]], {n - 1, n - 1}]; F = H + Transpose@H - DiagonalMatrix@Diagonal@H$\left( \begin{array}{cccc} 9 & 5 & 5 & 1 \\ 5 & 6 & 8 & 2 \\ 5 ...

7

The following did the first trick 40 times faster (on my machine): sparse[[All, All, 1 ;; -n - 1 ;; n]] *= 0. One of the major problems here is that ConstantArray[0., Dimensions[b[[All, All, 1 ;; -n - 1 ;; n]]]] is a dense array although it conveys basically no information.

7

Something like this? ArrayReshape[{{A, B}, {B, F}}, {n, n}] MatrixForm@% {{9, 6, 9, 3, 6}, {6, 9, 3, 6, 7}, {3, 8, 2, 8, 2}, {5, 5, 2, 8, 8}, {3, 1, 9, 2, 1}} \$\left( \begin{array}{ccccc} 9 & 6 & 9 & 3 & 6 \\ 6 & 9 & 3 & 6 & 7 \\ 3 & 8 & 2 & 8 & 2 \\ 5 & 5 & 2 & 8 & 8 \\ 3 &...

7

SeedRandom[1] n = 5; A = RandomInteger[{1, 9}, {1, 1}]; B = RandomInteger[{1, 9}, {1, n - 1}]; F = RandomInteger[{1, 9}, {n - 1, n - 1}]; {A, B, F} {{{2}}, {{5, 1, 8, 1}}, {{1, 9, 7, 1}, {5, 2, 9, 6}, {2, 2, 2, 4}, {3, 2, 7, 1}} ArrayFlatten You can use Transpose@B in the second block and ArrayFlatten: c = ArrayFlatten[{{A, B}, {Transpose @ B, F}}]...

0

Another way is using the WFR function SelectPermutations: list = {{4, 4, 4, 4}, {-4, 4, 4, 4}, {4, -4, 4, 4}, {4, 4, -4, 4}, {4, 4, 4, -4}, {-4, -4, 4, 4}, {-4, -4, -4, 4}, {-4, -4, -4, -4}}; out = ResourceFunction["SelectPermutations"][list, {4}, Det[#] =!= 0 && AllTrue[#, MemberQ[4]] && AllTrue[Plus @@@ Subsets[#, {2}], ...

0

Edit2 We can use @SHuisman condition checker list = {{4, 4, 4, 4}, {-4, 4, 4, 4}, {4, -4, 4, 4}, {4, 4, -4, 4}, {4, 4, 4, -4}, {-4, -4, 4, 4}, {-4, -4, -4, 4}, {-4, -4, -4, -4}}; mat = Transpose /@ Permutations[list, {4}]; result = Select[mat, Det@# != 0 && AllTrue[#, MemberQ[4]] && AllTrue[Plus @@@ Subsets[#, {2}], MemberQ[...

0

rows = {{4, 4, 4, 4}, {-4, 4, 4, 4}, {4, -4, 4, 4}, {4, 4, -4, 4}, {4, 4, 4, -4}, {-4, -4, 4, 4}, {4, 4, 4, -4}}; det = Select[Tuples[rows, 4], Det@# =!= 0 &]; result = Select[det, MemberQ[MemberQ[#, 8] & /@ (Total /@ Tuples[#, 2]), True] &]; Length /@ {det, result} {528, 528}

Top 50 recent answers are included