Lab 4 Answers

Total marks are 10.   Question1, 3 marks; Question 2, 7 marks.

[correctness will be mostly counted.  It is OK to have very different programing styles.]

1.

The rules (a) to (f) (with the order of (e) and (f) swapped):

laplace[f_  +  g_, t_, s_]  :=  
        laplace[f, t, s]  +  laplace[g, t, s];
laplace[c_*f_, t_,  s_]  := 
        c*laplace[f, t, s]  /;  FreeQ[c, t];
laplace[c_,  t_,  s_] :=  
        c/s  /;  FreeQ[c, t];
laplace[t_^n_. , t_, s_]  :=  n!/s^(n + 1)  /;  
          IntegerQ[n]  &&  n  >  0;
laplace[g_*E^(b_.  + c_. *t_), t_, s_] :=  
        E^b * laplace[g, t, s - c]  /;  
          FreeQ[b, t]  &&  FreeQ[c, t];
laplace[g_*t^n_. , t_, 
          s_]  :=  (-1)^n *D[laplace[g, t, s], {s, n}]  /;  
          IntegerQ[n]  &&  n > 0;

Some input examples:

laplace[t^2 + f[t], t, s]

laplace[t^3*Exp[t + 3], t, s]

laplace[t^2*Exp[c*t + b], t, s]

laplace[t^2*Sin[t], t, s]

The program give wrong results if the function G[t] do not have an explicit laplace transform.  This is due to the D[ ..., {s,n}] part.  I don't know how to fix it.

2.

\(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]

Some tests.

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

groupQ[{0, 1, 2, 3}, z4a]

groupQ[{a, b, c}, {{b, c, a}, {c, b, a}, {b, a, c}}]

z5m  =  Table[Mod[i*j, 5], {i, 1, 4}, {j, 1, 4}]

groupQ[{1, 2, 3, 4}, z5m]

abeliangroupQ[{1, 2, 3, 4}, z5m]

mat  =  {{i, a, b, c, d, k}, {a, i, c, b, k, d}, {b, k, d, a, i, 
            c}, {c, d, k, i, a, b}, {d, c, i, k, b, a}, {k, b, a, d, c, 
            i}};

MatrixForm[mat]

groupQ[{i, a, b, c, d, k}, mat]

abeliangroupQ[{i, a, b, c, d, k}, mat]