Homology Iterated Groups Package

Victor Alvarez Solano, Jose Andres Armario Sampalo, Maria Dolores Frau Garcia and Pedro Real Jurado
Departamento de Matematica Aplicada I, University of Seville (Spain)
19 August 2006

valvarez@us.es

Determining the homology of a group at a desired dimension is in general a very difficult task, which is actually not feasible from a computational point of view. Taking into account the tools that the Homological Perturbation Theory provides, these calculations may be significantly improved with the use of homological models. This way, if a homological model hG for a group G is known, it suffices to compute the homology modules for hG instead of those for G,which is meaningfully simpler. This package provides a means of computing the homology of any iterated product of central extensions, semidirect products and direct products of finite abelian groups. Furthermore, explicit calculations of the maps involved in the definition of the homological model may be achieved with a slight modification of the notebook.

Reference

Title

Homology Iterated Groups

Author

Victor Alvarez Solano, Jose Andres Armario Sampalo, Maria Dolores Frau Garcia and Pedro Real Jurado

Summary

This package is designed to find out the homology modules for any iterated product of central extensions, semidirect products and direct products of abelian groups.

Copyright

Rights reserved by Victor Alvarez Solano et al, Departamento de Matematica Aplicada I, University of Seville (Spain).

Notebook Version

2.0

Mathematica Version

4.0

History

Calculating the homology modules of groups has traditionally been a very difficult task in Algebraic Topology. Though there are many applications of the knowledge of such homology groups, we are particularly interested in the construction of cocyclic Hadamard matrices, and their applications in Coding Theory. From the last 20 years, the Homological Perturbation Theory has provided a new insight to this subject, so that some homological models have been described for many families of groups. This package provides a way for computing the homology modules for any iterated product of central extensions, semidirect products and direct products of abelian groups. As a straightforward consequence, the information on dimensions 1 through 3 may be used in turn to look for cocyclic Hadamard matrices, with aid of the HadamardSearch package also provided by this author.

Keywords

Homology, homological model, central extension, semidirect product.

Limitation

This package works only on iterated products of central extensions, semidirect products and direct products of abelian groups.

Discussion

References:
A Mathematica notebook for computing the homology of iterated products of groups. V. Alvarez, J.A. Armario, M.D. Frau and P. Real, LNCS 4151, 47--57 (2006).
(Co)homology of iterated semidirect products of abelian groups. V. Alvarez, J.A. Armario, M.D. Frau and P. Real (in preparation).

Requirements

Context`HomologyIteratedGroups`
uses IntegerSmithNormalForm, due to Victor Alvarez et al, 2006;

Interface

This part declares the publicly visible functions, options, and values.

Set up the package context, including public imports

Off[General::spell];
Off[General::spell1];
BeginPackage["`HomologyIteratedGroups`"]

$ContextPath

Usage messages for the exported functions and the context itself

HomologyIteratedGroups::usage="HomologyIteratedGroups[treelist,cardinalities,degree,chi] gives, for an iterated product of groups represented by a binary tree _treelist_, its integral homology module at degree _degree_. The program needs the list _cardinalities_ of cardinalities of the factor groups componing the iterated product. The maps chi[niv] defining the central extensions and semidirect products implicated must be pre-defined by the user before calling the HomologyIteratedGroups function.

More concretely, the program requires three input data: the tree-list representing the iterated product, as well as the list of cardinalities of the factor groups implicated (from left to the right) and the degree of the homology group to compute. In order to introduce the binary tree representing the group, starting from the root vertex, you have to cover all levels (from top to bottom, from left to right at the same level), attending to the following notation: 0, if it is a leaf vertex (i.e. represents a group Z or Zn); 1, if the vertex represents a direct product A x G; 2, if the vertex represents a semidirect product A x_chi G, for G being the structural groupm chi:G x G --->A; 3, if the vertex represents a semidirect product A x_chi G, for A  being the structural group, chi:A x A --->G; 4, if the vertex represents a central extension A x_chi G, for A being the image of the 2-cocycle chi:G x G --->A; and 5, if the vertex represents a central extension A x_chi G, for G  being the image of the 2-cocycle chi:A x A --->G. Each level must be introduced in a different list. For instance, if chi[2]: G x G ---> A is a 2-cocycle and chi[1]: H x (A x_chi[2] G) ---> A x_chi[2] G is an action, the iterated product (A x_chi[2] G) x_chi[1] H will be represented by the list {{2},{4,0}}. The maps chi[niv] must be provided by the user before calling the HomologyIteratedGroups function. There is an explicit example included as a comment at the end of the package."

Implementation

This part contains the actual definitions and any auxiliary functions that should not be visible outside.

Begin the private context (implementation part)

Begin["`Private`"]
{$Context,$ContextPath}

Definition of auxiliary functions and local (static) variables

Most of auxiliary functions uses the maps `chi` to be defined by the user, so we have decided to include these maps `chi` as an argument of the main command. This way, the auxiliary functions are incorporated to the body of the principal function, so that there is no need for adding the maps `chi` as arguments anymore.

Main program

\(\(\( (*

Main\ program

*) \)\(
\)\( (*\ 
      This\ notebook\ works\ with\ iterated\ products\ of\ direct, \ 
      semidirect\ and\ central\ extensions\ of\ abelian\ groups . \ 
              The\ map\ chi[niv]\ will\ refer\ both\ to\ a\ 2 - 
          cocycle\ \(chi : \ 
              G\ x\ \(G\ --\)\) -> \ \(A\ and\ to\ an\ action\ \(chi : \ 
              G\ x\ \(A\ --\)\) -> \ A\), \ 
      as\ it\ is\ the\ case . \ These\ maps\ chi[
          niv]\ must\ be\ provided\ by\ the\ user, \ 
      the\ index\ niv\ referring\ to\ the\ correspondent\ product\ A\ x\ _niv\ G . \ Appart\ from\ the\ maps\ chi[niv], \ 
      the\ input\ data\ consist\ in\ the\ tree - 
        list\ "arbol"\ representing\ the\ iterated\ product, \ 
      as\ well\ as\ the\ list\ "card"\ of\ cardinalities\ of\ the\ factor\ groups\ \((sorted\ from\ left\ to\ right)\)\ and\ the\ degree\ "grh"\ of\ the\ homology\ group\ to\ \(\(compute\)\(.\)\)\ *) \)\(
\)\( (*


*) \)\(
\)\(HomologyIteratedGroups[
          arbol_, card_, grh_, chi_] := 
        Module[{},  (*\ 
            Preprocessing\ elementary\ \(\(functions\)\(.\)\)\ *) 
 (*
We\ define\ general\ functions\ codifying\ the\ homological\ models\ for\ abelian\ groups\ Zn\ \((finite)\)\ and\ Zn\ \((infinite)\), \ 
            as\ well\ as\ central\ extensions\ and\ semidirect\ products . \ 
                Along\ the\ notebook, \ 
            the\ variable\ "niv"\ will\ refer\ to\ the\ index\ of\ the\ correspondent\ product\ in\ the\ tree - 
              list\ representing\ the\ iterated\ product\ of\ \(\(groups\)\(.\)\)
\ *) 
$RecursionLimit = 
            Infinity;  (*\(SetAttributes[mutiplicar, 
                Orderless];\)*) 
prod[l_, 0, y_, r_] := 
            y; 
prod[l_, x_, 0, r_] := x; 

          prod[l_, x_, y_, 0] := If[l == 0, x + y, Mod[x + y, l]]; 

          prod[l_, x_, y_, 
              1] := {\(proda[l]\)[x[\([1]\)], y[\([1]\)]], \(prodg[l]\)[
                x[\([2]\)], y[\([2]\)]]}; 

          prod[l_, x_, y_, 
              2] := {\(proda[l]\)[
                x[\([1]\)], \(chi[l]\)[x[\([2]\)], y[\([1]\)]]], \(prodg[l]\)[
                x[\([2]\)], y[\([2]\)]]}; 

          prod[l_, x_, y_, 
              3] := {\(proda[l]\)[x[\([1]\)], y[\([1]\)]], \(prodg[l]\)[
                x[\([2]\)], \(chi[l]\)[x[\([1]\)], y[\([2]\)]]]}; 

          prod[l_, x_, y_, 
              4] := {\(proda[l]\)[\(proda[l]\)[x[\([1]\)], 
                  y[\([1]\)]], \(chi[l]\)[x[\([2]\)], y[\([2]\)]]], \(prodg[
                  l]\)[x[\([2]\)], y[\([2]\)]]}; 

          prod[l_, x_, y_, 
              5] := {\(proda[l]\)[x[\([1]\)], 
                y[\([1]\)]], \(prodg[l]\)[\(prodg[l]\)[x[\([2]\)], 
                  y[\([2]\)]], \(chi[l]\)[x[\([1]\)], y[\([1]\)]]]}; 

          inversos[l_, 0, r_] := 0; 

          inversos[l_, x_, 0] := If[l == 0, \(-x\), Mod[\(-x\), l]]; 

          inversos[l_, x_, 
              1] := {\(inversosa[l]\)[x[\([1]\)]], \(inversosg[l]\)[
                x[\([2]\)]]}; 

          inversos[l_, x_, 2] := 
            Module[{k}, 
              k = \(inversosg[l]\)[x[\([2]\)]]; {\(chi[l]\)[
                  k, \(inversosa[l]\)[x[\([1]\)]]], k}]; 

          inversos[l_, x_, 3] := 
            Module[{k}, 
              k = \(inversosa[l]\)[x[\([1]\)]]; {k, \(chi[l]\)[
                  k, \(inversosg[l]\)[x[\([2]\)]]]}]; 

          inversos[l_, x_, 4] := 
            Module[{k}, 
              k = \(inversosg[l]\)[
                  x[\([2]\)]]; {\(inversosa[l]\)[\(proda[l]\)[
                    x[\([1]\)], \(chi[l]\)[x[\([2]\)], k]]], k}]; 

          inversos[l_, x_, 5] := 
            Module[{k}, 
              k = \(inversosa[l]\)[
                  x[\([1]\)]]; {k, \(inversosg[l]\)[\(prodg[l]\)[
                    x[\([2]\)], \(chi[l]\)[x[\([1]\)], 
                      k]]]}]; 
\(\(proyeccion[j_]\)[0]\)[l_] := \(fzn[j]\)[
              l]; 
\(\(proyeccion[j_]\)[1]\)[l_] := \(fmodban[j]\)[
              aw[\(isopd[j]\)[l]]]; 
\(\(proyeccion[j_]\)[2]\)[
              l_] := \(fmodps[j, 
                2]\)[\(awps[j, 2]\)[\(isops[j, 2]\)[l]]]; 
\(\(proyeccion[
                  j_]\)[3]\)[
              l_] := \(fmodps[j, 
                3]\)[\(awps[j, 3]\)[\(isops[j, 3]\)[l]]]; 
\(\(proyeccion[
                  j_]\)[4]\)[
              l_] := \(fmodec[j, 
                4]\)[\(awec[j, 4]\)[\(isoec[j, 4]\)[l]]]; 
\(\(proyeccion[
                  j_]\)[5]\)[
              l_] := \(fmodec[j, 
                5]\)[\(awec[j, 5]\)[\(isoec[j, 5]\)[l]]]; 
\(\(inyeccion[
                  j_]\)[0]\)[l_] := \(gzn[j]\)[l]; 
\(\(inyeccion[j_]\)[1]\)[
              l_] := \(invisopd[
                j]\)[\(eml[j]\)[\(gmodban[j]\)[l]]]; 
\(\(inyeccion[j_]\)[
                2]\)[l_] := \(invisops[j, 
                2]\)[\(emlps[j, 2]\)[\(gmodps[j, 2]\)[l]]]; 
\(\(inyeccion[
                  j_]\)[3]\)[
              l_] := \(invisops[j, 
                3]\)[\(emlps[j, 3]\)[\(gmodps[j, 3]\)[l]]]; 
\(\(inyeccion[
                  j_]\)[4]\)[
              l_] := \(invisoec[j, 
                4]\)[\(emlec[j, 4]\)[\(gmodec[j, 4]\)[l]]]; 
\(\(inyeccion[
                  j_]\)[5]\)[
              l_] := \(invisoec[j, 
                5]\)[\(emlec[j, 5]\)[\(gmodec[j, 5]\)[l]]]; 
\(\(homotopia[
                  j_]\)[0]\)[l_] := \(fizn[j]\)[
              l]; 
\(\(homotopia[j_]\)[1]\)[
              l_] := \(invisopd[
                  j]\)[\(shi[j]\)[\(isopd[j]\)[l]]] + \(invisopd[
                  j]\)[\(eml[j]\)[\(fimodban[j]\)[
                    aw[\(isopd[j]\)[l]]]]]; 
\(\(homotopia[j_]\)[2]\)[
              l_] := \(invisops[j, 
                  2]\)[\(ships[j, 2]\)[\(isops[j, 2]\)[l]]] + \(invisops[j, 
                  2]\)[\(emlps[j, 
                    2]\)[\(fimodps[j, 
                      2]\)[\(awps[j, 2]\)[\(isops[j, 2]\)[
                        l]]]]]; 
\(\(homotopia[j_]\)[3]\)[
              l_] := \(invisops[j, 
                  3]\)[\(ships[j, 3]\)[\(isops[j, 3]\)[l]]] + \(invisops[j, 
                  3]\)[\(emlps[j, 
                    3]\)[\(fimodps[j, 
                      3]\)[\(awps[j, 3]\)[\(isops[j, 3]\)[
                        l]]]]]; 
\(\(homotopia[j_]\)[4]\)[
              l_] := \(invisoec[j, 
                  4]\)[\(shiec[j, 4]\)[\(isoec[j, 4]\)[l]]] + \(invisoec[j, 
                  4]\)[\(emlec[j, 
                    4]\)[\(fimodec[j, 
                      4]\)[\(awec[j, 4]\)[\(isoec[j, 4]\)[
                        l]]]]]; 
\(\(homotopia[j_]\)[5]\)[
              l_] := \(invisoec[j, 
                  5]\)[\(shiec[j, 5]\)[\(isoec[j, 5]\)[l]]] + \(invisoec[j, 
                  5]\)[\(emlec[j, 
                    5]\)[\(fimodec[j, 
                      5]\)[\(awec[j, 5]\)[\(isoec[j, 5]\)[l]]]]]; 
\(\(dif[
                  x_]\)[m_]\)[
              l_ + k_] := \(\(dif[x]\)[m]\)[l] + \(\(dif[x]\)[m]\)[
                k]; \(\(dif[x_]\)[m_]\)[l_Integer*k_List] := 
            multiplicar[l, \(\(dif[x]\)[m]\)[k]]; \(\(dif[x_]\)[m_]\)[0] := 
            0; 
\(\(dif[x_]\)[m_]\)[l_] := 
            Module[{l1, l2, k}, 
              If[m == 0, k = \(difzn[x]\)[l], 
                l1 = Take[l, hojimb[\([x, 1]\)]]; 
                l2 = Take[l, \(-hojimb[\([x, 2]\)]\)]; 
                Which[m == 1, 
                  k = pegar[\(da[x]\)[l1], l2] + 
                      multiplicar[\((\(-1\))\)^Apply[Plus, l1], 
                        pegar[l1, \(dg[x]\)[l2]]], m == 2, 
                  k = pegar[\(da[x]\)[l1], l2] + 
                      multiplicar[\((\(-1\))\)^Apply[Plus, l1], 
                        pegar[l1, \(dg[x]\)[l2]]] + \(difmodps[x, 2]\)[l], 
                  m == 3, 
                  k = pegar[\(da[x]\)[l1], l2] + 
                      multiplicar[\((\(-1\))\)^Apply[Plus, l1], 
                        pegar[l1, \(dg[x]\)[l2]]] + \(difmodps[x, 3]\)[l], 
                  m == 4, 
                  k = pegar[\(da[x]\)[l1], l2] + 
                      multiplicar[\((\(-1\))\)^Apply[Plus, l1], 
                        pegar[l1, \(dg[x]\)[l2]]] + \(difmodec[x, 4]\)[l], 
                  True, k = 
                    pegar[\(da[x]\)[l1], l2] + 
                      multiplicar[\((\(-1\))\)^Apply[Plus, l1], 
                        pegar[l1, \(dg[x]\)[l2]]] + \(difmodec[x, 5]\)[l]]]; 
              k]; 
\(proda[niv_]\)[x_, y_] := 
            prod[infoarbol[\([niv, 3]\)], x, y, 
              infoarbol[\([niv, 1]\)]]; 
\(prodg[niv_]\)[x_, y_] := 
            prod[infoarbol[\([niv, 4]\)], x, y, 
              infoarbol[\([niv, 2]\)]]; 
\(inversosa[niv_]\)[x_] := 
            inversos[infoarbol[\([niv, 3]\)], x, 
              infoarbol[\([niv, 1]\)]]; 
\(inversosg[niv_]\)[x_] := 
            inversos[infoarbol[\([niv, 4]\)], x, 
              infoarbol[\([niv, 2]\)]]; 
\(fa[niv_]\)[
              l_] := \(\(proyeccion[infoarbol[\([niv, 3]\)]]\)[
                infoarbol[\([niv, 1]\)]]\)[l]; 
\(ga[niv_]\)[
              l_] := \(\(inyeccion[infoarbol[\([niv, 3]\)]]\)[
                infoarbol[\([niv, 1]\)]]\)[l]; \(fia[niv_]\)[
              l_] := \(\(homotopia[infoarbol[\([niv, 3]\)]]\)[
                infoarbol[\([niv, 1]\)]]\)[l]; 
\(fg[niv_]\)[
              l_] := \(\(proyeccion[infoarbol[\([niv, 4]\)]]\)[
                infoarbol[\([niv, 2]\)]]\)[l]; \(gg[niv_]\)[
              l_] := \(\(inyeccion[infoarbol[\([niv, 4]\)]]\)[
                infoarbol[\([niv, 2]\)]]\)[l]; 
\(fig[niv_]\)[
              l_] := \(\(homotopia[infoarbol[\([niv, 4]\)]]\)[
                infoarbol[\([niv, 2]\)]]\)[l]; 
\(da[niv_]\)[
              l_] := \(\(dif[infoarbol[\([niv, 3]\)]]\)[
                infoarbol[\([niv, 1]\)]]\)[l]; 
\(dg[niv_]\)[
              l_] := \(\(dif[infoarbol[\([niv, 4]\)]]\)[
                infoarbol[\([niv, 2]\)]]\)[l]; 
 (*\ 
            Additive\ and\ multiplicative\ operations\ will\ not\ be\ listable . \ 
                The\ correspondent\ listable\ operations\ will\ be\ denoted\ by\ sumlist\ and\ \(\(prodlist\)\(.\)\)\ *) 

          ClearAttributes[Plus, Listable]; 

          ClearAttributes[Times, Listable]; 

          SetAttributes[sumlist, Listable]; 

          SetAttributes[prodlist, Listable]; 
          multiplicar[a_, b_] := 
            Module[{n}, ClearAttributes[Plus, Listable]; 
              ClearAttributes[Times, Listable]; \ 
              n = b + {\(-1\)} + {\(-2\)}; 
              Apply[Plus, Table[a*n[\([i]\)], {i, Length[n]}]] - a*{\(-1\)} - 
                a*{\(-2\)}]; 
sumlist[a_, b_] := a + b; 

          prodlist[a_, b_] := a*b; 
 (*\ 
            The\ maps\ nul1\ and\ nul2\ take\ out\ degenerated\ elements\ on\ W \((A)\) 
              x_\tau\ W \((G)\)\ and\ W \((A)\)\otimes_t\ W \((G)\), \ \(\(respectively\)\(.\)\)\ *) 
 (*\ 
            Elements\ in\ W \((A\ x_f\ G)\)\ and\ W \((A)\)\ x\ W \((G)\)\ are\ codified\ in\ the\ form\ lambda*list\ and\ lambda*{list, list}, \ 
            respectively, \ 
            lambda\ being\ an\ integer . \ 
                The\ "list"\ must\ be\ considerd\ empty, \ {}, \ 
            for\ the\ case\ of\ the\ unique\ element\ on\ degree\ \(\(zero\)\(.\)\)\ *) 
nul1[x_ + y_] := nul1[x] + nul1[y]; 
          nul1[x_Integer*y_] := multiplicar[x, nul1[y]]; nul1[0] := 0; 

          nul1[l_] := 
            Module[{k, n, i}, k = l; n = Length[l[\([1]\)]]; i = 1; 
              While[i ≤ n, 
                If[\((Apply[Plus, 
                          Map[Abs, Flatten[{l[\([1, i]\)]}]]] == 
                        0)\) && \((Apply[Plus, 
                          Map[Abs, Flatten[{l[\([2, i]\)]}]]] == 0)\), 
                  k = 0; i = n + 1, i = i + 1]]; k]; 

          nul2[x_ + y_] := nul2[x] + nul2[y]; 
          nul2[x_Integer*y_] := multiplicar[x, nul2[y]]; nul2[0] := 0; 
          nul2[l_] := 
            Module[{k, n1, n2}, 
              n1 = Length[
                  Select[l[\([1]\)], 
                    Apply[Plus, Map[Abs, Flatten[{#}]]] == 0 &, 1]]; 
              n2 = Length[
                  Select[l[\([2]\)], 
                    Apply[Plus, Map[Abs, Flatten[{#}]]] == 0 &, 1]]; 
              If[n1 + n2 == 0, k = l, k = 0]; 
              k]; 
 (*\ The\ maps\ aw, \ 
            eml\ and\ shi\ act\ only\ over\ not\ degenerated\ elements . \ 
                This\ means\ that\ maps\ nul1\ and\ nul2\ must\ be\ used, \ 
            if\ \(\(necessary\)\(.\)\)\ *) 
 (*\ 
            Codifying\ the\ Alexander - 
              Whitney\ \(map : \ \(\(aw\)\(\ \)\(.\)\)\)\ *) 

          aw[x_ + y_] := aw[x] + aw[y]; 
          aw[x_Integer*y_] := multiplicar[x, aw[y]]; aw[0] = 0; 

          aw[l_] := Module[{n, l1, l2}, l1 = l[\([1]\)]; l2 = l[\([2]\)]; 
              n = Length[l1]; 
              Apply[Plus, 
                Table[{Drop[l1, \(-\((n - i)\)\)], Drop[l2, i]}, {i, 
                    n + 1 - \(Select[Range[Length[l2] + 1], 
                          Apply[Plus, 
                                Map[Abs, 
                                  Flatten[{\(Append[Reverse[l2], 
                                        0]\)[\([#]\)]}]]] == 
                              0 &]\)[\([1]\)], \(-1\) + \(Select[
                          Range[Length[l1] + 1], 
                          Apply[Plus, 
                                Map[Abs, 
                                  Flatten[{\(Append[l1, 
                                        0]\)[\([#]\)]}]]] == 
                              0 &]\)[\([1]\)]}]]]; 
 (*\ 
            Codigying\ the\ Eilenberg - 
              Mac\ Lane\ \(map : \ 
                  eml\  . \ A\ \((p, q)\) - 
                    shuffle\ selects\ those\ positions\ of\ the\ list\ of\ length\ p\ at\ which\ the\ q\ elements\ of\ the\ initial\ list\ must\ be\ \(\(inserted\)\(.\)\)\)\ *) 
\(aument[p_]\)[k_] := 
            Table[Append[k, {j}], {j, \(Last[k]\)[\([1]\)], 
                p + 1}]; 
\(apaument[p_]\)[k_] := 
            Flatten[Map[aument[p], k], 1]; 
shuf[p_, 0] := {{}}; 
          shuf[0, q_] := {Table[{1}, {i, q}]}; 

          shuf[p_, 1] := Table[{{q}}, {q, 1, p + 1}]; 

          shuf[p_, q_] := Nest[apaument[p], shuf[p, 1], q - 1]; 

          insertar[l_, {ele_, pos_}] := 
            Insert[l, ele, pos]; 
\(eml[niv_]\)[
              x_ + y_] := \(eml[niv]\)[x] + \(eml[niv]\)[y]; \(eml[niv_]\)[
              x_Integer*y_] := 
            multiplicar[x, \(eml[niv]\)[y]]; \(eml[niv_]\)[0] = 
            0; 
\(eml[niv_]\)[l_] := 
            Module[{k, n1, n2, l1, l2}, l1 = l[\([1]\)]; l2 = l[\([2]\)]; 
              n1 = Length[l1]; n2 = Length[l2]; k = shuf[n1, n2]; 
              Apply[Plus, 
                Table[multiplicar[\((\(-1\))\)^\((\((\((n1 + n2 - 
                                      1)\)*\((n1 + n2)\) - n1*\((n1 - 1)\))\)/
                            2 + 1 - \((\((n2 - 2)\)*\((n2 - 1)\))\)/2 - 
                          Apply[Plus, Flatten[k[\([i]\)], 1]])\), {Insert[l1, 
                        elementoneutrodelgrupo[\(infoarbol[\([niv]\)]\)[\([{1, 3}]\)]], k[\([i]\)]], 
                      Fold[insertar, 
                        Table[elementoneutrodelgrupo[\(infoarbol[\([niv]\)]\)[\([{2, 4}]\)]], {j, n1}], 
                        Table[{l2[\([n2 + 1 - j]\)], 
                            k[\([i, n2 + 1 - j]\)]}, {j, n2}]]}], {i, 
                    Length[k]}]]]; 

          unir[l_, x_ + y_] := unir[l, x] + unir[l, y]; 
          unir[l_, x_Integer*y_] := multiplicar[x, unir[l, y]]; 
          unir[l_, 0] = 0; unir[0, k_] := 0; 

          unir[l_, k_] := {Join[l[\([1]\)], k[\([1]\)]], 
              Join[l[\([2]\)], k[\([2]\)]]}; 
 (*\ 
            Codifying\ the\ Shih\ homotopy\ \(map : \ 
                shi . \ 
                    It\ depends\ on\ the\ index\ "niv"\ corresponding\ to\ the\ actual\ \(\(product\)\(.\)\)\)\ *) 
\(shi[niv_]\)[
              x_ + y_] := \(shi[niv]\)[x] + \(shi[niv]\)[y]; \(shi[niv_]\)[
              x_Integer*y_] := 
            multiplicar[x, \(shi[niv]\)[y]]; \(shi[niv_]\)[0] = 
            0; 
\(shi[niv_]\)[l_] := 
            Module[{n, k1, k2}, k1 = l[\([1]\)]; k2 = l[\([2]\)]; 
              n = Length[k1]; 
              If[n == 0, 0, 
                Apply[Plus, 
                  Table[Apply[Plus, 
                      Table[multiplicar[\((\(-1\))\)^\((n - p - q)\), 
                          unir[nul1[{Append[Drop[k1, \(-p\) - q - 1], 
                                  elementoneutrodelgrupo[\(infoarbol[\([niv]\)]\)[\([{1, 3}]\)]]], Append[Drop[k2, \(-p\) - q - 1], 
Fold[
                                    prodg[niv], 0, 
                                    Reverse[
                                      Take[k2, {n - p - q, 
                                        n - q}]]]]}], \(eml[niv]\)[
                              nul2[{Take[
                                    k1, {n - p - q, 
                                      n - q}], 
Drop[k2, 
                                    n - q]}]]]], {p, 0, n - q - 1}]], {q, 0, 
                      n - 1}]]]]; 
 (*

*) 
 (*\ 
            Codifying\ the\ homological\ model\ for\ central\ extensions\ *) 
 (*

*) 
\(tauec[
                niv_, 4]\)[l_] := 
            Module[{k}, 
              If[Length[l] ≤ 1, k = 0, 
                k = Prepend[
                    Table[\(proda[
                          niv]\)[\(inversosa[niv]\)[\(chi[niv]\)[
                            l[\([i + 2]\)], 
                            Fold[prodg[niv], 0, 
                              Reverse[Take[l, i + 1]]]]], \(chi[niv]\)[
                          l[\([i + 2]\)], 
Fold[prodg[niv], 
                            0, Reverse[Take[l, {2, i + 1}]]]]], {i, 
                        Length[l] - 2}], \(inversosa[niv]\)[\(chi[niv]\)[
                        l[\([2]\)], l[\([1]\)]]]]]; k]; 
\(tauec[niv_, 5]\)[
              l_] := Module[{k}, 
              If[Length[l] ≤ 1, k = 0, 
                k = Prepend[
                    Table[\(prodg[
                          niv]\)[\(inversosg[niv]\)[\(chi[niv]\)[
                            l[\([i + 2]\)], 
                            Fold[proda[niv], 0, 
                              Reverse[Take[l, i + 1]]]]], \(chi[niv]\)[
                          l[\([i + 2]\)], 
Fold[proda[niv], 
                            0, Reverse[Take[l, {2, i + 1}]]]]], {i, 
                        Length[l] - 2}], \(inversos[niv]\)[\(chi[niv]\)[
                        l[\([2]\)], l[\([1]\)]]]]]; 
              k]; 
\(deltauec[niv_, ind_]\)[
              x_ + y_] := \(deltauec[niv, ind]\)[x] + \(deltauec[niv, ind]\)[
                y]; \(deltauec[niv_, ind_]\)[x_Integer*y_] := 
            multiplicar[
              x, \(deltauec[niv, ind]\)[y]]; 
\(deltauec[niv_, ind_]\)[0] = 
            0; 
\(deltauecsimple[niv_, ind_]\)[
              x_ + y_] := \(deltauecsimple[niv, ind]\)[
                x] + \(deltauecsimple[niv, ind]\)[y]; \(deltauecsimple[niv_, 
                ind_]\)[x_Integer*y_] := 
            multiplicar[
              x, \(deltauecsimple[niv, ind]\)[y]]; \(deltauecsimple[niv_, 
                ind_]\)[0] = 
            0; 
\(deltauecbanal[niv_, ind_]\)[
              x_ + y_] := \(deltauecbanal[niv, ind]\)[
                x] + \(deltauecbanal[niv, ind]\)[y]; \(deltauecbanal[niv_, 
                ind_]\)[x_Integer*y_] := 
            multiplicar[
              x, \(deltauecbanal[niv, ind]\)[y]]; \(deltauecbanal[niv_, 
                ind_]\)[0] = 0; 
\(prodalista[niv_, ind_]\)[0, l_] := 
            l; 
\(prodalista[niv_, 4]\)[k_, l_] := 
            Table[\(proda[niv]\)[k[\([i]\)], l[\([i]\)]], {i, 
                Length[k]}]; 
\(prodalista[niv_, 5]\)[k_, l_] := 
            Table[\(prodg[niv]\)[k[\([i]\)], l[\([i]\)]], {i, 
                Length[k]}]; 
\(deltauecsimple[niv_, ind_]\)[{{}, {}}] := 
            0; 
\(deltauecbanal[niv_, ind_]\)[{{}, {}}] := 
            0; 
\(deltauecbanal[niv_, ind_]\)[
              l_] := \(-{Rest[l[\([1]\)]], 
                Rest[l[\([2]\)]]}\); 
\(deltauecsimple[niv_, 4]\)[
              l_] := {\(prodalista[niv, 4]\)[\(tauec[niv, 4]\)[l[\([2]\)]], 
                Rest[l[\([1]\)]]], 
              Rest[l[\([2]\)]]}; 
\(deltauecsimple[niv_, 5]\)[
              l_] := {Rest[
                l[\([1]\)]], \(prodalista[niv, 5]\)[\(tauec[niv, 5]\)[
                  l[\([1]\)]], Rest[l[\([2]\)]]]}; 
\(deltauec[niv_, 4]\)[
              l_] := Module[{n, l1, l2, k}, l1 = l[\([1]\)]; l2 = l[\([2]\)]; 
              n = Length[l1]; 
              If[n < 2 || 
                  Apply[Plus, Map[Abs, Flatten[{l2[\([1]\)]}]]] == 0, 
                k = 0, k = \(deltauecsimple[niv, 4]\)[l] - {Rest[l1], 
                      Rest[l2]}]; k]; 
\(deltauec[niv_, 5]\)[l_] := 
            Module[{n, l1, l2, k}, l1 = l[\([1]\)]; l2 = l[\([2]\)]; 
              n = Length[l2]; 
              If[n < 2 || 
                  Apply[Plus, Map[Abs, Flatten[{l1[\([1]\)]}]]] == 0, 
                k = 0, k = \(deltauecsimple[niv, 5]\)[l] - {Rest[l1], 
                      Rest[l2]}]; k]; 
\(compo[niv_, ind_]\)[
              x_ + y_] := \(compo[niv, ind]\)[x] + \(compo[niv, ind]\)[
                y]; \(compo[niv_, ind_]\)[x_Integer*y_] := 
            multiplicar[x, \(compo[niv, ind]\)[y]]; \(compo[niv_, ind_]\)[
              0] = 0; \(compo[niv_, ind_]\)[
              l_] := \(deltauec[niv, ind]\)[\(shi[niv]\)[l]]; 

          sumatorio[l_] := 
            Apply[Plus, 
              Table[multiplicar[\((\(-1\))\)^\((i + 1)\), l[\([i]\)]], {i, 
                  Length[l]}]]; 
\(difteztec[niv_, ind_]\)[
              x_ + y_] := \(difteztec[niv, ind]\)[
                x] + \(difteztec[niv, ind]\)[y]; \(difteztec[niv_, ind_]\)[
              x_Integer*y_] := 
            multiplicar[
              x, \(difteztec[niv, ind]\)[y]]; \(difteztec[niv_, ind_]\)[0] = 
            0; \(difteztec[niv_, 4]\)[l_] := 
            Module[{p, q, l1, l2, k}, l1 = l[\([1]\)]; l2 = l[\([2]\)]; 
              p = Length[l1]; q = Length[l2]; 
              If[q == 0 || 
                  Apply[Plus, Map[Abs, Flatten[{l2[\([1]\)]}]]] == 0, 
                k = 0, k = 
                  aw[sumatorio[
                      NestWhileList[
                        compo[niv, 
                          4], \(deltauec[niv, 4]\)[\(eml[niv]\)[
                            l]], \((#1 =!= 0)\) &]]]]; 
              k]; 
\(difteztec[niv_, 5]\)[l_] := 
            Module[{p, q, l1, l2, k}, l1 = l[\([1]\)]; l2 = l[\([2]\)]; 
              p = Length[l1]; q = Length[l2]; 
              If[p == 0 || 
                  Apply[Plus, Map[Abs, Flatten[{l1[\([1]\)]}]]] == 0, 
                k = 0, k = 
                  aw[sumatorio[
                      NestWhileList[
                        compo[niv, 
                          5], \(deltauec[niv, 5]\)[\(eml[niv]\)[
                            l]], \((#1 =!= 0)\) &]]]]; 
              k]; 
\(awec[niv_, ind_]\)[
              x_ + y_] := \(awec[niv, ind]\)[x] + \(awec[niv, ind]\)[
                y]; \(awec[niv_, ind_]\)[x_Integer*y_] := 
            multiplicar[x, \(awec[niv, ind]\)[y]]; \(awec[niv_, ind_]\)[0] := 
            0; 
\(awec[niv_, ind_]\)[l_] := 
            aw[sumatorio[
                NestWhileList[compo[niv, ind], 
                  nul1[l], \((#1 =!= 0)\) &]]]; 
\(emlec[niv_, ind_]\)[
              x_ + y_] := \(emlec[niv, ind]\)[x] + \(emlec[niv, ind]\)[
                y]; \(emlec[niv_, ind_]\)[x_Integer*y_] := 
            multiplicar[x, \(emlec[niv, ind]\)[y]]; \(emlec[niv_, ind_]\)[0] := 
            0; 
\(emlec[niv_, 4]\)[l_] := 
            Module[{k, l1, l2}, l1 = l[\([1]\)]; l2 = l[\([2]\)]; 
              k = \(eml[niv]\)[nul2[l]]; 
              If[Length[l2] == 0 || 
                  Apply[Plus, Map[Abs, Flatten[{l2[\([1]\)]}]]] == 0, 
                Null, k = 
                  k - \(shi[niv]\)[
                      sumatorio[
                        NestWhileList[
                          compo[niv, 4], \(deltauec[niv, 4]\)[
                            k], \((#1 =!= 0)\) &]]]]; 
              k]; 
\(emlec[niv_, 5]\)[l_] := 
            Module[{k, l1, l2}, l1 = l[\([1]\)]; l2 = l[\([2]\)]; 
              k = \(eml[niv]\)[nul2[l]]; 
              If[Length[l1] == 0 || 
                  Apply[Plus, Map[Abs, Flatten[{l1[\([1]\)]}]]] == 0, 
                Null, k = 
                  k - \(shi[niv]\)[
                      sumatorio[
                        NestWhileList[
                          compo[niv, 5], \(deltauec[niv, 5]\)[
                            k], \((#1 =!= 0)\) &]]]]; 
              k]; 
\(shiec[niv_, ind_]\)[
              x_ + y_] := \(shiec[niv, ind]\)[x] + \(shiec[niv, ind]\)[
                y]; \(shiec[niv_, ind_]\)[x_Integer*y_] := 
            multiplicar[x, \(shiec[niv, ind]\)[y]]; \(shiec[niv_, ind_]\)[0] := 
            0; 
\(shiec[niv_, ind_]\)[l_] := \(shi[niv]\)[
              sumatorio[
                NestWhileList[compo[niv, ind], 
                  nul1[l], \((#1 =!= 0)\) &]]]; 

          pegar[x_ + y_, z_] := pegar[x, z] + pegar[y, z]; 
          pegar[x_Integer*y_, z_] := multiplicar[x, pegar[y, z]]; 
          pegar[0, z_] := 0; 

          pegar[z_, x_ + y_] := pegar[z, x] + pegar[z, y]; 
          pegar[z_, x_Integer*y_] := multiplicar[x, pegar[z, y]]; 
          pegar[z_, 0] := 0; 

          pegar[l_, k_] := 
            Join[l, k]; 
\(fmodban[niv_]\)[
              x_ + y_] := \(fmodban[niv]\)[x] + \(fmodban[niv]\)[
                y]; \(fmodban[niv_]\)[x_Integer*y_] := 
            multiplicar[x, \(fmodban[niv]\)[y]]; \(fmodban[niv_]\)[0] := 
            0; 
\(fmodban[niv_]\)[l_] := 
            pegar[\(fa[niv]\)[l[\([1]\)]], \(fg[niv]\)[l[\([2]\)]]]; 

          union[x_ + y_, z_] := union[x, z] + union[y, z]; 
          union[x_Integer*y_, z_] := multiplicar[x, union[y, z]]; 
          union[0, z_] := 0; 

          union[z_, x_ + y_] := union[z, x] + union[z, y]; 
          union[z_, x_Integer*y_] := multiplicar[x, union[z, y]]; 
          union[z_, 0] := 0; 

          union[l_, k_] := {l, k}; 
\(gmodban[niv_]\)[
              x_ + y_] := \(gmodban[niv]\)[x] + \(gmodban[niv]\)[
                y]; \(gmodban[niv_]\)[x_Integer*y_] := 
            multiplicar[x, \(gmodban[niv]\)[y]]; \(gmodban[niv_]\)[0] := 
            0; 
\(gmodban[niv_]\)[l_] := 
            union[\(ga[niv]\)[Take[l, hojimb[\([niv, 1]\)]]], \(gg[niv]\)[
                Take[l, \(-hojimb[\([niv, 2]\)]\)]]]; 
\(fimodban[niv_]\)[
              x_ + y_] := \(fimodban[niv]\)[x] + \(fimodban[niv]\)[
                y]; \(fimodban[niv_]\)[x_Integer*y_] := 
            multiplicar[x, \(fimodban[niv]\)[y]]; \(fimodban[niv_]\)[0] := 
            0; 
\(fimodban[niv_]\)[l_] := 
            multiplicar[\((\(-1\))\)^Length[l[\([1]\)]], 
                union[l[\([1]\)], \(fig[niv]\)[l[\([2]\)]]]] + 
              union[\(fia[niv]\)[
                  l[\([1]\)]], \(gg[niv]\)[\(fg[niv]\)[
                    l[\([2]\)]]]]; 
\(compomodec[niv_, ind_]\)[
              x_ + y_] := \(compomodec[niv, ind]\)[
                x] + \(compomodec[niv, ind]\)[y]; \(compomodec[niv_, ind_]\)[
              x_Integer*y_] := 
            multiplicar[
              x, \(compomodec[niv, ind]\)[y]]; \(compomodec[niv_, ind_]\)[
              0] = 0; 
\(compomodec[niv_, ind_]\)[
              l_] := \(difteztec[niv, ind]\)[\(fimodban[niv]\)[
                l]]; 
\(difmodec[niv_, ind_]\)[
              x_ + y_] := \(difmodec[niv, ind]\)[x] + \(difmodec[niv, ind]\)[
                y]; \(difmodec[niv_, ind_]\)[x_Integer*y_] := 
            multiplicar[
              x, \(difmodec[niv, ind]\)[y]]; \(difmodec[niv_, ind_]\)[0] = 
            0; 
\(difmodec[niv_, ind_]\)[l_] := \(fmodban[niv]\)[
              sumatorio[
                NestWhileList[
                  compomodec[niv, 
                    ind], \(difteztec[niv, ind]\)[\(gmodban[niv]\)[
                      l]], \((#1 =!= 0)\) &]]]; 
\(fmodec[niv_, ind_]\)[
              x_ + y_] := \(fmodec[niv, ind]\)[x] + \(fmodec[niv, ind]\)[
                y]; \(fmodec[niv_, ind_]\)[x_Integer*y_] := 
            multiplicar[x, \(fmodec[niv, ind]\)[y]]; \(fmodec[niv_, ind_]\)[
              0] := 0; 
\(fmodec[niv_, ind_]\)[l_] := \(fmodban[niv]\)[
              sumatorio[
                NestWhileList[compomodec[niv, ind], 
                  l, \((#1 =!= 0)\) &]]]; 
\(gmodec[niv_, ind_]\)[
              x_ + y_] := \(gmodec[niv, ind]\)[x] + \(gmodec[niv, ind]\)[
                y]; \(gmodec[niv_, ind_]\)[x_Integer*y_] := 
            multiplicar[x, \(gmodec[niv, ind]\)[y]]; \(gmodec[niv_, ind_]\)[
              0] := 0; 
\(gmodec[niv_, ind_]\)[
              l_] := \(gmodban[niv]\)[l] - \(fimodban[niv]\)[
                sumatorio[
                  NestWhileList[
                    compomodec[niv, 
                      ind], \(difteztec[niv, ind]\)[\(gmodban[niv]\)[
                        l]], \((#1 =!= 0)\) &]]]; 
\(fimodec[niv_, ind_]\)[
              x_ + y_] := \(fimodec[niv, ind]\)[x] + \(fimodec[niv, ind]\)[
                y]; \(fimodec[niv_, ind_]\)[x_Integer*y_] := 
            multiplicar[x, \(fimodec[niv, ind]\)[y]]; \(fimodec[niv_, ind_]\)[
              0] := 0; 
\(fimodec[niv_, ind_]\)[l_] := \(fimodban[niv]\)[
              sumatorio[
                NestWhileList[compomodec[niv, ind], 
                  l, \((#1 =!= 0)\) &]]]; 
\(isoec[niv_, ind_]\)[
              x_ + y_] := \(isoec[niv, ind]\)[x] + \(isoec[niv, ind]\)[
                y]; \(isoec[niv_, ind_]\)[x_Integer*y_] := 
            multiplicar[x, \(isoec[niv, ind]\)[y]]; \(isoec[niv_, ind_]\)[0] := 
            0; 
\(isoec[niv_, ind_]\)[{}] := {{}, {}}; 
\(isoec[niv_, 4]\)[
              l_] := Module[{k, n}, n = Length[l]; 
              k = {}; 
k = 
                Transpose[l]; 
{Prepend[
                  Table[\(proda[niv]\)[
                      k[\([1, i]\)], \(chi[niv]\)[k[\([2, i]\)], 
                        Fold[prodg[niv], 0, 
                          Reverse[Take[k[\([2]\)], i - 1]]]]], {i, 2, n}], 
                  k[\([1, 1]\)]], k[\([2]\)]}]; 
\(isoec[niv_, 5]\)[l_] := 
            Module[{k, n}, n = Length[l]; 
              k = {}; 
k = 
                Transpose[l]; 
{k[\([1]\)], 
                Prepend[
                  Table[\(prodg[niv]\)[
                      k[\([2, i]\)], \(chi[niv]\)[k[\([1, i]\)], 
                        Fold[proda[niv], 0, 
                          Reverse[Take[k[\([1]\)], i - 1]]]]], {i, 2, n}], 
                  k[\([2, 1]\)]]}]; 
\(invisoec[niv_, ind_]\)[
              x_ + y_] := \(invisoec[niv, ind]\)[x] + \(invisoec[niv, ind]\)[
                y]; \(invisoec[niv_, ind_]\)[x_Integer*y_] := 
            multiplicar[
              x, \(invisoec[niv, ind]\)[y]]; \(invisoec[niv_, ind_]\)[0] := 
            0; 
\(invisoec[niv_, ind_]\)[{{}, {}}] := {}; \(invisoec[niv_, 
                4]\)[l_] := 
            Prepend[Table[{\(proda[niv]\)[
                    l[\([1, i]\)], \(inversosa[niv]\)[\(chi[niv]\)[
                        l[\([2, i]\)], 
                        Fold[prodg[niv], 0, 
                          Reverse[Take[l[\([2]\)], i - 1]]]]]], 
                  l[\([2, i]\)]}, {i, 2, 
                  Length[l[\([1]\)]]}], {l[\([1, 1]\)], 
                l[\([2, 1]\)]}]; 
\(invisoec[niv_, 5]\)[l_] := 
            Prepend[Table[{l[\([1, i]\)], \(prodg[niv]\)[
                    l[\([2, i]\)], \(inversosg[niv]\)[\(chi[niv]\)[
                        l[\([1, i]\)], 
                        Fold[proda[niv], 0, 
                          Reverse[Take[l[\([1]\)], i - 1]]]]]]}, {i, 2, 
                  Length[l[\([2]\)]]}], {l[\([1, 1]\)], 
                l[\([2, 1]\)]}]; 
\(isobar[arb_]\)[
              x_ + y_] := \(isobar[arb]\)[x] + \(isobar[arb]\)[y]; \(isobar[
                arb_]\)[x_Integer*y_] := 
            multiplicar[x, \(isobar[arb]\)[y]]; \(isobar[arb_]\)[0] := 
            0; \(isobar[1]\)[l_] := 
            multiplicar[\((\(-1\))\)^\((Ceiling[Length[l]/2] + 1)\), 
              Reverse[l]]; 
\(isobar[0]\)[l_] := 
            l; 
 (*

*) 
 (*\ 
            Codifying\ the\ homological\ model\ for\ semidirect\ products\ *) 
 (*

*) 
\(deltaups[niv_, ind_]\)[
              x_ + y_] := \(deltaups[niv, ind]\)[x] + \(deltaups[niv, ind]\)[
                y]; \(deltaups[niv_, ind_]\)[x_Integer*y_] := 
            multiplicar[
              x, \(deltaups[niv, ind]\)[y]]; \(deltaups[niv_, ind_]\)[0] = 
            0; 
\(deltaupssimple[niv_, ind_]\)[
              x_ + y_] := \(deltaupssimple[niv, ind]\)[
                x] + \(deltaupssimple[niv, ind]\)[y]; \(deltaupssimple[niv_, 
                ind_]\)[x_Integer*y_] := 
            multiplicar[
              x, \(deltaupssimple[niv, ind]\)[y]]; \(deltaupssimple[niv_, 
                ind_]\)[0] = 0; 
\(deltaupssimple[niv_, ind_]\)[{{}, {}}] := 
            0; 
\(deltaupssimple[niv_, 2]\)[
              l_] := {Table[\(chi[niv]\)[l[\([2, 1]\)], 
                  l[\([1, i + 1]\)]], {i, Length[l[\([1]\)]] - 1}], 
              Rest[l[\([2]\)]]}; 
\(deltaupssimple[niv_, 3]\)[
              l_] := {Rest[l[\([1]\)]], 
              Table[\(chi[niv]\)[l[\([1, 1]\)], l[\([2, i + 1]\)]], {i, 
                  Length[l[\([2]\)]] - 1}]}; 
\(deltaups[niv_, 2]\)[l_] := 
            Module[{n, l1, l2, k}, l1 = l[\([1]\)]; l2 = l[\([2]\)]; 
              n = Length[l1]; 
              If[n < 2 || 
Apply[Plus, 
                      Map[Abs, Flatten[{l2[\([1]\)]}]]] == 0, k = 0, 
                k = \(deltaupssimple[niv, 2]\)[l] - {Rest[l1], Rest[l2]}]; 
              k]; 
\(deltaups[niv_, 3]\)[l_] := 
            Module[{n, l1, l2, k}, l1 = l[\([1]\)]; l2 = l[\([2]\)]; 
              n = Length[l2]; 
              If[n < 2 || 
                  Apply[Plus, Map[Abs, Flatten[{l1[\([1]\)]}]]] == 0, 
                k = 0, k = \(deltaupssimple[niv, 3]\)[l] - {Rest[l1], 
                      Rest[l2]}]; k]; 
\(compops[niv_, ind_]\)[
              x_ + y_] := \(compops[niv, ind]\)[x] + \(compops[niv, ind]\)[
                y]; \(compops[niv_, ind_]\)[x_Integer*y_] := 
            multiplicar[x, \(compops[niv, ind]\)[y]]; \(compops[niv_, ind_]\)[
              0] = 0; \(compops[niv_, ind_]\)[
              l_] := \(deltaups[niv, ind]\)[\(shi[niv]\)[l]]; 
\(difteztps[
                niv_, ind_]\)[
              x_ + y_] := \(difteztps[niv, ind]\)[
                x] + \(difteztps[niv, ind]\)[y]; \(difteztps[niv_, ind_]\)[
              x_Integer*y_] := 
            multiplicar[
              x, \(difteztps[niv, ind]\)[y]]; \(difteztps[niv_, ind_]\)[0] = 
            0; \(difteztps[niv_, 2]\)[l_] := 
            Module[{p, q, l1, l2, k}, l1 = l[\([1]\)]; l2 = l[\([2]\)]; 
              p = Length[l1]; q = Length[l2]; 
              If[q == 0 || 
                  Apply[Plus, Map[Abs, Flatten[{l2[\([1]\)]}]]] == 0, 
                k = 0, k = 
                  multiplicar[\((\(-1\))\)^
                      p, \(({Table[\(chi[niv]\)[l2[\([1]\)], 
                              l1[\([i]\)]], {i, p}], Rest[l2]} - {l1, 
                          Rest[l2]})\)]]; k]; 
\(difteztps[niv_, 3]\)[l_] := 
            Module[{p, q, l1, l2, k}, l1 = l[\([1]\)]; l2 = l[\([2]\)]; 
              p = Length[l1]; q = Length[l2]; 
              If[p == 0 || 
                  Apply[Plus, Map[Abs, Flatten[{Last[l1]}]]] == 0, 
                k = 0, k = 
                  multiplicar[\((\(-1\))\)^
                      p, \(({Drop[l1, \(-1\)], 
                          Table[\(chi[niv]\)[Last[l1], l2[\([i]\)]], {i, 
                              q}]} - {Drop[l1, \(-1\)], l2})\)]]; 
              k]; 
\(awps[niv_, ind_]\)[
              x_ + y_] := \(awps[niv, ind]\)[x] + \(awps[niv, ind]\)[
                y]; \(awps[niv_, ind_]\)[x_Integer*y_] := 
            multiplicar[x, \(awps[niv, ind]\)[y]]; \(awps[niv_, ind_]\)[0] := 
            0; 
\(awps[niv_, ind_]\)[l_] := 
            aw[sumatorio[
                NestWhileList[compops[niv, ind], 
                  nul1[l], \((#1 =!= 0)\) &]]]; 
\(emlps[niv_, ind_]\)[
              x_ + y_] := \(emlps[niv, ind]\)[x] + \(emlps[niv, ind]\)[
                y]; \(emlps[niv_, ind_]\)[x_Integer*y_] := 
            multiplicar[x, \(emlps[niv, ind]\)[y]]; \(emlps[niv_, ind_]\)[0] := 
            0; 
\(emlps[niv_, 2]\)[l_] := 
            Module[{k, l1, l2}, k = \(eml[niv]\)[nul2[l]]; l1 = l[\([1]\)]; 
              l2 = l[\([2]\)]; 
              If[Length[l2] == 0 || 
                  Apply[Plus, Map[Abs, Flatten[{l2[\([1]\)]}]]] == 0, 
                Null, k = 
                  k - \(shi[niv]\)[
                      sumatorio[
                        NestWhileList[
                          compops[niv, 2], \(deltaups[niv, 2]\)[
                            k], \((#1 =!= 0)\) &]]]]; 
              k]; 
\(emlps[niv_, 3]\)[l_] := 
            Module[{k, l1, l2}, k = \(eml[niv]\)[nul2[l]]; l1 = l[\([1]\)]; 
              l2 = l[\([2]\)]; 
              If[Length[l1] == 0 || 
                  Apply[Plus, Map[Abs, Flatten[{l1[\([1]\)]}]]] == 0, 
                Null, k = 
                  k - \(shi[niv]\)[
                      sumatorio[
                        NestWhileList[
                          compops[niv, 3], \(deltaups[niv, 3]\)[
                            k], \((#1 =!= 0)\) &]]]]; 
              k]; 
\(ships[niv_, ind_]\)[
              x_ + y_] := \(ships[niv, ind]\)[x] + \(ships[niv, ind]\)[
                y]; \(ships[niv_, ind_]\)[x_Integer*y_] := 
            multiplicar[x, \(ships[niv, ind]\)[y]]; \(ships[niv_, ind_]\)[0] := 
            0; 
\(ships[niv_, ind_]\)[l_] := \(shi[niv]\)[
              sumatorio[
                NestWhileList[compops[niv, ind], 
                  nul1[l], \((#1 =!= 0)\) &]]]; 
\(compomodps[niv_, ind_]\)[
              x_ + y_] := \(compomodps[niv, ind]\)[
                x] + \(compomodps[niv, ind]\)[y]; \(compomodps[niv_, ind_]\)[
              x_Integer*y_] := 
            multiplicar[
              x, \(compomodps[niv, ind]\)[y]]; \(compomodps[niv_, ind_]\)[
              0] = 0; 
\(compomodps[niv_, ind_]\)[
              l_] := \(difteztps[niv, ind]\)[\(fimodban[niv]\)[
                l]]; 
\(difmodps[niv_, ind_]\)[
              x_ + y_] := \(difmodps[niv, ind]\)[x] + \(difmodps[niv, ind]\)[
                y]; \(difmodps[niv_, ind_]\)[x_Integer*y_] := 
            multiplicar[
              x, \(difmodps[niv, ind]\)[y]]; \(difmodps[niv_, ind_]\)[0] = 
            0; 
\(difmodps[niv_, ind_]\)[l_] := \(fmodban[niv]\)[
              sumatorio[
                NestWhileList[
                  compomodps[niv, 
                    ind], \(difteztps[niv, ind]\)[\(gmodban[niv]\)[
                      l]], \((#1 =!= 0)\) &]]]; 
\(fmodps[niv_, ind_]\)[
              x_ + y_] := \(fmodps[niv, ind]\)[x] + \(fmodps[niv, ind]\)[
                y]; \(fmodps[niv_, ind_]\)[x_Integer*y_] := 
            multiplicar[x, \(fmodps[niv, ind]\)[y]]; \(fmodps[niv_, ind_]\)[
              0] := 0; 
\(fmodps[niv_, ind_]\)[l_] := \(fmodban[niv]\)[
              sumatorio[
                NestWhileList[compomodps[niv, ind], 
                  l, \((#1 =!= 0)\) &]]]; 
\(gmodps[niv_, ind_]\)[
              x_ + y_] := \(gmodps[niv, ind]\)[x] + \(gmodps[niv, ind]\)[
                y]; \(gmodps[niv_, ind_]\)[x_Integer*y_] := 
            multiplicar[x, \(gmodps[niv, ind]\)[y]]; \(gmodps[niv_, ind_]\)[
              0] := 0; 
\(gmodps[niv_, ind_]\)[
              l_] := \(gmodban[niv]\)[l] - \(fimodban[niv]\)[
                sumatorio[
                  NestWhileList[
                    compomodps[niv, 
                      ind], \(difteztps[niv, ind]\)[\(gmodban[niv]\)[
                        l]], \((#1 =!= 0)\) &]]]; 
\(fimodps[niv_, ind_]\)[
              x_ + y_] := \(fimodps[niv, ind]\)[x] + \(fimodps[niv, ind]\)[
                y]; \(fimodps[niv_, ind_]\)[x_Integer*y_] := 
            multiplicar[x, \(fimodps[niv, ind]\)[y]]; \(fimodps[niv_, ind_]\)[
              0] := 0; 
\(fimodps[niv_, ind_]\)[l_] := \(fimodban[niv]\)[
              sumatorio[
                NestWhileList[compomodps[niv, ind], 
                  l, \((#1 =!= 0)\) &]]]; 
\(isops[niv_, ind_]\)[
              x_ + y_] := \(isops[niv, ind]\)[x] + \(isops[niv, ind]\)[
                y]; \(isops[niv_, ind_]\)[x_Integer*y_] := 
            multiplicar[x, \(isops[niv, ind]\)[y]]; \(isops[niv_, ind_]\)[0] := 
            0; 
\(isops[niv_, ind_]\)[{}] := {{}, {}}; 
\(isops[niv_, 2]\)[
              l_] := Module[{k, n, x1, x2}, n = Length[l]; 
              k = {}; 
k = 
                Transpose[
                  l]; 
{Table[\(chi[niv]\)[
                    Fold[prodg[niv], 0, 
                      Table[\(inversosg[niv]\)[k[\([2, j]\)]], {j, i}]], 
                    k[\([1, i]\)]], {i, n}], k[\([2]\)]}]; 
\(isops[niv_, 
                3]\)[l_] := 
            Module[{k, n, x1, x2}, n = Length[l]; k = {}; 
              k = Transpose[l]; 
{k[\([1]\)], 
                Table[\(chi[niv]\)[
                    Fold[proda[niv], 0, 
                      Table[\(inversosa[niv]\)[k[\([1, j]\)]], {j, i}]], 
                    k[\([2, i]\)]], {i, n}]}]; 
\(invisops[niv_, ind_]\)[
              x_ + y_] := \(invisops[niv, ind]\)[x] + \(invisops[niv, ind]\)[
                y]; \(invisops[niv_, ind_]\)[x_Integer*y_] := 
            multiplicar[
              x, \(invisops[niv, ind]\)[y]]; \(invisops[niv_, ind_]\)[0] := 
            0; 
\(invisops[niv_, ind_]\)[{{}, {}}] := {}; 
\(invisops[niv_, 
                2]\)[l_] := 
Table[{\(chi[niv]\)[
                  Fold[prodg[niv], 0, Reverse[Take[l[\([2]\)], i]]], 
                  l[\([1, i]\)]], l[\([2, i]\)]}, {i, 
                Length[l[\([1]\)]]}]; 
\(invisops[niv_, 3]\)[
              l_] := 
Table[{l[\([1, i]\)], \(chi[niv]\)[
                  Fold[proda[niv], 0, Reverse[Take[l[\([1]\)], i]]], 
                  l[\([2, i]\)]]}, {i, 
                Length[l[\([2]\)]]}]; 
 (*

*) 
 (*\ 
            Codifying\ the\ homological\ model\ for\ direct\ products\ *) 
 (*

*) 
\(isopd[
                niv_]\)[
              x_ + y_] := \(isopd[niv]\)[x] + \(isopd[niv]\)[y]; \(isopd[
                niv_]\)[x_Integer*y_] := 
            multiplicar[x, \(isopd[niv]\)[y]]; \(isopd[niv_]\)[0] := 
            0; 
\(isopd[niv_]\)[{}] := {{}, {}}; 
\(isopd[niv_]\)[l_] := 
            Transpose[l]; 
\(invisopd[niv_]\)[
              x_ + y_] := \(invisopd[niv]\)[x] + \(invisopd[niv]\)[
                y]; \(invisopd[niv_]\)[x_Integer*y_] := 
            multiplicar[x, \(invisopd[niv]\)[y]]; \(invisopd[niv_]\)[0] := 
            0; 
\(invisopd[niv_]\)[{{}, {}}] := {}; 
\(invisopd[niv_]\)[
              l_] := Transpose[
              l]; 
 (*

*) 
 (*\ 
            Codifying\ the\ homological\ model\ for\ abelian\ groups\ *) 
 (*

*) 

          sumarunalista[l_] := Apply[Plus, l]; 

          s[n_, l_] := 
            Module[{m, k}, m = Length[l]; 
              If[Length[
                    Select[Map[sumarunalista, 
                        Partition[l, 2]], #1 < n &]] == 0, 
                If[Mod[m, 2] == 1, k = Last[l], k = 1], k = 0]; 
              k]; 
\(fzn[n_]\)[
              x_ + y_] := \(fzn[n]\)[x] + \(fzn[n]\)[y]; \(fzn[n_]\)[
              x_Integer*y_] := multiplicar[x, \(fzn[n]\)[y]]; \(fzn[n_]\)[0] := 
            0; 
\(fzn[0]\)[l_] := 
            If[Length[l] == 1, multiplicar[l[\([1]\)], {1}], 
              0]; 
\(fzn[n_]\)[l_] := 
            multiplicar[s[n, l], {Length[l]}]; 
\(base1[n_]\)[l_] := 
            Table[Join[{1, i}, l], {i, 1, n - 1}]; 
\(base2[n_]\)[l_] := 
            Flatten[Map[base1[n], l], 1]; 
\(gzn[n_]\)[
              x_ + y_] := \(gzn[n]\)[x] + \(gzn[n]\)[y]; \(gzn[n_]\)[
              x_Integer*y_] := multiplicar[x, \(gzn[n]\)[y]]; \(gzn[n_]\)[0] := 
            0; 
\(gzn[0]\)[l_] := 
            If[l == {1}, l, 0]; 
\(gzn[n_]\)[l_] := 
            Module[{k}, 
              If[Mod[l[\([1]\)], 2] == 1, k = {{1}}, k = {{}}]; 
              Apply[Plus, Nest[base2[n], k, Floor[l[\([1]\)]/2]]]]; 
\(fi2[
                n_]\)[x_ + y_] := \(fi2[n]\)[x] + \(fi2[n]\)[y]; \(fi2[n_]\)[
              x_Integer*y_] := multiplicar[x, \(fi2[n]\)[y]]; \(fi2[n_]\)[0] := 
            0; 
\(fi2[0]\)[l_] := 
            If[Abs[Last[l]] ≤ 1, 
              0, \(-\((\(-1\))\)^Length[l]\)*
                Apply[Plus, 
                  Table[Join[Drop[l, \(-1\)], {Sign[Last[l]]*i, 1}], {i, 
                      Abs[Last[l]] - 1}]]]; 
\(fizn[n_]\)[l_] := 
            multiplicar[\(-1\), \(fi2[n]\)[l]]; 
\(fi2[n_]\)[{}] = 
            0; 
\(fi2[n_]\)[l_] := 
            Module[{k}, 
              k = Apply[Plus, 
                  Table[Join[{1, i}, Rest[l]], {i, 1, 
                      l[\([1]\)] - 1}]]; 
If[
                l[\([1]\)] + \(Append[l, 0]\)[\([2]\)] < n, Null, 
                k = k + 
                    pegar[Apply[Plus, 
                        Table[{1, i}, {i, 1, n - 1}]], \(fi2[n]\)[
                        Drop[l, 2]]]]; k]; 
\(difzn[n_]\)[
              x_ + y_] := \(difzn[n]\)[x] + \(difzn[n]\)[y]; \(difzn[n_]\)[
              x_Integer*y_] := 
            multiplicar[x, \(difzn[n]\)[y]]; \(difzn[n_]\)[{0}] := 
            0; 
\(difzn[0]\)[l_] := 0; 
\(difzn[n_]\)[l_] := 
            multiplicar[
              Mod[1 + l[\([1]\)], 2]*
                n, {l[\([1]\)] - 
                  1}]; 
 (*

*) 
 (*\ 
            Codifying\ the\ basis\ for\ the\ homological\ model\ *) 
 (*

*) 
 (*\ 
            The\ function\ basemod[q, p]\ generates\ such\ a\ basis, \ 
            attending\ to\ the\ ordering\ {{0,  ... , 0, q}, {0,  ... , 1, 
                    q - 1},  ... , {q, 0,  ... , 
                    0}} . \ \ Entries\ corresponding\ to\ infinite\ factor\ groups\ must\ be\ 0\ or\ 1. \ The\ function\ basemod\ is\ to\ be\ called\ only\ twice . \ 
                Both\ times\ the\ function\ is\ affected\ by\ a\ Reverse\ command, \ so\ that\ the\ basis\ to\ be\ considered\ are\ of\ the\ type\ {{q, 
                  0,  ... , 0}, {q - 1, 1,  ... , 0},  ... , {0, 0,  ... , 
                  q}}\ *) 
 (*
*) 
\(juntar[l_]\)[k_] := Join[l, k]; 

          basemod[0, car_List] := {Table[0, {i, Length[car]}]}; 

          basemod[q_, {car_}] := 
            If[car == 0, If[q == 1, {{1}}, {}], {{q}}]; 

          basemod[q_Integer, car_List] := 
            Flatten[Table[
                Map[juntar[{i}], basemod[q - i, Rest[car]]], {i, 0, 
                  Min[q, car[\([1]\)]*q + 1]}], 1]; 

          coef[l_] := 
            If[VectorQ[l], {1, l}, {l[\([1]\)], 
                l[\([2]\)]}]; 
 (*

We\ include\ now\ the\ IntegerSmithNormalForm\ package, \ 
            due\ to\ V . \ Alvarez\ et\ al, \ 
            2006. 

*) 

          M[i_, j_, t_, k_] := 
            ReplacePart[IdentityMatrix[k], 
              t, {i, j}]; 
\(T[i_, j_, k_] := 
                Module[{m, n}, m = IdentityMatrix[k]; n = m[\([i]\)]; 
                  m[\([i]\)] = m[\([j]\)]; m[\([j]\)] = n; 
                  m];\)
\(Completar[C_, m_, n_] := 
                Module[{k, i, j, ii}, i = m - Length[C]; k = {}; 
                  Do[k = Append[k, Table[0, {ii, 1, n}]], {j, 1, i}]; 
                  Do[k = Append[k, 
                        Join[Table[0, {ii, 1, n - Length[C[\([1]\)]]}], 
                          C[\([j]\)]]], {j, 1, Length[C]}]; 
                  k];\)
\(ExtendedSmithForm[A_] := 
              Module[{k, C, coli, colj, P, Q, m, n, H, i, it, control}, 
                m = Length[A]; n = Length[A[\([1]\)]]; 
                P = {IdentityMatrix[m]}; Q = {IdentityMatrix[n]}; C = A; 
                i = 1; Fin = 
                  Max[Abs[Take[C, {i, m}, {i, n}]]] > 
                    0; 
While[
                  Fin, {coli, 
                      colj} = \(Position[
                        Completar[Take[Abs[C], {i, m}, {i, n}], m, n], 
                        Min[Select[
                            Flatten[
                              Take[Abs[C], {i, m}, {i, n}]], #1 > 
                                0 &]]]\)[\([1]\)]; 
                  P = Prepend[P, T[i, coli, m]]; 
                  Q = Append[Q, T[i, colj, n]]; it = i + 1; 
                  C = First[P] . C . Last[Q]; 
                  control = True; 
While[it ≤ n, 
                    If[IntegerQ[C[\([i, it]\)]/C[\([i, i]\)]], it = it + 1, 
                      Q = Append[Q, 
                          M[i, it, \(-Quotient[C[\([i, it]\)], 
                                  C[\([i, i]\)]]\), n] . T[it, i, n]]; 
                      C = C . Last[Q]; control = False; 
                      it = n + 1]
]; 
                  If[control, 
                    Do[Q = Append[Q, 
                          M[i, it, \(-C[\([i, it]\)]\)/C[\([i, i]\)], n]]; 
                      C = C . Last[Q], {it, i + 1, n}]; 
                    it = i + 1; 
While[it ≤ m, 
                      If[IntegerQ[C[\([it, i]\)]/C[\([i, i]\)]], it = it + 1, 
                        P = Prepend[P, 
                            T[it, i, m] . 
                              M[it, i, \(-Quotient[C[\([it, i]\)], 
                                    C[\([i, i]\)]]\), m]]; C = First[P] . C; 
                        control = False; it = m + 1]
]; 
                    If[control, 
                      Do[P = Prepend[P, 
                            M[it, i, \(-C[\([it, i]\)]\)/C[\([i, i]\)], m]]; 
                        C = First[P] . C, {it, i + 1, 
                          m}]; 
Catch[
                        Do[
Do[
                            If[IntegerQ[C[\([coli, colj]\)]/C[\([i, i]\)]], , 
                              P = Prepend[P, M[i, coli, 1, m]]; 
                              C = First[P] . C; control = False; 
                              Throw[False]], {colj, i + 1, n}], {coli, i + 1, 
                            m}]; Throw[True]]; 
                      If[\ control, 
                        P = Prepend[P, M[i, i, Sign[C[\([i, i]\)]], m]]; 
                        C = First[P] . C; i = i + 1; 
                        Fin = Max[Abs[Take[C, {i, m}, {i, n}]]] > 
                            0]
];
];
]; 
P = Fold[Dot, IdentityMatrix[m], P]; 
                Q = Fold[Dot, IdentityMatrix[n], Q]; {C, {P, 
                    Q}}
]\); 
 (*\({numgru, hojimb, aux, pos, imbestratos, imbprec, infoarbol, indices, i3, 
              i4, a1, g1, niv, posest, arbol2, b1, b2, primbase, segbase, 
              baseaux, hom, nhomol, A, B, k, k1, k2, homologia, nucleo, 
              fnsa1, fnsa2}\)\(,\)*) 
 (*\(Print["The program requires three input data: the tree-list representing the iterated product, as well as the list of cardinalities of the factor groups implicated (from left to the right) and the degree of the homology group to compute. In order to introduce the binary tree representing the group, starting from the root vertex, you have to cover all levels (from top to bottom, from left to right at the same level), attending to the following notation: 0, if it is a leaf vertex (i.e. represents a group Z or Zn); 1, if the vertex represents a direct product A x G; 2, if the vertex represents a semidirect product A x_chi G, for G being the structural groupm chi:G x G --->A; 3, if the vertex represents a semidirect product A x_chi G, for A  being the structural group, chi:A x A --->G; 4, if the vertex represents a central extension A x_chi G, for A being the image of the 2-cocycle chi:G x G --->A; and 5, if the vertex represents a central extension A x_chi G, for G  being the image of the 2-cocycle chi:A x A --->G. Each level must be introduced in a different list. For instance, if chi[2]: G x G ---> A is a 2-cocycle and chi[1]: H x (A x_chi[2] G) ---> A x_chi[2] G is an action, the iterated product (A x_chi[2] G) x_chi[1] H will be represented by the list {{2},{4,0}}. The maps chi[niv] must be provided by the user."];\)*) 
 (*\ \(arbol = 
                Input["Please, introduce the normalized list of vertices of the tree "];\)*) 

          numgru = 
            1 + Length[
                Select[Flatten[arbol, 1], #1 =!= 0 &]]; 
 (*card = {}; 
            Do[Print["Number of elements of the group ", 
                i, " starting from the left (k>1 means Z_k, 0 for Z)..."]; card = Append[card, Input["Cardinal "]], {i, numgru}];*) 

          hojimb = 
            Table[{1, 1}, {i, 
                Length[Last[arbol]] - Count[Last[arbol], 0]}]; 

          Do[aux = sumlist[arbol[\([i]\)], 1]; 
            pos = Complement[Range[Length[aux]], 
                Flatten[Position[aux, 1], 1]]; 
Do[
              aux[\([pos[\([j]\)]]\)] = 
                hojimb[\([j, 1]\)] + hojimb[\([j, 2]\)], {j, Length[pos]}]; 
            hojimb = Join[Partition[aux, 2], hojimb], {i, Length[arbol], 
              2, \(-1\)}]; 
          imbestratos = 
            Table[Select[arbol[\([i]\)], #1 =!= 0 &], {i, Length[arbol]}]; 

          imbprec = 
            Append[Table[
                Apply[Plus, 
                  Table[Length[imbestratos[\([j]\)]], {j, i - 1}]], {i, 
                  Length[arbol]}], 
              numgru - 1]; 
infoarbol = {}; 
          arbol2 = Append[arbol, Table[0, {i, 2*Length[Last[imbestratos]]}]]; 
          indices = card; 
          niv = 1; 
Do[pos = 0; 
            posest = 
              imbprec[\([i + 
                    1]\)]; 
Do[
a1 = 
                hojimb[\([niv, 1]\)]; 
              g1 = hojimb[\([niv, 2]\)]; 
 (*\(Which[
                    imbestratos[\([i, j]\)] == 1, 
                    Null, 
imbestratos[\([i, j]\)] == 
                      2, 
Print["Have you defined the action chi[", niv, "]:G x A --> A yet?"]; 
                    preg = Input["Please, introduce 1 if you want to define it now"]; If[preg == 1, 
                      Do[Do[Print["Please, introduce the value of chi[", 
                            niv, "][", fil, ",", 
                            col, "]"]; \(chi[niv]\)[fil, col] = 
                            Input["Value: "], {col, carda[niv]}], {fil, 
                          cardg[niv]}]], 
                    imbestratos[\([i, j]\)] == 
                      3, 
Print["Have you defined the action chi[", niv, "]:A x G --> G yet?"]; 
                    preg = Input["Please, introduce 1 if you want to define it now"]; If[preg == 1, 
                      Do[Do[Print["Please, introduce the value of chi[", 
                            niv, "][", fil, ",", 
                            col, "]"]; \(chi[niv]\)[fil, col] = 
                            Input["Value: "], {col, cardg[niv]}], {fil, 
                          carda[niv]}]], 
imbestratos[\([i, 
                          j]\)] == 
                      4, 
Print["Have you defined the 2-cocycle chi[", niv, "]:G x G --> A? yet"]; 
                    preg = Input["Please, introduce 1 if you want to define it now"]; If[preg == 1, 
                      Do[Do[Print["Please, introduce the value of chi[", 
                            niv, "][", fil, ",", 
                            col, "]"]; \(chi[niv]\)[fil, col] = 
                            Input["Value: "], {col, cardg[niv]}], {fil, 
                          cardg[niv]}]], 
imbestratos[\([i, 
                          j]\)] == 
                      5, 
Print["Have you defined the 2-cocycle chi[", niv, "]:A x A --> G yet?"]; 
                    preg = Input["Please, introduce 1 if you want to define it now"]; If[preg == 1, 
                      Do[Do[Print["Please, introduce the value of chi[", 
                            niv, "][", fil, ",", 
                            col, "]"]; \(chi[niv]\)[fil, col] = 
                            Input["Value: "], {col, carda[niv]}], {fil, 
                          carda[niv]}]]];\)*) 
posest = 
                posest + 1; 
Which[a1 == 1, 
                i3 = indices[\([pos + 1]\)]; 
                indices = Drop[indices, {pos + 1}]; pos = pos - 1; 
                posest = posest - 1, 
a1 > 1, i3 = posest]; 
              pos = pos + a1; 
posest = 
                posest + 1; 
Which[g1 == 1, 
                i4 = indices[\([pos + 1]\)]; 
                indices = Drop[indices, {pos + 1}]; pos = pos - 1; 
                posest = posest - 1, 
g1 > 1, i4 = posest]; 
              pos = pos + g1; 
infoarbol = 
                Append[infoarbol, {arbol2[\([i + 1, 2*j - 1]\)], 
                    arbol2[\([i + 1, 2*j]\)], i3, 
                    i4}]; 
niv = niv + 1, {j, 
                Length[imbestratos[\([i]\)]]}]
, {i, 
              Length[imbestratos]}]; 
 (*

*) 
 (*\ 
            Constructing\ the\ diferential\ of\ the\ homological\ model\ *) 
 (*

*) 
elementoneutrodelgrupo[{op_, ca_}] := 
            Module[{gr1, gr2, k}, 
              If[op == 0, k = 0, 
                gr1 = elementoneutrodelgrupo[\(infoarbol[\([ca]\)]\)[\([{1, 
                          3}]\)]]; 
                gr2 = elementoneutrodelgrupo[\(infoarbol[\([ca]\)]\)[\([{2, 
                          4}]\)]]; k = {gr1, gr2}]; k]; 

          If[arbol[\([1, 1]\)] == 0, 
            difarbol[l_] := \(\(dif[card[\([1]\)]]\)[0]\)[l]; 
            prodarbol[x_, y_] := prod[card[\([1]\)], x, y, 0], 
            prodarbol[x_, y_] := prod[1, x, y, arbol[\([1, 1]\)]]; 
            difarbol[l_] := \(\(dif[1]\)[arbol[\([1, 1]\)]]\)[
                l]]; 
 (*

*) 
 (*\ 
            Computing\ the\ \(\(homology\)\(.\)\)\ *) 
 (*

*) 
nhomol = 1; 
          hom = grh; primbase = Reverse[basemod[hom, card]]; 
          b2 = Length[primbase]; 

          If[hom == 0, nucleo = 1; b2 = 1; primbase = {{}}, 
            baseaux = Reverse[basemod[hom - 1, card]]; 

            b1 = Length[baseaux]; 
A = Table[Table[0, {i, b1}], {j, b2}]; 

            Do[
k = {\(-1\)} + 
                  difarbol[primbase[\([i]\)]]; 
k2 = 
                Table[coef[k[\([k1]\)]], {k1, 2, 
                    Length[k]}]; 
Do[
A = 
                  ReplacePart[A, 
                    k2[\([j, 
                        1]\)], {i, \(Position[baseaux, 
                          k2[\([j, 2]\)]]\)[\([1, 1]\)]}], {j, 
                  Length[k2]}], {i, b2}]; 
SetAttributes[Plus, Listable]; 
            SetAttributes[Times, Listable]; 
fnsa1 = 
              ExtendedSmithForm[A];  (*Print[A // MatrixForm]; 
              Print[fnsa1[\([1]\)] // 
                  MatrixForm];*) 
ClearAttributes[Plus, 
              Listable]; 
            ClearAttributes[Times, Listable]; 
nucleo = 
              b2 - Length[
                  Select[Table[
                      fnsa1[\([1, ji, ji]\)], {ji, b1}], #1 > 0 &]]]; 

          While[nhomol == 1, 
b1 = 
              b2; 
segbase = 
              Reverse[basemod[hom + 1, card]]; 
            b2 = Length[segbase]; 
B = 
              Table[Table[0, {i, b1}], {j, b2}]; 

            Do[
k = {\(-1\)} + 
                  difarbol[segbase[\([i]\)]]; 
k2 = 
                Table[coef[k[\([k1]\)]], {k1, 2, 
                    Length[k]}]; 
Do[
B = 
                  ReplacePart[B, 
                    k2[\([j, 
                        1]\)], {i, \(Position[primbase, 
                          k2[\([j, 2]\)]]\)[\([1, 1]\)]}], {j, 
                  Length[k2]}], {i, b2}]; 
If[
              B == {}, 
              homologia = {}, 
SetAttributes[Plus, 
                Listable]; SetAttributes[Times, Listable]; 
              fnsa2 = ExtendedSmithForm[B];  (*Print[B // MatrixForm]; 
                Print[fnsa2[\([1]\)] // 
                    MatrixForm];*) 
ClearAttributes[Plus, 
                Listable]; 
              ClearAttributes[Times, 
                Listable]; 
homologia = 
                Select[Table[
                    fnsa2[\([1, ji, ji]\)], {ji, b1}], #1 > 
                      0 &]]; 
Print["The homology at degree ", hom, " is Z^", nucleo - Length[homologia], " + Z_", 
              Select[homologia, #1 > 1 &]]; hom = hom + 1; 
            nucleo = b2 - Length[Select[homologia, #1 > 0 &]]; 
            primbase = segbase; 
nhomol = 
              Input["Please, introduce 1 for calculating the next homology group, anything else to stop."]]];\)\)\)

End the private context

End[ ]

Epilog

This section ends the package.

End the package context

EndPackage[ ]

Examples, Tests

Examples, tests for the use of the package can go here.

Example 1

Let consider the dihedral group D_4t=Z_2t x_chi[1] Z_2, for the dihedral action chi[1]:Z_2 x Z_2t--->Z_2t given by chi[1][1,b]=-b and b otherwise.These maps should be pre-defined by the user,before calling the function HomologyIteratedGroup.For instance,for t=5,one could type

t = 5; chi[1][g_, b_] := Mod[(1 - 2*g)*b, 2*t];

A tree-list representing the iterated group is given by {{2}}. A list of cardinalities, from left to the right, is {10,2}. If we are interested in computing the homology groups from 0 to 10, we should type

HomologyIteratedGroups[{{2}}, {10, 2}, 0, chi]

Example 2

Let consider the infinite dihedral group Z x_chi[1] Z_2 for the dihedral action chi[1]:Z_2 x Z--->Z given by chi[1][1,b]=-b and b otherwise.These maps should be pre-defined by the user,before calling the function HomologyIteratedGroup.For instance,for t=5,one could type

chi[1][g_, b_] := (1 - 2*g)*b;

A tree-list representing the iterated group is given by {{2}}. A list of cardinalities, from left to the right, is {0,2}. If we are interested in computing the homology groups from 0 to 10, we should type

HomologyIteratedGroups[{{2}}, {0, 2}, 0, chi]

and introduce 1 each time we are asked to going on computing the next homology group.

Example 3

Let consider the iterated product (Z_t x_chi[2] Z_2) x_chi[1] Z_2,for the 2-cocycle chi[2]:Z_2 x Z_2--->Z_t given by chi[2][1,1]=Mod[1+ceiling(t/2),t] and 0 otherwise; and an the dihedral action chi[1]:Z_2 x (Z_t x_chi[2] Z_2)--->(Z_t x_chi[2]_2) given by chi[1][1,{a,g}]=opposite({a,g}) and {a,g} otherwise.These maps should be pre-defined by the user,before calling the function HomologyIteratedGroup.For instance,for t=5,one could type

t = 4; chi[2][a_, g_] := 
      If[g*a == 1, Mod[Ceiling[t/2] + 1, t], 
        0];
chi[1][g_, {a_, b_}] := 
        If[g == 1, {Mod[-(a + chi[2][b, b]), t], b}, {0, 
            0}];

A tree-list representing the iterated group is given by {{2},{4,0}}. A list of cardinalities, from left to the right, is {5,2,2}. If we are interested in computing the homology groups from 0 to 10, we should type

HomologyIteratedGroups[{{2}, {4, 0}}, {4, 2, 2}, 0, chi]

and introduce 1 each time we are asked to going on computing the next homology group.