Tag Info

Hot answers tagged

18

I think the built-in function ArrayComponents is what you need: vec = {1, 4, 4, 8, 7, 7, 4}; ArrayComponents[vec] (* {1,2,2,3,4,4,2} *) mat = {{1, 4}, {2, 7}, {7, 2}, {9, 4}}; ArrayComponents[mat] (* {{1,2},{3,4},{4,3},{5,2}} *) raggedarray = RandomSample /@ (CharacterRange["a", "z"][[#]] & /@ Range[RandomSample[Range[5]]]) (* ...


11

The old-school way to do this: index[a_] := Module[{i = 1, f}, f[x_] := f[x] = i++; f /@ a] index @ vec {1, 2, 2, 3, 4, 4, 2} A method using Assocation, introduced long after ArrayComponents. index2[a_List] := AssociationThread[#, Range@Length@#] ~Lookup~ a & @ DeleteDuplicates @ a Edit #2: extended to matrices using eldo's own method: ...


9

For the filling pattern you showed: x = {a1, a2, a3, a4, a5, a6}; n = 3; x ~Internal`PartitionRagged~ Range[n, 1, -1] ~Flatten~ {2} // PadLeft {{a1, a4, a6}, {0, a2, a5}, {0, 0, a3}} To find n given a complete input list x you can use: n = Sqrt[1 + 8 Length@x]/2 - 1/2


8

Actually, I think the reason it works like this is because Mathematica lists can be anything, so it assumed you want the second element of this list of lists to be 0. So if you want all elements of that second sublist to be 0, you have to specify it just like you did for the column. mat = {{1, 2, 3, 4, 5}, {6, 7, 8, 9, 10}, {11, 12, 13, 14, 15}, {16, ...


7

Your code is like a Rube Goldberg machine! Try this instead: fn[state_] := Outer[Coefficient[state, #*#2] &, ##] & @@ (Union @ Cases[state, #, -2] & /@ {_FF, _GG}) Test: test = 7 FF[1, 1] GG[1, 1] + 2 FF[1, 1] GG[2, 2] + 4 FF[2, 2] GG[2, 2] + 11 FF[2, 1] GG[2, 4]; fn[test] // MatrixForm $\left( \begin{array}{ccc} 7 & 2 & 0 ...


6

Join @@ Flatten[{M1, M2}, {{2}, {1}}] (* {{1, 2, 3}, {10, 11, 12}, {4, 5, 6}, {13, 14, 15}, {7, 8, 9}, {16, 17, 18}, {19, 20, 21}, {22, 23, 24}} *) Reference for using the second argument of Flatten to transpose a ragged array. Update: even shorter (big praise to Flatten): Flatten[{M1, M2}, {2, 1}]


6

Since "It is not important where each element is placed": a = {a1, a2, a3, a4, a5, a6} mat = SparseArray[ Rule[#, #2] & @@@ Thread@{Flatten[Table[{i, j}, {i, 3}, {j, i, 3}], 1], a}]; mat // MatrixForm $\left( \begin{array}{ccc} \text{a1} & \text{a2} & \text{a3} \\ 0 & \text{a4} & \text{a5} \\ 0 & 0 & \text{a6} \\ ...


6

I'll use this example matrix: matrix = Table[i + j, {i, 20}, {j, 0, 19}] Please take a look at it. You'll notice that the top row has the elements 1-20 and that the leftmost column as has those as well. Now let's create a list of the columns/rows that you want to keep: keep = Join[Range[5], Range[6, 10, 2], Range[11, 20, 3]] (* Out: {1, 2, 3, 4, 5, 6, 8, ...


6

I know I'm a little bit late to the party but here's a way to generate the ragged diamond using DiamondMatrix directly: (* Generate double diamond surrounded by zeros using DiamondMatrix*) diamondWithin = DiamondMatrix[{4, 5}, {9, 10}]; (* Trim the zeros and resulting empty lists (if any) *) trimZero = diamondWithin //. {0 :> Sequence[], {} :> ...


5

For a worst case scenario when your graphics broke down, and you are forced to work only with numbers f[x_, y_, a_, b_] := (x + y)^2/a^2 + (x - y)^2/b^2 R = 10; mat=Table[If[f[m, n, 2, 3] < R^2, Style[X, Red], O], {m, -2 R,2 R}, {n, -2 R, 2 R}]; Grid[mat, Spacings -> {0, 0}] Change R, a, b to change the shape. Its probably not very practical way, ...


5

One way, probably not the cleanest: gr = Graphics[Rotate[Disk[{0, 0}, {4, 2}], Pi/6], ImageSize -> 250]; a = Image[gr, "Bit", ColorSpace -> "Grayscale"] // ImageData; a // Colorize You can control the border size using PlotRangePadding or ArrayPad, for Graphics or absolute scaling. This is not slow: gr = Graphics[Rotate[Disk[{0, 0}, {4, 2}], ...


5

Defining a helper function for tidiness: diamondcounts[n_] := Range[n] ~Join~ Range[n - 1, 1, -1] You could use ConstantArray and Map ConstantArray[1, #] & /@ diamondcounts[n] But personally I think Table is a rather nice choice here: Table[1, {i, diamondcounts[n]}, {i}]


5

Using ArrayPad to reflect a pyramid matrix: diamond[n_] := ArrayPad[ConstantArray[1, #] & /@ Range[n], {{0, n - 1}}, "Reflected"] diamond[5] // MatrixForm


5

Here are two different methods based on Array: diamond[n_] := With[{a = ConstantArray[1, #] &}, Array[a, n]~ Join ~Reverse@Array[a, n - 1]] OR diamond[n_]:= Array[Array[1 &, #] &, {n}] ~ Join ~ Reverse[Array[Array[1 &, #] &, {n-1}]] diamond[5] // MatrixForm


4

This is simply the logical outcome of Mathematica treating an array as an ordinary expression tree. Your array isn't really an array at all, but merely a collection of List expressions inside another List expression, all of which happen to be the same length. And like any other ordinary expression in an assignment you can change a part using Set: expr = ...


4

You were almost there but you need to read up on SortBy: Do[ matfinal[i] = SortBy[matinitial, Total[#[[i ;; i + 4]]] &], {i, 6} ]


4

diamond[n_] := 1 & /@ Range[#] & /@ (Range[n]~Join~Reverse@Range[n - 1]); or diamond[n_] := Array[1 &, n - Abs[#]] & /@ Range[1 - n, n - 1]; diamond[10]//MatrixForm


4

Here is a FoldList approach: diamond[n_] := Rest@FoldList[ConstantArray[1, #2] &, 0, Range[n]~Join~Range[n - 1, 1, -1]] Then: diamond[6] // MatrixForm


4

Not much to add to the existing answers except that my favorite method to convert lists of natural numbers to all ones is x^0 therefore: f[n_] := Range[n - Abs @ Range[1-n, n-1]]^0 Also I don't believe anyone has yet used Diagonal: f2[n_] := With[{m = BoxMatrix[(n - 1)/2]}, Array[m ~Diagonal~ # &, 2 n - 1, 1 - n]]


4

I'm surprised MMA doesn't have something like StringSplit for list, but maybe I haven't looked hard enough. I added the .. to delete multiple all-zero columns after seeing @Kuba's comment. Please upvote his comment instead of my answer since his was the more succinct. mat = {{0, 0, 0, 0, 0, 1}, {1, 0, 0, 1, 0, 1}, {0, 1, 0, 0, 0, 0}, {0, 0, 0, 0, 0, ...


4

Since you haven't given an explicit graph, I'll take the liberty to work with a random graph in this answer: graph = RandomGraph[{4, 4}, VertexLabels -> "Name", ImagePadding -> 10] From what I understand, you want the following table: TableForm[shortestpathlinkmatrix, TableHeadings -> {edges, shortestpaths}] This can be achieved as ...


4

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


3

func = Function[{mat, matfin, n, m}, Table[ With[{ord = Ordering[mat, All, Total[#[[i ;; i + m]]] < Total[#2[[i ;; i + m]]] &]}, matfin[i] = matinit[[ord]]], {i, n}]]; OP's example: func[matinitial, matfinal, 6, 4]; matfinal[1] (* {{11, 12, 13, 14, 15, 16, 17, 18, 19, 10}, {21, 22, 23, 24, 25, 26, 27, 28, 29, 210}, {31, 32, ...


3

You are completely right: using Map is much nicer than an iterative approach. Here's one way you might do it: ReplacePart[M, # -> s]& /@ L Here /@ is a short-hand input form of Map, and the #& combination is what's known as a pure function. Welcome to Mathematica :).


3

Investigating your answers I found some more possibilities: A helper function PeekRange[n_] := With[{r = Range @ n}, r ~ Join ~ Reverse @ Most @ r] Partition: diamond1[n_] := Partition[ConstantArray[1, n], n, 1, {-1, 1}, {}] ListConvolve: diamond2[n_] := ConstantArray @@@ ListConvolve[{1}, PeekRange @ n, 1, 0, List] ArrayReshape: diamond3[n_] := ...


3

A variation on @MrW's answer using a combination of Outer, Coefficient, Variables and GatherBy: func = Function[{state}, Coefficient[state, #] &@ Outer[Times, ## & @@ (Sort /@ GatherBy[Variables[state], Head])]]; Test: xx1 = FF[1, 1] GG[1, 1] + FF[1, 1] GG[2, 2] + FF[2, 2] GG[2, 2]; xx2 = 2*FF[1, 2] GG[1, 1] + FF[1, 1] GG[1, 2] + FF[2, 2] ...


3

you can also use ClusteringComponents function inex[m_] := ClusteringComponents[m, Length@m + 1]; vec = {1, 4, 4, 8, 7, 7, 4}; inex[vec] (*{1, 2, 2, 3, 4, 4, 2}*) mat = {{1, 4}, {2, 7}, {7, 2}, {9, 4}}; inex[mat] (*{{1, 2}, {3, 4}, {4, 3}, {5, 2}}*)


3

Basically, the same idea as seismatica's answer, but with different details. m = {{0, 0, 0, 0, 0, 1}, {1, 0, 0, 1, 0, 1}, {0, 1, 0, 0, 0, 0}, {0, 0, 0, 0, 0, 1}, {1, 1, 0, 1, 0, 0}, {0, 0, 0, 1, 0, 1}}; split = Transpose /@ DeleteCases[ SplitBy[If[Plus @@ # > 0, #] & /@ Transpose[m], # === Null &], {Null}]; ...


3

In the spirit of Mathematica 10 I would have written it like this: Composition[ DeleteCases[{{0} ..}], Map[Transpose], SplitBy[#, Unitize@*Total] &, Transpose ]@mat {{{0, 0}, {1, 0}, {0, 1}, {0, 0}, {1, 1}, {0, 0}}, {{0}, {1}, {0}, {0}, {1}, {1}}, {{1}, {1}, {0}, {1}, {0}, {1}}} With rules I would write: Transpose /@ {Transpose[mat] ...


2

We can adapt Sjoerd's solution to the question, Table - find index of the maximum element. Other methods may be found here: List manipulation: position & max value combination. tt1 = Flatten[ Table[Thread@{x, y, z /. Solve[z^2 == x^2 y - z, z, Method -> Reduce]}, {x, 0, 5, 1}, {y, 0, 5, 1}], 2]; Then this yields {x, y, max}: tt1 ~Part~ ...



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