Tag Info

New answers tagged

4

This gives a slight speed up (~40%) for me: stepcp = Compile[{{m, _Complex, 2}, {u, _Complex, 2}, {n, _Integer}, {l, _Real}}, Block[{ m2 = ConjugateTranspose@m, x = u, ut = Flatten@Transpose@u}, Join[{1.0}, Table[x = m.x.m2; Flatten[x].ut, {i, n - 1}]/(2 l)]]] I replaced the NestList with a more procedural approach, calculating the trace of the ...


2

As pointed out by MarcoB in the comments, one shouldn't use MatrixForm for calculations (check the question he referred to). As he suggested, this is the real reason Inverse doesn't evaluate. Also, in this case the matrix m is singular. You can easily check that by MatrixRank[m] which yields 2, and also by checking Det[m]==0. How to proceed with m being ...


1

In Mathematica Abs is a Listable function which means that it may be applied to a scalar, matrix, or tensor directly: m1 = {{1, -8, 3}, {-1, -7, 9}, {-1, 0, -9}}; Abs[m1] {{1, 8, 3}, {1, 7, 9}, {1, 0, 9}} UpperTriangularize works like this: UpperTriangularize[{{1, 2, 3}, {4, 5, 6}, {7, 8, 9}}] {{1, 2, 3}, {0, 5, 6}, {0, 0, 9}} Matrix product ...


2

Sorry, I don't know. Have you tried compiling to C? One point: you should define stepcp with Set (=) rather than SetDelayed (:=) or you recompile it every time you use it. SparseArray is a specialized format of the high-level Mathematica language. It is not supported by compilation. Many operations are optimized to work on sparse arrays, saving ...


1

Would something like this work for you? generatematrix := Module[ {rows, columns, function, result}, rows = Input["Enter the number of rows"]; columns = Input["Enter the number of column"]; function = Input["Enter the function"]; result = Array[function, {rows, columns}]; MatrixForm@ result ] Every time you evaluate generatematrix, ...


0

Another way is: Infinity*IdentityMatrix[5] //. Indeterminate -> q // Quiet This creates a 5 by 5 matrix with all values equal to q except along the diagonal where the value is infinity.


3

E.g.: SparseArray[Band[{1, 1}] -> Infinity, {3, 3}, 2] // Normal Creates a 3×3 with 2 everywhere but the diagonal of infinity. Drop the // Normal if you want to keep it sparse...


2

As @kattern pointed out, MatrixForm will pretty print your lists to look like matrices. {{0}, {1}, {0}, {-1}} // MatrixForm A word of caution, however: MatrixForm can get in the way of your calculations if you are not careful. See this question and the related answers: Why does MatrixForm affect calculations?. For instance, you could get bitten by ...


7

Add this to your notebook or init file $PrePrint = If[MatrixQ[#], MatrixForm[#], #] &; Then all matrices will automatically display as MatrixForm and If you want to format lists as column vectors also, try $PrePrint = Which[MatrixQ[#], MatrixForm[#], VectorQ[#], ColumnForm[#], True, #] &; Now also


3

I like the existing answers but I cannot resist posting my own formulation. I shall make use of the new-in-10.1 CirclePoints though I shall also provide an alternative without it. First Rules that specify the thickness of each radial line, counterclockwise from 3 o'clock: rls = {"a1" -> {3, 3, 3, 3}, "b1" -> {1, 3, 1, 3}, "c1" -> {1, 1, 3, 3}, ...


5

You could define $a_1,a_2$,.. as graphic primitives (Line) and use Translate: a1 = {Thickness[.01], Line[{{{0, 0}, {1, 0}}, {{1/2, -1/2}, {1/2, 1/2}}}]}; a2 = {Line[{{{0, 0}, {1, 0}}, {{1/2, -1/2}, {1/2, 1/2}}}]}; b1 = {Line[{{0, 0}, {1, 0}}], Thickness[.01], Line[{{1/2, -1/2}, {1/2, 1/2}}]}; b2 = {Line[{{1/2, -1/2}, {1/2, 1/2}}], Thickness[.01], Line[{{0, ...


4

One way of doing that is create an image for each element and then use GraphicsGrid With the definition about line of @halmir a1 = {Thickness[.03], Line[{{{0, 0}, {1, 0}}, {{1/2, -1/2}, {1/2, 1/2}}}]}; a2 = {Line[{{{0, 0}, {1, 0}}, {{1/2, -1/2}, {1/2, 1/2}}}]}; b1 = {Line[{{0, 0}, {1, 0}}], Thickness[.03], Line[{{1/2, -1/2}, {1/2, 1/2}}]}; b2 = ...


0

You may need to use the "list" data structure in mathematica. Say, $\Sigma$ is a two by two matrix. In Mathematica, you just input Sigma = {{x+y, m+n}, {x+y-w, m-n.l}} Similarly b={u,v} Then, $b\Sigma b^T$ is just b.Sigma.Transpose[b,{1}] Hope it works for you.


1

Not an answer but too long for comment: If I modify slightly your input and choose 'n=2` n = 2; Solve[Table[{Subscript[β, 1] (1 - Subscript[a, i] - Subscript[b, i] - Subscript[c, i]) Sum[ Subscript[A, i, j] (Subscript[a, j] + Subscript[c, j]), {j, 1, n}] - Subscript[δ, 1] Subscript[a, i] + Subscript[δ, 2] ...


2

A simple solution would be using Coefficient p = Sum[c[i, j] x^i Exp[I j x], {i, 0, 3}, {j, 0, 3}]; Table[a[i, j] = Coefficient[Coefficient[p, x, i], Exp[I x], j] , {j, 0, 3}, {i, 0, 3}]; MatrixForm[%] $ \left( \begin{array}{cccc} c(0,0) & c(0,1) & c(0,2) & c(0,3) \\ c(1,0) & c(1,1) & c(1,2) & c(1,3) \\ c(2,0) & ...


10

It's an issue of growth of term size in this example. If you do the straight iteration then at each step the matrix elements roughly quadruple in size (because each time you multiply every element by a variable, and sum four such products per matrix entry). We confirm this below on an example of half the size. tab = Partition[#, 4] & /@ ...


2

I'll illustrate with a simple example. mat = {{2, 1}, {1, 3.}}; ch = CholeskyDecomposition[mat] (* Out[145]= {{1.41421356237, 0.707106781187}, {0., 1.58113883008}} *) Pull out the diagonal. Use it to modify and get a triangular matrix with ones on the diagonal. diag = Diagonal[ch] (* Out[148]= {1.41421356237, 1.58113883008} *) modch = ch*1/diag (* ...


8

For a wide variety of applications, the cost of doing a scalar product is rarely linear in the complexity of the multiplicands. Furthermore, the complexity of a product is usually larger than the complexity of the inputs. This can range from the simple case of multiplying two $n$-bit integers to get a $2n$-bit sum, to the horrible case of multiplying two ...


16

Here's an edited version of my answer to a related question (elsewhere). Since your central question was about speed (or time complexity), you might wish to know an important result from elementary theory of algorithms and computational complexity, which is that the time and space complexity of matrix multiplication depends upon the order of such ...


6

Based on the definition from the Wikipedia article, this should give you the resistance distance matrix of the graph g: With[{Γ = PseudoInverse[KirchhoffMatrix[g]]}, Outer[Plus, Diagonal[Γ], Diagonal[Γ]] - Γ - Transpose[Γ] ]


1

One way to improve the performance of your code is to remove definitions of auxiliary functions from the bodies of function definitions. Such auxiliary functions are redefined every time the function is called. This is demonstrated by f[] := Module[{g}, g[] := SymbolName[g]; g[]] Table[f[], {4}] {"g$11401", "g$11402", "g$11403", "g$11404"} In your ...


3

Just sample your function over a 2D window with a Table. f[x_,y_]:= 1-2*Sinc[2(x^2 + y^2)] step = .2; kern = Table[f[x,y], {x, -3, 3, step}, {y, -3, 3, step}]; The dimensions of the kernel can be returned with Dimensions[kern]. Experiment with values of step and window sizes. Now just do an ImageConvolve[img,kern] and optionally use ImageAdjust to ...


15

This happens because of unpacking when the numbers exceed $MaxMachineNumber: fast = Dot @@@ Partition[tab, Divisors[3960][[42]]]; Developer`PackedArrayQ /@ fast (* {True, True, True, True, True, True, True, True} *) Max[fast] <= $MaxMachineNumber (* True *) slow = Dot @@@ Partition[tab, Divisors[3960][[43]]]; Developer`PackedArrayQ /@ slow (* {False, ...


1

If I understand correctly what you want, this code seems to work: a = 2; matrix = {{1, 1, 3}, {7, 4, 7}, {2, 6, 8}}; For[i = 1, i <= 3, i++, For[j = 1, j <= 3, j++, value = Part[matrix, i, j]; Print [value]; noofbit = IntegerDigits[value, 2]; z = FromDigits [noofbit]; Part[matrix, i, j] = z]]; Print[matrix] The statements ...


1

I am not sure what the ultimate aim is here. I post this in case it motivates the desired approach. Anything above N=2 is unwieldy: Setup: matg[n_, s_, col_] := Table[Style[Unique[s], col, Bold], {n}] smat[n_, s_, col_] := SparseArray[{i_, j_} :> Style[Unique[s], col, Bold], {n, n}] Example: a = smat[2, "a", Red]; b = List /@ matg[2, "b", ...


2

A couple of approaches: f[x_] := {x[[1]], Sequence @@ (x[[-1]] # & /@ x[[2 ;; -2]]), x[[-1]]}; g = {#1, #2 #5, #3 #5, #4 #5, #5} &; Map[f, data, {2}] g @@@ # & /@ data


2

You were one character away from the solution: data[[All, All, {2, 3, 4}]] *= data[[All, All, 5]]; data {{{23, 61.5, 82., 102.5, 20.5}, {24, 61.5, 20.5, 0., 20.5}, . . . See documentation for TimesBy and Elegant operations on matrix rows and columns.


1

M1 = 1/3*{{1, 1, 1}, {1, α, α^2}, {1, α^2, α}}; Z1 = {{Z + Zg, Zg, Zg}, {Zg, Z + Zg, Zg}, {Zg, Zg, Z + Zg}}; M2 = {{1, 1, 1}, {1, α^2, α}, {1, α, α^2}}; Either provide an exact value in the Rule M1.Z1.M2 /. α -> -1/2 + I Sqrt[3]/2 // Simplify {{Z + 3 Zg, 0, 0}, {0, Z, 0}, {0, 0, Z}} Or use Rationalize to remove both near zero values and 1. ...


1

M1.Z1.M2 /. α -> -.5 + I Sqrt[3]/2 Chop[FullSimplify[%]] (* {{Z + 3 Zg, 0, 0}, {0, 1. Z, 0}, {0, 0, 1. Z}} *)


3

One simple solution to this is to a combination of Simplify and Chop, which will get rid of items like (0. * I). Chop[Simplify[M1.Z1.M2 /. α -> (-0.5 + I*Sqrt[3]/2)]] {{Z + 3 Zg, 0, 0}, {0, 1. Z, 0}, {0, 0, 1. Z}} There are still some (1. Z) terms in there, which, if you look at the FullForm are actually just very close to 1, according to the ...


1

You have created a rather dangerous monster. Observe what happens: Q=Table[Q[i,j]=RandomReal[{0.6,1}],{i,5},{j, 5}] First of all, Mathematica evaluates the right hand side which is the Table[...] part. For every value of the iterators it then evaluates the expression Q[i,j]=RandomReal[...] which returns you the RandomReal part (a number). Under the cover ...


1

You can do this in a few ways, but the most elegant is to use the method in kguler's comment on your original post, which is just to divide: M = RandomReal[{-1, 1}, {3, 3, 500}]; div = RandomReal[{-1, 1}, {3, 3}]; result = M / div; Because the Divide (/) function has the Listable attribute, it automatically threads over the outer level of its arguments in ...


5

The main reason for the slowness of the magicSquare is that your failed to insist on vecterization. (you're already aware of its importance, right? ) Making use of the internal functions owning Listable attribute and treating lists as a whole as much as possible, it's not hard to come to the following: magicSquare2[n_] /; Mod[n, 4] == 0 := Module[{mat, ...


2

Code The case when $n$ is odd magicSquare[n_?OddQ] := Module[{mat1, mat2}, mat1 = Table[Range[n], {i, n}]; mat2 = Transpose@mat1; With[ {matA = Mod[mat2 + mat1 + (n - 3)/2, n], matB = Mod[mat2 + 2 mat1 - 2, n]}, n matA + matB + 1] ] The case when $n$ is doubly-even magicSquare[n_] /; Mod[n, 4] == 0 := Module[{mat1, mat2, square, ...


0

The answers provided here are good. But I would lean towards using group-theoretic properties rather than just a LinearSolve. innerProduct[a_,b_]:=1/2 Tr[ConjugateTranspose[a].b] (* Usually *) groupSolve[basis_,names_][matrix_]:=Total[MapThread[ innerProduct[#1,matrix] #2 &,{basis,names} ]] which then can be used with ...


3

Another approach combining @SquareOne's observation with ArrayComponents: counts = Max /@ ArrayComponents[data[[All, All, 1]]] (* {4, 6, 7, 8} *) times = First /@ data[[All, All, -1]]; Transpose[{times, counts}] (* {{20.5, 4}, {20.4, 6}, {20.3, 7}, {20.2, 8}} *) Note: Assumed that 0 is not used as a particleID.


2

Slightly different approach. This Max[#[[All, 1]]] & /@ data {26, 28, 29, 29, 30} gives you the maximum particle number ID at each successive time (notice as @Halirutan said that you have a double entry (29), but never mind) Theoretically, by calculating the successive differences between theses elements: Max[#[[All, 1]]] & /@ data // ...


2

When you take the IDs of each time-step and accumulate them through the time (but deleting duplicates), then you get the information you want. Therefore, the basic idea is to extract all IDs from each time and then you use Union over and over again trough all time-steps FoldList[Union, data[[All, All, 1]]] (* {{23, 24, 25, 26}, {23, 24, 25, 26, 27, ...


2

I think this does what you need: With[{a = Merge[Apply[#5 -> #1 &, data, {2}], Union]}, Thread[{Keys@a, Length /@ FoldList[Union, Values@a]}]] (* {{20.5, 4}, {20.4, 6}, {20.3, 7}, {20.2, 8}} *)


0

EDIT: Corrections VBA to Mathematica code translation optval[vol_, intrate_, expn_, payoff_, strike_, Etype_, NAS_] := Module[{S, vold, Vnew, Dummy, ds, dt, NTS, q, gamma, Delta, Theta}, S = Table[0, {NAS + 1}]; vold = Table[0, {NAS + 1}]; Vnew = Table[0, {NAS + 1}]; Dummy = Table[0, {NAS + 1}, {3}]; ds = 2*strike/NAS; dt = 0.9/vol^2/NAS^2; ...


4

MapIndexed can be used to apply styling to elements conditionally based upon the their indices within the matrix. For example: format[v_, {_, 1}] := framed[v, White, Blue] format[v_, {_, 2}] := MatrixForm[v, TableSpacing -> {None, None}] format[v_, {_, 2, 1, _} | {_, 2, _, 4}] := framed[v, Black, Darker[Yellow, 0.01]] format[v_, _] := v framed[v_, f_, ...


4

mfnested = MapAt[MatrixForm, nested, {{}, {;; , ;;}}]; colF = MapAt[Function[{i}, Item[i, Background -> #2[[1]]]], #, #2[[2]]] &; Fold[colF, mfnested, {{Yellow, {{1, All, 2, 1, 1, All}, {1, All, 2, 1, All, -1}}}, {Lighter@Blue, {{All, All, 1}}}}] Grid[MapAt[Grid[#, Background -> {{-1 -> Yellow}, {1 -> Yellow}}] &, ...


2

What follows is my latest edit. I have moved my previous attempts to solve this to the bottom of the answer. EDIT 04.05.15 I have given this problem some more thought. It's peculiar, that Mathematica cannot solve it straight away, but it should in fact be quite easy. Using your notation, we are dealing with the following differential equation: $$ ...


1

The first argument of VectorScale is the "unit scale to use, given as a fraction of the diagonal of the overall bounding box", according to the documentation, so if we dynamically rescale the fraction we use so it is equal to the maximum length vector at each $\theta$ (occurs at the points in the corners), we can get the desired behavior. With[ {xi = -π, ...


1

myVectorPlot[x__]:= VectorPlot[x] /. Arrow[{p_, q_}]:>Arrow[{p + (q - p)/2, q + (q - p)/2}]; Manipulate[ { sample = Table[ {x - (x*Cos[θ] - y*Sin[θ]), y - (x*Sin[θ] + y*Cos[θ])}, {x, -Pi, Pi, 1}, {y, -Pi, Pi, 1} ]; scale = Max[Map[Norm, sample, {2}]]; myVectorPlot[{-x + (x*Cos[θ] - y*Sin[θ]), -y + (x*Sin[θ] + y*Cos[θ])}, {x, -Pi, Pi}, {y, ...


1

I'm interpreting your question as asking how to display all the vectors in your plot scaled to the same length as the vectors in the corners of the plot range. You can do that as follows: With[{max = N[π]}, Manipulate[ VectorPlot[{x - (x Cos[θ] - y Sin[θ]), y - (x Sin[θ] + y Cos[θ])}, {x, -max, max}, {y, -max, max}, Axes -> True, ...


1

First, a fixed version of your code: ClearAll[eOF0, eOF1, eOF2, eOF3] eOF0[int_, dt_, nas_, nts_] := Module[{d = ConstantArray[2, {nas + 1, nts}]}, For[j = nts, j > 1, j--, d = ReplacePart[d, {1, j - 1} -> (1 - int*dt)*d[[1, j]]]]; Grid[d]] eOF0[0.01, 0.1, 4, 4] and a few alternatives eOF1[int_, dt_, nas_, nts_] := Module[{d = ...



Top 50 recent answers are included