Tag Info

Hot answers tagged

12

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


12

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


11

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


10

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


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


8

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


8

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


8

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


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


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


5

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


5

FWIW, here's a slightly shortened re-implementation of standardize[]: standardize[a_] := Module[{atemp = a, beta, gamma = 2}, Do[ beta = atemp[[alpha, x]]; If[beta >= gamma, If[beta > gamma, atemp[[{gamma, beta}]] = atemp[[{beta, gamma}]]; atemp = (atemp /. {beta -> gamma, gamma -> beta})]; gamma++], {alpha, 4}, {x, ...


5

If you make standardize have attribute HoldFirst, your code works as is: ClearAll[standardize]; SetAttributes[standardize, HoldFirst]; standardize[a_] := Module[{alpha, beta, gamma, x}, gamma = 2; For[alpha = 1, alpha <= 4, alpha++, For[x = 1, x <= 4, x++, beta = a[[alpha, x]]; If[beta >= gamma, If[beta > gamma, a[[{gamma, beta}]] = ...


4

One approach, born out of curiosity more than anything, is to take the determinant, extract the permutations from the indices, and then cycle decompose. I don't think this is a very efficient method as Det is slow, but it seems to work. To cycle decompose, I use combinatoricatocycles[] with Mathematica 7 (see here), rather than the new Mathematica 8 ...


4

Mostly I cribbed this from here. I simply changed the line that converts input to the particular sparse representation used by the main part of the code. Important caveat: I do not know for a fact that this code is correct for the directed case. extendCycle[cyc_List, edges_List] := Map[If[# > First[cyc] && ! MemberQ[cyc, #], Append[cyc, #], ...


4

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


3

The help page of GroupElementToWord shows that it has a Method option. The documentation for that option says that "GroupElementToWord uses the Minkwitz algorithm, with a number of parameters", and shows some examples on how changing those parameters can result in shorter words in the generators. The Minkwitz algorithm (Torsten Minkwitz, 1998) is based on ...


3

A brute-force approach would be to define the set of matrices and form all products of them: FixedPoint[Union[#, Dot @@@ Tuples[#, 2]] &, set] The Union sorts the entries so that duplicates are eliminated. The length of the resulting list is the order of the group. Edit to explain the code In the command FixedPoint, the first argument is a function ...


3

Not very elegant and it requires additional work on the rules : elem = {1, a, b} rules = {a^3 -> 1, a^4 -> a, b^2 -> 1, b^3 -> b, b a^2 -> a b, b^4 -> 1} bigG = Union[Times @@ # & /@ Tuples[elem, {2}]] bigS = Subsets[bigG, {3}] TableView[ Outer[Sort[#1 #2 //. rules] &, bigG, bigS, 1, 1], TableHeadings -> {bigG, bigS} ] ...


2

As per whuber's comment, given a function $h$ and a set of functions $f_i$, where you know that $$h(\mathbf{r})=\sum_i a_i f_i(\mathbf{r})$$ you wish to know what the $a_i$ are? A dumb, but possibly effective way is just to throw some points at it and solve. For example, with F1[{x_, y_}] := (x + I y)^2 F2[{x_, y_}] := (x - I y)^2 F3[{x_, y_}] := (x + ...


2

Try this: In[1]:= Unprotect[PermutationProduct]; PermutationProduct[left___, sum_Plus, right___] := PermutationProduct[left, #, right] & /@ sum; PermutationProduct[left___, c_ perm_?PermutationCyclesQ, right___] := c PermutationProduct[left, perm, right]; PermutationProduct[left___, 0, right___] := 0; ...


2

Let me try to explain this. The key idea with bases is that even when you work with a group action on a set of n objects numbered 1 to n, you actually can identify the individual group elements by how they act on the elements of a base, which is frequently much shorter. For example, take the In[1]:= group = DihedralGroup[6]; It has 12 elements, sorted ...


2

There is an add-on package that's worth mentioning in this context, mainly to address Wouter's comment: in the Combinatorica package, you find some group-theory related commands that are not part of the System context to which the linked guide refers. One of them is ConstructTabelau, addressing the comment by Wouter. Sometimes the built-in gems are hard to ...


2

Here's a simple suggestion: define a function that expands commutators by applying the Leibnitz rule to each argument individually and using the distributive property of the ** operation. Since we can't apply commutativity, I have to spell out rules for different orders of factors. Then I apply the function to an example. cExpand[ expr_] := (expr //. { ...


2

PG = PermutationGroup[{Cycles[{{1, 3}, {2, 4}}], Cycles[{{1, 5}, {4, 6}}]}]; PermutationProduct @@ GroupElements @ PG Cycles[{{1, 5}, {4, 6}}]


2

I presume you mean the representation of the generators of su(2) (i.e. of the algebra) rather than a presentation of the group. Representations of the SU(2) group in any dimension can be obtained from WignerD. Something like SU2repj = Table[ WignerD[{j, m1, m2}, a, b, c], {m1, j, -j, -1}, {m2, j, -j, -1} ] /. j -> 2 will generate the $5\times5$ ...


1

Let's define your function and my proposal: f1[l_, gr_] := Length@DeleteDuplicates@Permute[l, gr@Length@l] f2[l_, gr_] := GroupOrder@gr@Length@l / GroupOrder@GroupSetwiseStabilizer[gr@Length@l, {l}, Permute] f2 isn't always faster than f1,but can calculate things where f1 fails due to memory constraints. For example: Timing@f1[{a, a, a, a, ...


1

Try this set of rules: Unprotect[NonCommutativeMultiply]; NonCommutativeMultiply[a_Plus, b_] := Plus@@(NonCommutativeMultiply[#,b]&/@a) NonCommutativeMultiply[a_, b_Plus] := Plus@@(NonCommutativeMultiply[a,#]&/@b) NonCommutativeMultiply[Times[-1,a__], b_] := -NonCommutativeMultiply[Times[a],b] NonCommutativeMultiply[a_, Times[-1,b__]] := ...


1

Not a general solution, but works for the case you cited; (*Definitions*) an=6; bn=4; h[0,x_]:=x; h[1,x_]:=1/x; h[2,x_]:=1-x; h[3,x_]:=1/(1-x); h[4,x_]:=(x-1)/x; f[x_] := Sum[a@i x^i,{i,an}] / Sum[b@i x^i,{i,bn}]; (*Proposed form / Rational*) (*Now find the coefficients a[i] and b[i]*) ss=Solve[And @@ Table[f@h[i,x] == f@x,{i,0,4}], ...



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