# Tag Info

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

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

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

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 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 &) ... 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 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}]] = ... 5 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 ... 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} ] ... 3 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 ... 3 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, #], ... 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 ... 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

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

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

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

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