Lab 5 Answers

Total marks are 15.  5 marks for each questions.

1.

First, we copy the programs from lab 4 for testing groups.

\(closedQ[set_List, \ table_List]\  := \ 
      Module[{f}, 
 (*\ A0, \ 
          test\ that\ operation\ is\ \(\(closed\)\(.\)\)\ *) 
If[
          Length[Union[set]]\  ≠ \ 
            Length[set], 
Print["elements not unique!"]; 
Return[
            False]
]; 

 (*\ 
          check\ that\ the\ table\ contains\ only\ elements\ in\ the\ set\ *) 
f\  = \ Flatten[table, 1]; 
If[
          Union[f]\  =!= \ 
            Union[set], 
Print["operation is not closed!"]; 
Return[
            False]]; 
True
]\)

\(associativeQ[set_List, \ table_List]\  := \ 
      Module[{n, f, i, j, k}, 
 (*\ A1, \ 
          check\ a*\((b*c)\)\  = \ \((a*
                  b)\)*\(\(c\)\(.\)\)\ \ *) 
 (*\ 
          Replace\ table\ by\ number\ from\ 1\ to\ n\ so\ that\ it\ is\ easy\ to\ locate\ entries\ in\ the\ table . \ \ Thus\ the\ elements\ are\ canonically\ renamed\ as\ 1\ to\ \(\(n\)\(.\)\)\ *) 
n\  = \ Length[set]; 
f\  = \ 
          table\  /. \ 
            Thread[set\  -> \ 
                Range[n]]; 

For[i = 1, \ 
          i ≤ n, \ \(++i\), 
For[j = 1, 
            j ≤ n, \ \(++j\), 
For[k = 1, \ 
              k ≤ n, \ \(++k\), 
If[
                f[\([i, f[\([j, k]\)]]\)]\  ≠ \ 
                  f[\([f[\([i, j]\)], 
                      k]\)], 
Print["associativity failed!"]; 
Return[
                  False]]
]
]
]; 
True
]\)

\(identityQ[set_List, \ table_List]\  := \ 
      Module[{n, i, f, righte, lefte}, 
 (*\ 
          Check\ \(A2 : \ 
              identity\ e . \ \ Return\ either\ False\ or\ \(\({True, \ 
                    identity}\)\(.\)\)\)\ *) 
n = \ 
          Length[set]; 
{lefte, \ 
            righte}\  = \ {{}, \ {}}; 
For[i\  = \ 1, \ 
          i\  ≤ n, \ \(++i\), 
If[
            set\  === \ table[\([i]\)], 
lefte\  = \ 
              set[\([i]\)]; 
Break[]
]
]; 
If[lefte\  == \ {}, \ 
          Print["identity not find!"]; 
          Return[False]]; 
f\  = \ 
          Transpose[table]; 
For[i\  = \ 1, \ 
          i\  ≤ n, \ \(++i\), 
If[
            set\  === \ f[\([i]\)], 
righte\  = \ 
              set[\([i]\)]; 
Break[]
]
]; 
If[righte\  == \ {}, \ 
          Print["identity not find!"]; 
          Return[False]]; 
If[
          lefte\  == \ 
            righte, 
Print["identity is ", \ 
            lefte], \ 
Return[
            False]
]; 
{True, \ 
          lefte}
]\)

\(\(\(inverseQ[set_List, \ table_List, \ e_]\  := \ 
      Module[{i, n, \ f}, 
 (*\ 
          A3 . \ check\ that\ every\ one\ has\ inverse . \ \ We\ jsut\ make\ sure\ that\ each\ row\ and\ each\ column\ has\ a\ \(\(e\)\(.\)\)\ *) 
n\  = \ Length[set]; 
For[
          i\  = \ 1, \ 
          i\  ≤ \ 
            n, \ \(++i\), 
If[\(! MemberQ[table[\([i]\)], \ 
                e]\), 
Print["right inverse for ", \ 
              set[\([i]\)], \ " not find!"]; 
Return[
              False]]
]; 
f\  = \ 
          Transpose[table]; 
For[i\  = \ 1, \ 
          i\  ≤ \ 
            n, \ \(++i\), 
If[\(! MemberQ[f[\([i]\)], \ 
                e]\), 
Print["left inverse for ", \ 
              set[\([i]\)], \ " not find!"]; 
Return[
              False]]
]; 
True
]\)\(
\)
    \)\)

groupQ[set_List,  table_List]  :=  
      Module[{}, 
If[! closedQ[set, table],  
          Return[False]]; 
If[! associativeQ[set, 
              table],  Return[False]]; 
res =  
          identityQ[set, table]; 
If[res  ===  False, 
          Return[False]]; 
e  =  
          res[[2]]; 
If[! inverseQ[set, table, 
              e],  Return[
            False]]; 
True
]

The following two modules are required for lab 5. (not part of requirement for lab 4).

\(commuteQ[set_List, table_List] := \ 
      Module[{i, j, n}, 
 (*\ A4, \ 
          check\ a*b\  = \ b*a\ *) 
n\  = \ 
          Length[set]; 
For[i\  = \ 1, \ 
          i\  ≤ \ n, \ \(++i\), 
For[
            j\  = \ 1, \ 
            j\  ≤ \ n, \ \(++j\), 
If[
              table[\([i, j]\)]\  =!= \ table[\([j, i]\)], \ 
              Print["non-commuting!"]; 
Return[
                False]]
]
]; 
True
]\)

abeliangroupQ[set_List,  table_List] := 
      groupQ[set, table]  &&  commuteQ[set,  table]

Now, we write function for testing distribution law.  Distribution law need two operations, +, and  *, thus two tables are needed.   Again, we use the Thread[ ] trick to map the elements into natural numbers {1,2,3...}.

\(distributionQ[set_List, \ addtable_List, \ multable_List]\  := \ 
      Module[{n, f, g, i, j, k}, 
 (*\ A5, \ 
          check\ a*\((b + c)\)\  = \ \(\((a*b)\) + \((a*
                  c)\)

            \ \ \ \ \ \ \ \ \((a + b)\)*
                c\  = \ \((a*
                    c)\) + \(\((b*c)\)\(.\)\)\)\ \ *) 
 (*\ 
          Replace\ table\ by\ number\ from\ 1\ to\ n\ so\ that\ it\ is\ easy\ to\ locate\ entries\ in\ the\ table . \ \ Thus\ the\ elements\ are\ canonically\ renamed\ as\ 1\ to\ \(\(n\)\(.\)\)\ *) 
n\  = \ Length[set]; 
        f\  = \ addtable\  /. \ 
            Thread[set\  -> \ Range[n]]; 
g\  = \ 
          multable\  /. \ 
            Thread[set\  -> \ 
                Range[n]]; 

For[i = 1, \ 
          i ≤ n, \ \(++i\), 
For[j = 1, 
            j ≤ n, \ \(++j\), 
For[k = 1, \ 
              k ≤ n, \ \(++k\), 
If[
                g[\([i, f[\([j, k]\)]]\)]\  ≠ \ 
                  f[\([\ g[\([i, j]\)], 
                      g[\([i, 
                          k]\)]\ ]\)], 
Print["associativity failed!"]; 
Return[False]]; 
If[
                g[\([f[\([i, j]\)], k]\)]\  ≠ \ 
                  f[\([\ g[\([i, k]\)], 
                      g[\([j, 
                          k]\)]\ ]\)], 
Print["associativity failed!"]; 
Return[
                  False]]
]
]
]; 
True
]\)

fieldQ[set_,  addtable_,  multable_List] := 
      Module[{res,  zerop,  
          mtb = multable}, 

res  =  
          identityQ[set, addtable]; 
 (* 
          need to know which element in set is 0,  
          and drop them in multable and set *) 

zerop  =  Position[set,  res[[2]]][[1, 
              1]]; 
setmzero  =  
          Drop[set,  {zerop}]; 
mtb  =  
          Drop[mtb,  {zerop}]; 
mtb  =  
          Drop[Transpose[mtb], {zerop}]; 
mtb  =  
          Transpose[mtb]; 

abeliangroupQ[
            set,  addtable]  &&  abeliangroupQ[setmzero,  mtb]  &&  
          distributionQ[set,  addtable,  
            multable]
]

Testing with (Subscript[Z, 4]) and (Subscript[Z, 5]):

z4a  =  Table[Mod[i + j, 4], {i, 0, 3}, {j, 0, 3}]; 
    z4m  =  Table[Mod[i*j, 4], {i, 0, 3}, {j, 0, 3}]

fieldQ[{0, 1, 2, 3}, z4a, z4m]

z5a  =  
        Table[Mod[i + j, 5], {i, 1, 5}, {j, 1, 
            5}];
z5m  =  Table[Mod[i*j, 5], {i, 1, 5}, {j, 1, 5}]

fieldQ[{1, 2, 3, 4, 0}, z5a, z5m]

2.

The style below for this problem is to compute, rather than program, to find answers.
The set of all polynomials modulo 1 + (x^2) in (Subscript[Z, 3])is a finite set:   They are

setmod1px2  = 
      Flatten[ Table[i + j*x, {j, 0, 2}, {i, 0, 2}]]

Addition is easy, since the sum of linear polynomials remain linear, we only need to mod 3 of the coefficients.

addtable  =  
      Table[PolynomialMod[setmod1px2[[i]] + setmod1px2[[j]], 
          3],  {i,  1, 9}, {j, 1, 9}]

multable  =  
      Table[PolynomialMod[
          PolynomialRemainder[setmod1px2[[i]]*setmod1px2[[j]], 
            1 + x^2, x], 3],  {i,  1, 9}, {j, 1, 9}]

If we were computing by hand, we can use that fact that (x^2) = -1  mod ((x^2)+1).  For example,  (((2  x + 2))^2) = 4 + 8  x + 
            4  (x^2) = 1 + (x^2) + 2  x  =  2  x (all mod ((x^2) + 1) and mod 3.   If a + b x and c + b x are two members of the set, then the rules for addition and multiplication are: 
	(a + b x)  + (c + 
              d x)    =   (a + c) mod 3   +   x (b + 
                d) mod3,  
	(a + b x) * (c + 
              d x)  =  (a c - b d) mod 3  +  
          x (a d  +  b c) mod 3.
They are very much like the addition and multiplication of complex numbers.
The check for field goes through:

fieldQ[setmod1px2, addtable,  multable]

Looking at the multiplication table, we find the inverses of

setmod1px2

is

inverses = {NULL,  1,  2, 2  x, 2 + x, 1 + x, x, 2 + 2  x, 
        1 + 2  x}

Here we verify  a (a^(-1)) = 1 (except that 0 has no inverse):

Map[PolynomialMod[PolynomialRemainder[#, 1 + x^2, x], 3] &, 
      setmod1px2*inverses]

We now apply extended Euclidean algorithm to compute inverses. First we load in the package:

<< Algebra`PolynomialExtendedGCD`

extgcd  =  
      Map[PolynomialMod[
            PolynomialExtendedGCD[#, x^2 + 1,  Modulus  -> 3], 3] &,  
        setmod1px2]

This verify that extended GCD computation and earlier reading from multable is the same:

inverses   -  ( #[[2, 1]] &  /@  extgcd)

3. Garner's algorithm

\(\(garner[m_List, u_List] := 
        Module[{}, 
v = u; \ \ \  (*\ 
            only\ v0\ is\ valid\ *) 
n\  = \ 
            Length[u]; 
p\  = \ 
            Table[0, {n}]; 
g\  = \ 
            p; 
prod\  = \ 1; 
For[j = 1, 
            j ≤ n, \(++j\), 
p[\([j]\)]\  = \ 
              prod; 
g[\([j]\)]\  = \ 
              reciprocal[p[\([j]\)], 
                m[\([j]\)]]; 
prod\  *= \ 
              m[\([j]\)];
]; 

For[j\  = \ 2, \ 
            j\  ≤ \ n, \ \(++j\), 
vsum\  = \ 
              Sum[v[\([i]\)]*p[\([i]\)], \ {i, 1, 
                  j - 1}]; 
v[\([j]\)]\  = \ 
              Mod[\((u[\([j]\)] - vsum)\)*g[\([j]\)], \ 
                m[\([j]\)]]
]; 

res\  = \ 
            v . p; 

 (*\ 
            We\ use\ symmetric\ representation\ for\ the\ final\ results\ *) 
If[
            res\  > \ prod/2, 
res\  -= \ 
              prod
]; 
res
];\)
\)
reciprocal[a_Integer,  m_Integer]  :=  
      Mod[ExtendedGCD[a, m][[2, 1]], m]

The example 5.15 of page 181 (internally we used positive presentation, rather than symmetric one):

garner[{99, 97, 95}, {49, 76, 65}]

Check back:

Mod[-272300, #] &  /@   {99, 97, 95}

That's all.