Tag Info

New answers tagged

0

Found the solution. The problem was somehow in the variables $\mu[i]$, so instead i used variables automatically generated variables Unique["\[Mu]"] which are unique and are numbered in way $\mu 12, \mu 35, ...$, so there is no problem with brackets. Also it was needed to call evaluate inside Do. PartialDerivative[tensor_] := Module[ {tens = tensor, ...


1

As others have pointed out, using MatrixForm when assigning values will result in something that's no longer treated as a matrix for many functions. You can see the difference directly with the following example. a = IdentityMatrix[2]; b = MatrixForm[a]; FullForm[a] (* List[List[1, 0], List[0, 1]] *) FullForm[b] (* MatrixForm[List[List[1, 0], List[0, 1]]] ...


1

Here is working code: s = DirectedGraph[RandomGraph[{10, 15}], "Acyclic"]; M = AdjacencyMatrix[s]; id = VertexInDegree[s]; od = VertexOutDegree[s]; wd = Log[1 - od/(25 + id)]; x = M.wd; Total@x What makes this work: Do not use MatrixForm in calculations, only for final display, since it wraps the expression and leads to a different internal ...


1

I'm a bit late coming in here with this, but let there be a different approach anyway. It so happens, that the permutation you describe is simply Cycles[{Range@20}]: Permute[Range@21,Cycles[{Range@20}]] (* {20, 1, 2, ..., 19, 21} *) With mat = Table[p[i,j],{i,0,20},{j,0,20}] You can try this: Transpose@ MapAt[Permute[#, Cycles[{Range@20}]] &, ...


3

Small example on 5x5 matrix: pp = Table[p[i, j], {i, 5}, {j, 5}] One way: pp[[#, #]] &@Insert[Rest@Range[5], 1, -2] Or another: pp[[;; 4, ;; 4]] = RotateLeft[pp[[;; 4, ;; 4]], {1, 1}];


1

Updating an existing matrix randomP = RandomInteger[{0, 9}, {5, 5}]; m = 2 ReplacePart[randomP, {{i_, j_} /; And[j == 2 i, j == m] -> p, {i_, j_} /; Or[j == 2 i - m, j == 0] -> q}]


4

m = 5; sa = SparseArray[{{i_, j_} /; j == Min[2 i, m] :> p, {i_, j_} /; j == 2 i - m :> q}, {m, m}] mat = Partition[Range[m^2], m]; sa2 = SparseArray[{{i_, j_} /; j == Min[2 i, m] :> p, {i_, j_} /; j == 2 i - m, 0] :> q, {i_, j_} :> mat[[i, j]]}, {m, m}]; Row[MatrixForm /@ {mat, sa2}]


1

There's no need to update values; you can use Table and create it in one pass. m = 4; Table[ Which[ j == 2 i && j == m, p, j == 2 i - m || j == 0, q, True, 0 ], {i, 10}, {j, 10}] // MatrixForm


1

This is essentially 2012rcampion's answer using Association for Basis. The definitions are: commutator[A_, B_] := A.B - B.A; multiplicationTable[basis_] := Outer[LinearSolve[Transpose[Flatten /@ Values[basis]], Flatten[commutator[#1, #2]]] &, Values@basis, Values@basis, 1].Keys[Basis] and the basis: Basis = Association["H" -> H, "E1" ...


2

(Note, it's best practice to use lowercase symbols to avoid conflicts with builtins.) multiplicationTable[basis_] := Outer[LinearSolve[Transpose[Flatten /@ basis], Flatten[commutator[##]]] &, basis, basis, 1] If we turn each matrix in the basis and the commutator into a vector, we can find a linear combination of basis elements that equal the ...


1

There may be a more efficient way to compute your MultiplicationTable itself but as a post-processing measure you could use something like this: rules = Join[ Thread[Basis -> {"H", "E1", "E2"}], Thread[-Basis -> {"-H", "-E1", "-E2"}], {m_ /; MatrixQ[m, # == 0 &] :> 0} ]; Replace[MultiplicationTable[Basis], rules, {2}] {{0, "-E2", ...


4

Inside Table, use If[j <= i, (* your expression *), 0] and change the iterators to go {i, 0, n-1}, {j, 0, n-1}. Also: I think your code would become more readable if you used {i, 1, n} and instead of i+1 everywhere just write i. You're not using i and j as indices into an array with Table and even if you were: Mathematica uses 1-based indexing.


2

n = 64; l = {n/32, 3*n/64, n/16, 3*n/32, n/8, 3*n/16, n/4, 3*n/8}; m = RandomReal[{0, 1}, {n, n}]; ListLinePlot[m[[l]], PlotLegends -> l]


1

If you know the kappa values ahead of time (eg. {1,2,3,4,5} ) and the dimension of your getA matrix is 3, for example kappa = Range[5]; n=3; then use a Pure Function and Map it to the List of kappa values getA[#] & /@ kappa getW[IdentityMatrix[3], getA[#], IdentityMatrix[3]] & /@ kappa { {{2, -1, -1}, {-1, 2, -1}, {-1, -1, 2}}, ...


3

Assuming ubpdqn's translation holds, this should be a much faster route to the same result: f = With[{n = Length@#}, ToeplitzMatrix[PadRight[Take[#, Floor[n/2]], n]]] &; Quick perf. comparo of Func, using Table, and f (on loungebook):


3

I post this in case it is of assistance: func[mat_] := Module[{n = Length[mat], tup}, tup = Cases[Tuples[Range[n], 2], {i_, j_} /; Abs[i - j] < (n - 1)/2]; SparseArray[ Thread[tup -> (mat[[Abs[#1 - #2] + 1]] & @@@ tup)], {n, n}]] This produces sparse array for an array input (in your case "inverse") and I have tried to to take account ...


3

I may have misunderstood but: f[a_, b_, n_] := Module[{lg = Length[a[[1]]], m1, m2, m3}, m1 = UpperTriangularize[ ConstantArray[w[b], {n + lg - 1, n + lg - 1}], lg]; m2 = LowerTriangularize[ ConstantArray[w[Transpose[b]], {n + lg - 1, n + lg - 1}], -lg]; m3 = DiagonalMatrix[ConstantArray[w[a], n]]; Plus @@ (ArrayFlatten /@ ({m1, m2, m3} ...


2

Update: ... because my matrix is (214x216) so it's impossible to assign all these values one by one. (* your 62 2X2 matrices av1 through av62 *) avmat = Array[Subscript[Row[{av, #}], ##2] &, {62, 2, 2}]; sa = SparseArray[{Band[{1, 1}] -> avmat, Band[{1, 3}] -> avmat}]; Dimensions@sa (* {124, 126} *) sa[[;; 20, ;; 20]] // MatrixForm (* ...


5

Another way: Clear[a, b, bt]; m = 2; n = 3; sp = Normal@SparseArray[{ {i_, j_} /; i == j :> a, {i_, j_} /; j > i :> b, {i_, j_} /; i > j :> bt}, {n*m, n*m}]; And replace the matrix with the numerical values a0 = RandomInteger[10, {m, m}]; b0 = RandomInteger[10, {m, m}]; bT = Transpose[b0]; sp /. {a -> a0, b -> b0, bt ...


5

You can try ArrayFlatten in such cases n = 3; A = Table[Subscript[a, i, j], {i, n}, {j, n}]; MatrixForm[A] B = Table[Subscript[b, i, j], {i, n}, {j, n}]; MatrixForm[B] BT = Transpose[B]; MatrixForm[BT] m = 2; M = Table[Piecewise[{{A, i == j}, {B, i < j}, {BT, i > j}}], {i, m}, {j,m}] // ArrayFlatten; MatrixForm[M]


3

Update: Using ToeplitzMatrix with ArrayFlatten: blockToeplitzF = ArrayFlatten[ ToeplitzMatrix[{Defer[#], ## & @@ ConstantArray[Transpose[Defer@#2], #3 - 1]}, {Defer[#], ## & @@ ConstantArray[Defer[#2], #3 - 1]}] /. Defer -> Identity] &; Example: ma = Array[Subscript[a, ##] &, {2, 2}]; mb = ...


1

Just for variety: t = Table[x, {x, 0.4, 0.8, 0.2}]; t2 = Table[x, {x, 0.4, 0.8, 0.2}]; res = {{{6.17743*10^-21, {w -> 0.339965, r -> 0.223645, p2 -> 1.33362, pw -> 1.72372}}, {1.90741*10^-25, {w -> 0.542223, r -> 0.371844, p2 -> 1.64076, pw -> 2.02472}}, {5.71176*10^-24, {w -> 0.643134, r -> 0.450457, ...


1

result = {{{6.17743*10^-21, {w -> 0.339965, r -> 0.223645, p2 -> 1.33362, pw -> 1.72372}}, {1.90741*10^-25, {w -> 0.542223, r -> 0.371844, p2 -> 1.64076, pw -> 2.02472}}, {5.71176*10^-24, {w -> 0.643134, r -> 0.450457, p2 -> 1.93086, pw -> 2.22915}}}, {{7.33982*10^-22, {w -> 0.311135, ...


3

Cleaning up the example in the comments: ClearAll[getF, a, b, csi, csiInv, valueF, TraceF] getF[csi_, a_, b_] := Module[{csiInv, valueF, TraceF}, csiInv = Inverse[csi]; valueF = csiInv.a.csiInv.b; TraceF = Tr[valueF]; Return[0.5*TraceF]] getF[IdentityMatrix[3], IdentityMatrix[3], IdentityMatrix[3]] (* 1.5 *) Or, better yet, getF2[csi_, ...


1

For highest efficiency, you should use the Listability of built-in functions in order to construct lists. Using this, you can do the following one-liner: a[n_, kappa_] := 2 Cos[(2 Pi/n) kappa Abs[Array[Subtract, {n, n}]]] a[5, 3] // MatrixForm $$\left(\begin{array}{ccccc} 2 & \frac{1}{2} \left(-1-\sqrt{5}\right) & \frac{1}{2} ...


0

As written your definition stops after the first "line" ending with ; You should use Module to localize your variables. Mathematica is case-sensitive and System Symbols will always start with capitals Function application uses square brackets: Abs[j - i] Indexing begins from one generally you should pass n as a parameter These issues corrected: getA[n_, ...


3

Do you mean this ? n = 5; getA[kappa_] := Table[2*Cos[(2*π/n)*(Abs @(i - j))*kappa], {i, 0, n-1}, {j, 0, n-1}] getA[3] //MatrixForm You may post the expected result from your Python code in order to make it easier finding a functional programming equivalent. EDIT, clean up: getA[n_,kappa_] := Table[2*Cos[(2*π/n)*(Abs @(i - j))*kappa], {i, 0, ...


0

I finally found a better way using NthSubset function available in Combinatoria package, here is the code, << Combinatorica`; Block[{$ContextPath}, Needs["Combinatorica`"]]; ClearAll[tsmat, k, L, s, i]; L = 4; tstmat = ...


1

Thanks all for replying and sharing comments for this post, considering all comments I came up with my own solution, see the code below, ClearAll[tsmat, lst, k, i, t, L, s]; L = 20; tstmat = RandomInteger[L, {L, L}]; lst = Range@L; Do[t = L!/(k! (L - k)!); Print[{k, t}]; s = Range[k]; Do[ s = ...


0

This is a quick kludge to do what you're after. You'd probably want to properly modularize it for actual code use (i.e., not carrying around globals) or better yet incorporate the NextKSubset and your code into a Nest, NestList, Fold or FoldList as appropriate: Block[{$ContextPath}, Needs["Combinatorica`"]]; fss[lst_, siz_] := (tmp1 = stop = Take[lst, ...


1

I would suggest to take out of Do any evaluation that need to be done only once and make sure to clear variables between successive runs. Clear[L, LL, k, config] L = 50; LL = L!; Do[t = LL/(k! (L - k)!); Print[{k, t}], {k, 1, L}] As an alternative for using Do you may consider {Range @ L, Table[k! (L - k)!, {k, 1, L}] // L!/# &} // Thread ...


6

matF = Tuples[#1, {##2}] &;; Examples matF[Range[0, 2], 2, 2] // Short (* {{{0,0},{0,0}},{{0,0},{0,1}},<<77>>,{{2,2},{2,1}},{{2,2},{2,2}}} *) MatrixForm /@ matF[Range[0, 2], 2, 2] matF[Range[3, 5], 2, 3] // Short (* {{{3,3,3},{3,3,3}},{{3,3,3},{3,3,4}},<<726>>,{{5,5,5},{5,5,5}}} *) Alternatively, you can use matF2 = ...


2

Use . for vector and matrix multiplication. The following works: Map[A.#1 &, b] Map[#1.A &, b] Your definition of A misses a comma by the way.


1

This is a generalized solution, should be pretty snappy: filler[mat_, blank_] := Module[ {cols = Flatten[Cases[#, {i_, _} :> i, 1, 1] & /@ Transpose@mat,1], f, tmp, x, b}, f[x_, blank] := x; f[_, b_] := b; tmp = FoldList[f, FoldList[f, #][[-1 ;; 1 ;; -1]]][[-1 ;; 1 ;; -1]] & /@ mat; MapIndexed[(tmp[[All, First@#2, 1]] ...


1

Let m be your ragged matrix. fill[row_, init_] := If[ MemberQ[First /@ row, First@init], row, Module[ {r, p}, r = Sort[Append[row, init]]; p = First@FirstPosition[r, init]; r /. x -> Last@r[[If[p == 1, Plus, Subtract][p, 1]]] ] ]; Fold[fill, #, {{a, x}, {b, x}, {c, x}, {d, x}}] & /@ m


4

Let l be your list. step1 = {a, b, c, d} /. ( Rule @@@ # & /@ l) /. a | b | c | d -> "x" {{"x", 1, 0, "x"}, {1, 2, 0, 9}, {3, 7, "x", 5}, {6, "x", "x", "x"}, {"x", "x", "x", 7}} fill[l_] := l //. { {x___, PatternSequence[c_?NumericQ, "x"], y___} :> {x, c, c, y}, {x___, PatternSequence["x", c_?NumericQ], y___} :> {x, c, c, y} } ...


0

Try Max[mat] and Position[mat, Max[mat]].


1

myLM2 = Nest[Insert[#, 0, {{1}, {1}, {3}, {3}}] & /@ Transpose[#] &, myM, 2]; myLM2 // MatrixForm


1

If the larger matrix consists of zeros (or other equal elements), one can use SparseArray function: myM = {{a1, a2, c1, c2}, {a2, a3, c2, c3}, {c1, c2, d1, d2}, {c2, c3, d2, d3}}; newM = SparseArray[{Band[{3, 3}] -> myM[[1 ;; 2, 1 ;; 2]], Band[{3, 7}] -> myM[[1 ;; 2, 3 ;; 4]], Band[{7, 3}] -> myM[[3 ;; 4, 1 ;; 2]], Band[{7, 7}] -> ...


3

I propose: quarter = Partition[#, Dimensions[#]/2] &; pad = PadLeft[#, Dimensions@#2, #2] &; matrixInsert[small_, large_] := ArrayFlatten[ pad @@ quarter /@ {small, large} ] Test: myM = {{a1, a2, c1, c2}, {a2, a3, c2, c3}, {c1, c2, d1, d2}, {c2, c3, d2, d3}}; myLM = Array[Plus, {8, 8}, {0, 1}]; matrixInsert[myM, myLM] // MatrixForm ...


1

First we'll define our matrices. Using your definitions we can make a matrix m: m = DWBCH[b1, b2, c2, 6] sA is defined like so: sA = {{b1, c2}, {c2, b2}} (not Sa, since Mathematica capitalizes all it's functions we should generally use lowercase variables to avoid collisions.) We can use Partition to split apart the matrix into sA-sized subarrays in ...


0

blocks[l_List, f_] := Map[f @@ # &, Module[{m = 0, F = Flatten[l], Q}, ReplacePart[Table[Q[i, j], {j, F}, {i, F}], Flatten[Tuples[#, 2] & /@ Map[++m &, l, {2}], 1] -> 0]], {2}]


2

blocks[l_List, f_] := Module[{m}, m = Transpose@Outer[f, #, #] &@Flatten[l]; (m[[#, #]] = 0) & /@ Span @@@ (# + {1, 0} & /@ Partition[{0}~Join~Accumulate[Length /@ l], 2, 1]); m ] blocks[{{a1, a2}, {b1, b2}, {c1, c2, c3}}, f] // MatrixForm blocks[{{a1, a2, a3}, {b1}, {c1, c2}}, f] // MatrixForm


4

A latin square generator(source): ls[perm_] := Module[{n = Length[perm], mat}, mat = Transpose[Join[{perm}, ConstantArray[1, {n - 1, n}]]]; (Mod[Accumulate@# - 1, n] 1 & /@ mat) + 1 ] Generating candidates: cand = ls /@ Permutations[Range[5]]; Criteria: crit[mt_] := And[mt[[1, 1]] < mt[[1, 2]] < mt[[1, 3]], mt[[1, 2]] == 2, mt[[2, ...


2

I first build the matrix with the "1 to 5 exactly once" condition. This is done row by row, each row from the list of permutations having no slot in common with the previous. Then check the given conditions: a = Table[0, {5}, {5}]; cond := a[[1, 2]] == 2 && a[[5, 1]] == 4 && a[[1, 1]] == 1 && a[[1, 1]] < a[[1, 2]] < ...


3

This was done in verion 10.02, but it should work in V 9 a = {{1, 2, 3, 4, 5}, {5, 3, 1, 2, 4}, {2, 4, 5, 3, 1}, {3, 1, 4, 5, 2}, {4, 5, 2, 1, 3}};


0

This seems to work. kmat = {{3 - 3 w, -4/3 + a + 2 w, 5/12 + b - w/2, 0}, {-4/3 + a + 2 w, -1 - 6 a - 3 x, 3/4 + 3 a - 3 b + 2 x - y/2, -2/3 - a - x/2 + z/2}, {5/12 + b - w/2, 3/4 + 3 a - 3 b + 2 x - y/2, -1/2 + 6 b, 19/12 - b + y/2 - 2 z}, {0, -2/3 - a - x/2 + z/2, 19/12 - b + y/2 - 2 z, -3 + 3 z}}; vec = Array[t, Length[kmat]]; ...


0

You can also define your own function if you want to apply it to multiple cases myFunc = ArrayFlatten@MapThread[List, {{K11e[#], K21e[#]}, {K12e[#], K22e[#]}}, 1] & myFunc@1 // MatrixForm


1

You should use ArrayFlatten to build block matrices, for example {{K11e[1], K12e[1]}, {K21e[1], K22e[1]}} // ArrayFlatten


3

The result is the same. V10 presentation is just went wrong somewhere, but it is the same value as v9. I copied v9 result to v10 and compared the real and the imaginary parts. Clear[t]; expr = {{0, 1/2, 0, 0, 1/2}, {1/2, 0, 1/2, 0, 0}, {0, 1/2, 0, 1/2, 0}, {0, 0, 1/2, 0, 1/2}, {1/2, 0, 0, 1/2, 0}}; v10 = MatrixExp[-I t expr]; v9 = (*copied from v9 ...



Top 50 recent answers are included