Podcast #128: We chat with Kent C Dodds about why he loves React and discuss what life was like in the dark days before Git. Listen now.
18

Li = Range[5]; TakeDrop[Li, #] & /@ Range[Length[Li]-1] // Column[Row/@#]& or, slightly shorter, i = 1; TakeDrop[Li, i++] & /@ Most[Li] // Column[Row/@#]& or, using just Range and organizing the result with Transpose: Transpose[{Range[Range[4]], Range[1 + Range[4], 5]}] // Column[Row/@#]& For an arbitrary list of size 5, say, lst ...


15

MMA v.8 provides support for (finite) Group Theory, however this answer will not make use of that functionality. We shall use the ** (NonCommutativeMultiply) command present in MMA, which allows us to create semigroups quite easily. In a fresh MMA session: Unprotect[NonCommutativeMultiply]; GroupAction[g_, s_] := (g ** #) & /@ s 1 is the identity: ...


15

I am not sure this is what you need. Please see if it helps. The little cubes are clickable, but not rotatable. We could put nicely formatted edge labels as well, but I didn't want to do that now as it would slow it down even more. conf = solved; Dynamic@Graph[ Join[ (conf -> twist[#, conf] &) /@ basic, (twist[#, conf] -> conf &) /@...


13

The group has 6048 elements. (Could it be isomorphic to $U_3(3)$?--see below.) count = 0; (matrices = NestWhile[(Print[count++]; Union[#~Join~Flatten[Outer[Dot, {gMatrix, hMatrix, kMatrix}, #, 1], 1]]) &, {IdentityMatrix[7]}, Length[#2] != Length[#1] &, 2, 99]) // Length // Timing $\{2.2, 6048\}$ This code begins ...


13

IntegerDigits works Try powers = IntegerDigits[204, 2] {1, 1, 0, 0, 1, 1, 0, 0} Now, if you want that formatted as a sum of powers of two, you have to hold it. For example Total@MapIndexed[#1 Defer[2]^(First@#2 - 1) &, Reverse@powers] 2^2 + 2^3 + 2^6 + 2^7 EDIT Nicer code, given that your numbers go up to 255 pow2[num_]:=Inner[#1 2^Defer[#2] ...


13

Because the image of the group under this (linear) representation is infinite, we will need to limit the orbits. Working in the abstract group Presuming it may eventually be of interest to depict multiple orbits, let's compute a large number of group elements once and for all. It seems efficient to do this abstractly, in terms of the given presentation, ...


13

The Susyno and LieART Mathematica packages can do this. I know best the first one (I wrote it), so let me use it as an example in this answer. Assuming that you have installed and loaded the package in a Mathematica session, your example ($\mathbf{10}\times\mathbf{27}$ in $SU(3)$) is computed as follows: ReduceRepProduct[SU3, {{3, 0}, {2, 2}}] This ...


13

This is literally the canonical example from the ReplaceList documentation: ReplaceList[{a, b, c, d, e, f}, {x__, y__} -> {{x}, {y}}] {{{a}, {b, c, d, e, f}}, {{a, b}, {c, d, e, f}}, {{a, b, c}, {d, e, f}}, {{a, b, c, d}, {e, f}}, {{a, b, c, d, e}, {f}}}


11

Hi all please send me an mail at spawn@math.upatras.gr or visit my web site www.math.upatras.gr/~spawn, although the version on the site is not updated you can find an online version of the help files of the package. Many things have been added since my thesis. Among them, I have added command for the algebraic manipulation of the symmetries (Levi ...


11

There is a simpler function instead of GCD that allows you to skip the comparison with 1: CoprimeQ. Using it, we can do this: Z[n_] := With[{i = Range[n]}, Pick[i, CoprimeQ[i, n]]] Z[21] (* ==> {1, 2, 4, 5, 8, 10, 11, 13, 16, 17, 19, 20} *) Here I deliberately tried to avoid any cryptic symbols (although perhaps that should be par for the course in a ...


11

mat = {Sort @ #, #} & @ PermutationList[a]; MatrixForm @ mat // TeXForm $ \left( \begin{array}{ccccccccccc} 1 & 2 & 3 & 4 & 5 & 6 & 7 & 8 & 9 & 10 & 11 \\ 9 & 11 & 7 & 8 & 10 & 2 & 1 & 5 & 3 & 4 & 6 \\ \end{array} \right)$


9

The Wolfram Demonstration in its original version was wrong. The demo has since been corrected (updated March 2013). The first five functions called $H$ there (which were originally the only functions listed) do not form a group. You need a sixth element to make the set closed under multiplication! This can be checked by defining the six functions as ...


9

Additional methods using WeightedData, EmpiricalDistribution, GatherBy and SparseArray: {weights,classes} = weightsPerclass = {{1, 0.2, .3, .4, .1, .3, .9, 0}, {1, 2, 3, 1, 3, 1, 1, 5}}; WeightedData wd = WeightedData[classes, weights]; The property "EmpiricalPDF" almost gives what we need wd["EmpiricalPDF"] (* {{1,2,3,5},{0.8125,0.0625,0.125,0.}} *) ...


9

All right, here is a solution: Find group isomorphisms in Mathematica. It's not pretty, but it's practical for groups of order up to about 100. It takes 30 ms to find out that $\text{d8a}\cong\text{d8b}$, and 43 ms to produce the automorphism group on my Mac mini. It finds an isomorphism from $S_5\to S_5$ (order 120) in 7 s. Producing all of $Aut(S_5)$ takes ...


8

Here is a brute force method: cycles[el_] := Module[{f, edges = Rule @@@ el // Dispatch}, f[x_, b___, x_] := {{x, b, x}}; f[___, x_, ___, x_] = {}; f[c___, v_] := Join @@ (f[c, v, #] & /@ ReplaceList[v, edges]); Join @@ f /@ Union @@ el ] In the code above the line f[___, x_, ___, x_] = {}; was used for clarity, but faster duplicate tests ...


8

Below is an implementation of Johnson's 1975 exhaustive algorithm (see PDF, AFAIK the fastest exhaustive algorithm), improved upon the rather procedural version of Daniel Skates (see Mathematica demonstration). A hand-crafted C-version of the code is also available (if you mail me), which adds a further tenfold increase of speed compared to the Mathematica ...


8

Use the PermutationOrder function: In[1]:= elt = Cycles[{{1, 2}, {3, 4, 5}}]; In[2]:= PermutationOrder[elt] Out[2]= 6 This is indeed the answer you expect, and the smallest power you can raise elt to and get the identity permutation. In[3]:= PermutationPower[elt, #] & /@ Range[6] Out[3]= {Cycles[{{1, 2}, {3, 4, 5}}], Cycles[{{3, 5, 4}}], Cycles[{{1, ...


8

Li = Range[5]; groups = Table[GatherBy[Li, # <= n &], {n, 4}] (* {{{1}, {2, 3, 4, 5}}, {{1, 2}, {3, 4, 5}}, {{1, 2, 3}, {4, 5}}, {{1, 2, 3, 4}, {5}}} *) To display this as shown in your question Column[StringJoin /@ Map[ToString, groups, {2}]] EDIT: Or more generally, Li = {a, c, b, e, d}; groups = Table[ GatherBy[Li, Position[Li, #][[...


7

You were almost there. Just add the following to your code: iC3v = Inverse /@ C3v; sa = SolveAlways[Flatten@ Table[basis[[i]][iC3v[[k]].{x, y}] == Sum[basis[[j]][{x, y}] d[k, j, i], {j, 3}], {i, 3}, {k, 6}], {x, y}]; MatrixForm /@ Table[d[k, i, j], {k, 6}, {i, 3}, {j, 3}] /. sa And you get your expected result: $\left( \begin{...


7

Update: I just noticed this comment: The constraint I have is: a node can not be in two subgraphs. This is contradictory with the rest of the problem description: need to find all possible connected subgraphs Next time please formulate the problem more precisely. You probably wanted FindGraphPartition[g, 12] (see METIS), but that is not finding all ...


6

This isn't directly an answer, and I'll delete it if it is off target. But you might want to use some non-System` context functionality for taking polynomial-mod-2 products. Specifically this works with integer lists of coefficients. I'll show an example below. In[1110]:= SeedRandom[1111]; vals = RandomInteger[2^8 - 1, 2] intlists = Map[Reverse[...


6

The SYM package was developed by Stylianos Dimas and may be found in Appendix A of his thesis at http://nemertes.lis.upatras.gr/jspui/bitstream/10889/1697/1/thesis.pdf


6

The multiplication table is itself a list of permutations of a representation of the group so you can do In[1]:= m = {{1, 2, 3, 4}, {2, 3, 4, 1}, {3, 4, 1, 2}, {4, 1, 2, 3}}; In[2]:= G = PermutationGroup[m]; Now you can compute group properties as usual: In[3]:= GroupOrder[G] Out[3]= 4 In this case the permutation representation obtained is exactly the ...


6

This works for 16 elements too: list0 = Range[4]; sep = 2; (* separation of exchangeable elements *) exchangeable = Select[Subsets[list0, {2}], Abs[Subtract @@ #] == sep &] (* {{1, 3}, {2, 4}} *) group = PermutationGroup[Cycles[{#}] & /@ exchangeable] (* PermutationGroup[{Cycles[{{1, 3}}], Cycles[{{2, 4}}]}] *) elements = GroupElements[group] (...


6

Update: This seems fixed in the latest RPi version, 11.2.0. This is a bug specific to the Raspberry Pi (or rather ARM versions of Mathematica?). I reported it on February 21, 2016, and Wolfram Support told me that it is a known issue. A workaround is to use the IGraph/M package, which provides the same functionality and works fine on the Raspberry Pi. &...


6

I find the OP questions somewhat unclear. In any case, the answers can be found in the tutorials "Permutations" and "Permutation Groups". I would like to permute the elements of the set A using symmetric group. In[44]:= Permute[{1,2,3},SymmetricGroup[3]] Out[44]= {{1, 2, 3}, {1, 3, 2}, {2, 1, 3}, {2, 3, 1}, {3, 1, 2}, {3, 2, 1}} The Mathematica ...


6

One should really use commutator rather than Commutator for future-proofing concerns, but I have some bad habits... Clear[Commutator] (* Manually implement the algebra of interest: *) Commutator[L1, L2] = I L3; Commutator[L2, L1] = -I L3; Commutator[L2, L3] = I L1; Commutator[L3, L2] = -I L1; Commutator[L3, L1] = I L2; Commutator[L1, L3] = -I L2; (* ...


6

Let us consider the axioms for a group: groupTheory={ForAll[{a,b,c},g[a,g[b,c]]==g[g[a,b],c]], ForAll[a,g[a,e]==a], ForAll[a,g[a,inv[a]]==e]}; As shown in the question, Murray's command for proving that the right identity is unique: FindEquationalProof[Implies[ForAll[a, g[a, f]==a], e==f], groupTheory ] fails with a message that there is an invalid ...


6

One idea is to overload MatrixForm so that it does this for you automatically: Unprotect[MatrixForm]; MatrixForm /: MakeBoxes[MatrixForm[cyc_Cycles], StandardForm] := With[ {list=PermutationList[cyc]}, ToBoxes[MatrixForm[{Range@Length@list, list}], StandardForm] ] Protect[MatrixForm]; Then: Cycles[{{1, 9, 3, 7}, {2, 11, 6}, {4, 8, 5, 10}}] //...


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