Tag Info

Hot answers tagged

14

A simple solution with And, Xor and Mod: n = 41; Table[If[Abs[2 j - 1 - n] < i && Xor[Mod[Abs[2 j - 2 - n] - i, 3] == 0, 2 j > n + 1], 1, 0], {i, n}, {j, n}] // ArrayPlot The same for n = 333: To be more functional-style: j = ConstantArray[Range@n, n]; i = Transpose@j; UnitStep[i - 1 - Abs[2 j - 1 - n]] (1 + (1 - 2 ...


11

Maybe upperTriangularMatrixQ2[mat_?MatrixQ] /; Equal @@ Dimensions@mat := UpperTriangularize@mat == mat; test = RandomInteger[{1, 100}, {1000, 1000}]; upperTriangularMatrixQ@test // AbsoluteTiming {2.126050, False} upperTriangularMatrixQ2@test // AbsoluteTiming {0.003277, False} test2 = UpperTriangularize@test; upperTriangularMatrixQ@test2 ...


10

Assuming that the values of your matrix are all distinct, or that you don't count repetitions in n, you can do this: ClearAll[largest]; largest[mat_, n_] := Clip[mat,{RankedMax[#, n], Max[#]}, {0, 0}] &[Flatten@mat] So that large = RandomReal[{1, 10}, {50, 50}]; Do[largest[large, 50], {1000}]; // Timing // First (* 0.076633 *)


10

At least internally, the following is a nice recursive way of thinking about the chess board: MatrixPlot[CellularAutomaton[250, {0, 1}, {7, 7}]] Not sure if this is what was meant by functional style. It's hard to make a one-liner functional. To address extensibility: the dimensions of the board are directly dictated by the argument {7,7}, and the ...


10

If you were to allow CellularAutomaton I think the simplest change is to drop every other row and column: MatrixPlot[CellularAutomaton[57, {{1}, 0}, 80][[;; ;; 2, ;; ;; 2]], ImageSize -> 400, Mesh -> All, PlotTheme -> "Monochrome"] There is however a discontinuity in the center compared to your original. I'll start working on other options. ...


8

f1 = KroneckerProduct[IdentityMatrix[#], #2]& f2 = SparseArray[{Band[{1, 1}, # Dimensions@#2] -> {#2}}] & f3 = SparseArray[{Band[{1, 1}] -> ConstantArray[#2, #]}] & f4 = ArrayFlatten[IdentityMatrix[#] /. 1 -> #2 ] & p = Table[1, {2}, {2}]; f1[3, p] f2[3, p] // Normal f3[3, p] // Normal f4[3, p] all give (* ...


8

I can't test the timing right now, but maybe it's worth mentioning Threshold[large, {"LargestValues", 50}]


8

You did not specify if this test should be optimized for the positive or negative case. If most of your matrices will fail the test it can be greatly beneficial to have an early exit behavior. For example if the lower left element in the matrix is not zero you can fail the matrix after a single element test! And even in the positive case the elements on ...


7

Short Version You can get Mathematica to convert WolframAlpha-style free-form input into a valid expression using CTRL+= or by starting an input expression with =: Note how Mathematica made sense of two alternative free-form expressions of the same thing, and converted each into the same valid expression involving the Dot operator. Longer Version: ...


7

As Gregory Rut mentioned, DiagonalMatrix already has built-in support for generating banded matrices from lists: Inner[DiagonalMatrix, RandomInteger[{0, 5}, #] & /@ {49, 50, 49}, {-1, 0, 1}] which yields the following (when ArrayPlot is applied):


7

diag = RandomChoice[CharacterRange["a", "z"], #] & /@ {49, 50, 49}; m = SparseArray[Inner[Rule, {Band[{1, 2}], Band[{1, 1}], Band[{2, 1}]}, diag, List]] MatrixPlot[m, Mesh -> True] Timings: for a 50X50 matrix the timings of two methods based on Band and DiagonalMatrix are both 0. For larger matrices, Band is much faster: ClearAll[f1, f2]; f1 = ...


6

You have to be a bit careful here; your last approach does not give the desired matrix F: (LinearSolve[dV, dv] // Transpose).dV === dv False Then what does give the correct output? We can use the fact that for generic matrices $A$ and $B$ we have $A.B = (B^T.A^T)^T$ and write F = Transpose @ LinearSolve[Transpose @ dV, Transpose @ dv] And indeed, ...


6

This seems much simpler than other answers presented: Array[Plus, {8, 8}] ~Mod~ 2 // MatrixPlot Attempting to comply with the requirements of the addendum here is a recursive solution: board[n_] := board[n - 1, {{0}}] board[n_, a_] := board[n - 1, ArrayFlatten[{{a, #\[Transpose]}, {#, 0}}] &[{1 - Last[a]}]] board[0, a_] := a Example: ...


6

I am not getting the same results in version 10. Also I see no problem with the results already indicated, and I'll say a bit about that as we proceed. Here is what I obtain in version 10. smatrix = {{1 - 2.96392/u2, 0.0000196744/u2}, {1. - 2.96392/u2, -2.11737*10^-10 + 0.0000196746/u2}}; det = Det[smatrix]; sols = Solve[det == 0, u2] During ...


6

The closest I get is this MatrixPlot@ Table[Boole@((Divisible[Abs[k - n], 3] || k >= 22) && (Divisible[Abs[-22 + k + n], 3] \[Implies] k < 22) && n > 2 Abs[-22 + k]), {n, 41}, {k, 41}]


5

I'm not quite sure if I understand your problem correctly. Anyway, use Eigensystem to find Eigenvalues and Eigenvectors at the same time. Here we go A = {{5, 4, 2}, {4, 5, 2}, {2, 2, 2}}; Eigensystem[A] (* {{10, 1, 1}, {{2, 2, 1}, {-1, 0, 2}, {-1, 1, 0}}} *) Hence the Eigenvalues are {10,1,1} and the respective Eigenvectors appear ordered ...


5

mat[p_, n_] := ArrayFlatten[DiagonalMatrix[Array[1 &, n]] /. {1 -> p, 0 -> 0 p}] p = {{1, 2}, {3, 1}}; mat[p, 3] // MatrixPlot


5

Judging from the paper you linked to and your own comments, I think what you really want is a directed Barabasi‚ÄďAlbert graph whose opposite edges have different weight. (Thus e.g. edge 1 -> 2 should have a different weight than 2 -> 1). The code you posted generates an undirected BA graph, so allow me to suggest an alternative generating function ...


5

Here is my expanded response to kguler. I noticed that usually Band is less effective then DiagonalMatrix@SparseArray or manual constructing of the resulting SparseArray f1 = SparseArray[Inner[Rule, {Band[{1, 2}], Band[{1, 1}], Band[{2, 1}]}, #, List]] &; f2 = Inner[DiagonalMatrix, #, {1, 0, -1}] &;; f3 = Inner[DiagonalMatrix[SparseArray@#, #2] ...


4

Pattern-based functional approach: pat1 := n_Integer /; n > 1 :> Sequence[n, n - 1 /. pat1]; pat2 := v : List[__Integer] /; Max[v] > 1 :> Sequence[v, v - 1 /. pat2]; cb[n_] := MatrixPlot[ {{n}} /. pat1 /. pat2, ColorFunction -> (GrayLevel@Mod[1 + #, 2] &), ColorFunctionScaling -> False, PlotRangePadding -> None, ...


4

Dot is a special case of Inner list = {{0, 1}, {0, 2}, {0, 3}}; Inner[Times, list, Transpose[list], Plus] // MatrixForm list = {{1, 1}, {1, 2}, {1, 3}} Inner[Power, list, Transpose[list], Plus] // MatrixForm Also possible: Outer[Times, {1, 2, 3}, {1, 2, 3}] // MatrixForm


4

If you are looking for matrix multiplication, use . (or the Dot command).


4

Also useful here would be the Outer product: p = ConstantArray[1, {2, 2}]; ArrayFlatten[Outer[Times, IdentityMatrix[2], p]] which gives the desired output (displayed using MatrixForm)


4

sundat = {{280., 0.082}, {280.5, 0.099}, {3995., 0.0087}, {4000., 0.00868}}; conversionfactors = {2., .5}; data2 = Transpose[conversionfactors Transpose[sundat]] or data2 = conversionfactors # & /@ sundat both give (* {{560.,0.041},{561.,0.0495},{7990.,0.00435},{8000.,0.00434}} *)


3

Here is a relative minor variation on eldo's method that speeds it up considerably, but still falls well short of Lenonid Shifrin's better algorithm. keepMax[matrix_, n_] := With[{threshold = (Union@Flatten@matrix)[[-n]]}, Map[If[# < threshold, 0, #] &, matrix, {2}]] Absolute timings SeedRandom[42]; testData = RandomInteger[{1, 99}, {50, ...


3

This is a functional version of board: ones = {{1, 1}, {1, 1}}; zeros = {{0, 0}, {0, 0}}; board[n_] := Partition[Riffle[ConstantArray[ones, (n)^2/2], {zeros}], n, n - 1] // ArrayFlatten // Image[#, ImageSize -> 400] & board[8] (Defining ones and zeros is optional, so this side effect can be avoided. You will notice also that it only works for even ...


3

One can decrease the difficulty of the problem by reducing the Dyson series to a matrix ODE. Let's start from the definition $$ U(x,x_0) = 1 + \int_{x_0}^{x}{dy_1V(y_1)}+\int_{x_0}^x{dy_1\int_{x_0}^{y_1}{dy_2V(y_1)V(y_2)}}+\ldots $$ and take the derivative with respect to $x$ $$ \frac{\partial}{\partial x}U(x,x_0) = ...


3

Expanding eldos approach for even n to all integers > 0: cb[n_?EvenQ] := MatrixPlot[ArrayPad[DiagonalMatrix[{1, 1}], n/2 - 1, "Reflected"], PlotTheme -> "Monochrome"] cb[n_?OddQ] := MatrixPlot[Most /@ Most @ ArrayPad[DiagonalMatrix[{1, 1}], (n + 1)/2 - 1, "Reflected"], PlotTheme -> "Monochrome"] Manipulate[ cb[n], {n, 1, 11, 1}]


3

You can also use Dot: sundat.{{2., 0}, {0, .5}} (* {{560., 0.041}, {561., 0.0495}, {7990., 0.00435}, {8000., 0.00434}} *)


2

Is what you mean by a functional solution a solution that uses functions? Or do you mean in the style of functional programming? If the former, then this works: checked[n_] := Table[Mod[1 + (i + j), 2], {i, 1, n}, {j, 1, n}] numbers[n_] := Transpose[{Range[1, n], ToString /@ (Reverse@Range[1, n])}] letters[n_] := Transpose[{Range[1, n], ...



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