4. EL GRUPO SIMÉTRICO

*Las entradas de cada ejemplo deben ser ejecutados en orden para su correcto funcionamiento.
**Algunas varibles tienen nombres similares que difieren en un único caracter, puede aparecer el siguiente mensaje de aviso (no supone error): 
		General::"spell1": "Possible spelling error: new symbol name "VARIABLE1" is similar to existing symbol "VARIABLE2"

FUNCIÓN 1. S[]

S[n_] := 
      Table[MatrixForm[{Table[
              j, {j, n}], Permutations[
                Table[j, {j, n}]][[i]]}], {i, n!}]

FUNCIÓN 2. NombreS[]

NombreS[n_] := 
      Do[Print[(Subscript[σ, k]), "=", S[n][[k]]], {k, 
          1, n!}]

Ejemplo 1.

S[n_] := 
      Table[MatrixForm[{Table[
              j, {j, n}], Permutations[
                Table[j, {j, n}]][[i]]}], {i, n!}]

NombreS[n_] := 
      Do[Print[(Subscript[σ, k]), "=", S[n][[k]]], {k, 
          1, n!}]

S[3]

NombreS[3]

FUNCIÓN 3. Indice[]

Indice[permutacion_] := 
          Module[{i, n, j}, 
n = 
              Length[permutacion]; 
i = 
              1; 
While[Permutations[
                    Table[j, {j, 1, n}]][[i]] != 
                permutacion, i++]; 
i
];

Ejemplo 2.

S[n_] := 
      Table[MatrixForm[{Table[
              j, {j, n}], Permutations[
                Table[j, {j, n}]][[i]]}], {i, n!}]

Indice[permutacion_] := 
          Module[{i, n, j}, 
n = 
              Length[permutacion]; 
i = 
              1; 
While[Permutations[
                    Table[j, {j, 1, n}]][[i]] != 
                permutacion, i++]; 
i
];

Indice[{2, 3, 4, 1, 5}]

S[5][[33]]

FUNCIÓN 4. sigma[]

sigma[k_, n_][
          m_] := Permutations[Table[j, {j, n}]][[k, m]]

1.1. Funciones de Mathematica

<< DiscreteMath`Combinatorica`

n = 3;
SymmetricGroup[n]

Index[{2, 3, 4, 1, 5}]

2. COMPOSICIÓN O MULTIPLICACIÓN DE PERMUTACIONES

FUNCIÓN 5. composicion[]

\(composicion[k_, j_, n_] := 
      Module[{t, m, z, tabla}, 
t = 
          1; 
tabla = 
          Table[\(sigma[k, n]\)[\(sigma[j, n]\)[m]], {m, 1, 
              n}]; 
While[
          tabla != \(Permutations[
                Table[m, {m, 
                    n}]]\)[\([t]\)], \(t++\)]; 
A = 
          MatrixForm[{Table[z, {z, n}], 
              tabla}]; 
Print[σ\_k, σ\_j, "=", σ\_t, "=", A]]\)

FUNCIÓN 6. composicion2[]

composicion2[k_, j_, n_] := 
      Module[{t, m, 
          z}, Position[Permutations[Table[m, {m, n}]], 
              Table[sigma[k, n][sigma[j, n][m]], {m, 1, 
                  n}]][[1]][[1]]]

Ejemplo 3.

sigma[k_, n_][
          m_] := Permutations[Table[j, {j, n}]][[k, m]]

\(composicion[k_, j_, n_] := 
      Module[{t, m, z, tabla}, 
t = 
          1; 
tabla = 
          Table[\(sigma[k, n]\)[\(sigma[j, n]\)[m]], {m, 1, 
              n}]; 
While[
          tabla != \(Permutations[
                Table[m, {m, 
                    n}]]\)[\([t]\)], \(t++\)]; 
A = 
          MatrixForm[{Table[z, {z, n}], 
              tabla}]; 
Print[σ\_k, σ\_j, "=", σ\_t, "=", A]]\)

composicion[2, 4, 3]

composicion2[k_, j_, n_] := 
      Module[{t, m, 
          z}, Position[Permutations[Table[m, {m, n}]], 
              Table[sigma[k, n][sigma[j, n][m]], {m, 1, 
                  n}]][[1]][[1]]]

composicion2[2, 4, 3]

FUNCIÓN 7. cuentas[]

cuentas[n_] := 
      Module[{t, k, j, m}, 
tablacomp = 
          Table[0, {k, n!}, {j, n!}]; 
Do[
Do[
t = 
                composicion2[k, j, 
                  n]; 
tablacomp[[j, 
                    k]] = (Subscript[σ, t])
, {k, 
                1, n!}];
, {j, 
            1, n!}]; 
TableForm[tablacomp, 
          TableHeadings -> {Table[(Subscript[σ, m]), {m, n!}], 
              Table[(Subscript[σ, m]), {m, n!}]}, 
          TableSpacing -> {2, 2}]
]

Ejemplo 4.

composicion2[k_, j_, n_] := 
      Module[{t, m, 
          z}, Position[Permutations[Table[m, {m, n}]], 
              Table[sigma[k, n][sigma[j, n][m]], {m, 1, 
                  n}]][[1]][[1]]]

cuentas[n_] := 
      Module[{t, k, j, m}, 
tablacomp = 
          Table[0, {k, n!}, {j, n!}]; 
Do[
Do[
t = 
                composicion2[k, j, 
                  n]; 
tablacomp[[j, 
                    k]] = (Subscript[σ, t])
, {k, 
                1, n!}];
, {j, 
            1, n!}]; 
TableForm[tablacomp, 
          TableHeadings -> {Table[(Subscript[σ, m]), {m, n!}], 
              Table[(Subscript[σ, m]), {m, n!}]}, 
          TableSpacing -> {2, 2}]
]

cuentas[3]

3. EL SUBGRUPO ALTERNADO

3.1. Signatura y paridad

PROGRAMA 8. Inversiones

permutacion=PERMUTACIÓN;

inversion=0;
Do[
    Do[
        If[i<j && permutacion[[j]]< permutacion[[i]],inversion++];
        ,{j,i,Length[permutacion]}];
    ,{i,1,Length[permutacion]}];
inversion

Ejemplo 5.

permutacion = {6, 8, 5, 2, 3, 4, 7, 1};
inversion = 0;
Do[
Do[
If[
                i < j  &&  
                  permutacion[[j]] <  
                    permutacion[[i]], inversion++];
, {j, i, Length[permutacion]}];
, {i, 
          1, Length[permutacion]}];
inversion

Ejemplo 6.

permutacion = {6, 8, 5, 2, 3, 4, 7, 1};
inversion = 0;
Do[
Do[
If[
                i < j  &&  
                  permutacion[[j]] <  
                    permutacion[[i]], inversion++];
, {j, i, Length[permutacion]}];
, {i, 
          1, Length[permutacion]}];
inversion

(-1)^%

3.2. El subgrupo alternado

PROGRAMA 9. Cálculo del subgrupo alternado contando el número de inversiones

sigma[k_,n_][m_]:=FUNCIÓN 4.7.;
S[n_]:=FUNCIÓN 4.4.;
n=NÚMERO DE ELEMENTOS DE LA PERMUTACIÓN;

Sn=S[n];
Alternado={};
Do[
  permutacion=Table[sigma[k,n][i],{i,1,n}];
  inversion=0;
  Do[
    Do[
        If[i<j && permutacion[[j]]< permutacion[[i]],inversion++];
        ,{j,i,n}];
    ,{i,1,n}];
  inversion;
  If[Mod[inversion,2]==0,AppendTo[Alternado,Sn[[k]]]];
  ,{k,1,n!}]
Alternado

Ejemplo 7.

sigma[k_, n_][
          m_] := Permutations[Table[j, {j, n}]][[k, m]]

S[n_] := 
      Table[MatrixForm[{Table[
              j, {j, n}], Permutations[
                Table[j, {j, n}]][[i]]}], {i, n!}]

n = 4;
Sn = S[n];
Alternado = {};
Do[
permutacion = 
        Table[sigma[k, n][i], {i, 1, n}]; 
inversion = 
        0; 
Do[
Do[
If[i < j  &&  permutacion[[j]] <  
                    permutacion[[i]], inversion++];
, {j, i, n}];
, {i, 1, 
          n}]; 
inversion; 
If[
        Mod[inversion, 2] == 0, 
        AppendTo[Alternado, Sn[[k]]]];
, {k, 
        1, n!}]
Alternado

<< DiscreteMath`Combinatorica`

AlternatingGroup[4]