%---TeX-start-of-header--- \documentclass[titlepage]{article} \usepackage{epsfig,mathematica,figi} %\mmanobreak \begin{comment} \begin{mathematica} <Infinity]; zero = 0.00001; ohide = DisplayFunction->Identity; oshow = DisplayFunction -> $DisplayFunction; ojoin = PlotJoined -> True; oall = PlotRange->All; osurf = HiddenSurface->False; deg = N[Degree]; pi = N[Pi]; \end{mathematica} \end{comment} \begin{document} \psfiginit %---TeX-end-of-header--- \author{Tomasz J.\ Cholewo} \title{Design and Analysis of Computer Algorithms, EMCS\,619\\ Homework \#4} \maketitle %==================================================================== \section{Problem 1} Verification of obtained results: \begin{mathematica} Print[ 8^^547312, " ", 2^^100111011001, " ", 16^^3D9C ]; . 184010 2521 15772 \end{mathematica} %==================================================================== \section{Problem 2} Function \texttt{split} divides a list into two sublists of equal length. \begin{mathematica} split[l_List /; EvenQ[Length[l]]] := Partition[l, Length[l] / 2] \end{mathematica} Function \texttt{split4} divides a matrix into four submatrices. \begin{mathematica} split4[l_List] := Transpose[split /@ Transpose /@ split[l], {1,2,4,3}] \end{mathematica} Function \texttt{join4} performs an operation being the opposite of the \texttt{split4} function: it merges four submatrices into a single one. \begin{mathematica} join4[l_List] := Transpose @ Apply[Join, Transpose @ Apply[Join, Transpose[l, {1,2,4,3}], {1}], {1}] \end{mathematica} Define a simple $4\times4$ test matrix: \begin{mathematica} test = {{1,2, 3, 4}, {5, 6, 7, 8}, {9, 10, 11, 12}, {13, 14, 15, 16}}; \end{mathematica} After splitting we get: \begin{mathematica} split4[test]//TableForm . //TableForm= 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 \end{mathematica} and after joining we get back the same matrix: \begin{mathematica} join4@split4[test]//TableForm . //TableForm= 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 \end{mathematica} Function \texttt{strassen} performs a multiplication of matrices \texttt{A} and \texttt{B} using Strassen's method. Size of matrices is limited to the integer powers of 2. Optional parameter \texttt{Debug} allows printing of the values of the imtermediate variables. \begin{mathematica} strassen[A_List, B_List, mode_:Silent] := If[ Length[A] <= 1, A * B, (* recursion stop condition *) Module[{a = split4[A], b = split4[B], p, q, r, s, t, u, v}, p = strassen[ a[[1,1]] + a[[2,2]], b[[1,1]] + b[[2,2]], mode ]; q = strassen[ a[[2,1]] + a[[2,2]], b[[1,1]], mode ]; r = strassen[ a[[1,1]], b[[1,2]] - b[[2,2]], mode ]; s = strassen[ a[[2,2]], b[[2,1]] - b[[1,1]], mode ]; t = strassen[ a[[1,1]] + a[[1,2]], b[[2,2]], mode ]; u = strassen[ a[[2,1]] - a[[1,1]], b[[1,1]] + b[[1,2]], mode ]; v = strassen[ a[[1,2]] - a[[2,2]], b[[2,1]] + b[[2,2]], mode ]; If[mode === Debug, Print[TableForm[{p,q,r,s,t,u,v}, TableDirections->{Row, Column, Row}, TableSpacing->{6, 1, 2}, TableHeadings->{{"p", "q", "r", "s", "t", "u", "v"}}]]; ]; join4[{{p + s - t + v, r + t}, {q + s, p + r - q + u}}] ] ] \end{mathematica} Two given matrices to be multiplied: \begin{mathematica} A={{1,2,0,2},{1,0,1,1},{0,1,3,1},{3,1,0,0}}; B={{1,0,1,1},{1,3,2,0},{2,1,0,1},{1,0,1,0}}; \end{mathematica} \begin{mathematica} strassen[A, B, Debug] // TableForm . p q r s t u v 10 13 5 6 3 0 3 0 4 1 -5 -4 -4 -6 1 1 4 3 1 0 0 0 1 2 7 5 4 2 Out[186]//TableForm= 5 6 7 1 4 1 2 2 8 6 3 3 4 3 5 3 \end{mathematica} ``Normal'' matrix multiplication gives the same result. \begin{mathematica} A.B//TableForm . //TableForm= 5 6 7 1 4 1 2 2 8 6 3 3 4 3 5 3 \end{mathematica} Function \texttt{T} determines how many additions and multiplications are required for multiplying two matrices with size \texttt{j}: \begin{mathematica} T[2] := 25; T[j_] := 18 (j/2)^2 + 7 T[j/2]; \end{mathematica} In our case for $4\times 4$ matrices we need \begin{mathematica} T[4] . = 247 \end{mathematica} operations. Logarithmic plots shown in Figure~\ref{logs} prove that the algorithm's complexity is really close to $\Theta(j^{2.81})$. \begin{mathematica} Display["logs.eps", Show[ListPlot[Log[(2^#)^2.81]& /@ Range[25]], ListPlot[Log[T[2^#]]& /@ Range[25], ojoin]], "EPS"]; \end{mathematica} \figi{logs}{Bilogarithmic plots of the functions $T(j)$ (continuous) and $2^2.81$ (dotted).} %==================================================================== \newpage \section{Problem 3} The Fourier Transform matrix and matrix of its inverse (without the $\frac{1}{4}$ factor) for the case $n=4$ are equal: \begin{mathematica} A = {{1, 1, 1, 1}, {1, w, w^2, w^3}, {1, w^2, w^4, w^6}, {1, w^3, w^6, w^9}}; B = {{1, 1, 1, 1}, {1, w^-1, w^-2, w^-3}, {1, w^-2, w^-4, w^-6}, {1, w^-3, w^-6, w^-9}}; \end{mathematica} The matrix operator resulting from applying the transform and then its inverse is equal to the product of these two matrices: \begin{mathematica} TableForm[B . A] . Out[64]//TableForm= 2 3 2 4 6 3 6 9 4 1 + w + w + w 1 + w + w + w 1 + w + w + w -3 -2 1 1 + w + w + - 2 3 2 4 6 w 4 1 + w + w + w 1 + w + w + w -3 -2 1 -6 -4 -2 1 + w + w + - 2 3 1 + w + w + w w 4 1 + w + w + w -3 -2 1 -9 -6 -3 -6 -4 -2 1 + w + w + - 1 + w + w + w 1 + w + w + w w 4 \end{mathematica} From the property 7.1 we can see that all sums of the form $1 + w^c + (w^c)^2 + (w^c)^3$ are equal to zero. It applies also for $c=2$ and for negative values of $c$ because it is equivalent to considering conjugate values of this whole sum, and the conjugate of 0 is 0. We can verify it by substituting in the above matrix the symbol \texttt{w} by the primitive fourth-root of 1 which is simply equal to $i$: \begin{mathematica} (B.A /. w -> I)//MatrixForm . Out[67]//MatrixForm= 4 0 0 0 0 4 0 0 0 0 4 0 0 0 0 4 \end{mathematica} After adding the normalization factor $\frac{1}{4}$ the above matrix becomes the identity matrix what proves that multiplying it by any vector will result in the same vector. %==================================================================== \newpage \section{Problem 5} The given graph can be described by the following adjacency matrix: \begin{mathematica} (A = {{0, 1, 0, 0, 0, 0, 0, 1}, {0, 0, 1, 1, 0, 0, 1, 0}, {0, 0, 0, 1, 0, 0, 0, 0}, {0, 0, 0, 0, 1, 0, 0, 0}, {0, 0, 0, 0, 0, 0, 0, 0}, {0, 0, 0, 1, 1, 0, 0, 0}, {0, 0, 1, 0, 1, 1, 0, 0}, {0, 0, 0, 0, 0, 0, 1, 0}})//showmatrix . Out[10]//MatrixForm= a b c d e f g h a 0 1 0 0 0 0 0 1 b 0 0 1 1 0 0 1 0 c 0 0 0 1 0 0 0 0 d 0 0 0 0 1 0 0 0 e 0 0 0 0 0 0 0 0 f 0 0 0 1 1 0 0 0 g 0 0 1 0 1 1 0 0 h 0 0 0 0 0 0 1 0 \end{mathematica} \subsection{Method of matrix powers} Function \texttt{powerclosure} finds the transitive closure matrix for the given adjacency matrix \texttt{A}. Parameter \texttt{mode}, if set to \texttt{Debug} allows printing of intermediate results, i.e., sums of consecutive powers of \texttt{A} up to the $i$th power. \begin{mathematica} powerclosure[A_List, mode_:Silent] := Module[{R = A}, Do[ R = Map[Sign, R . A + R, {2}]; If[ mode === Debug, Print[" "]; Print["R(", i, ") = "]; Print[showmatrix[R]] ], {i, 2, Length[A]} ]; R ] \end{mathematica} Results for the given graph: \begin{mathematica} showmatrix[powerclosure[A, Debug]] . R(2) = a b c d e f g h a 0 1 1 1 0 0 1 1 b 0 0 1 1 1 1 1 0 c 0 0 0 1 1 0 0 0 d 0 0 0 0 1 0 0 0 e 0 0 0 0 0 0 0 0 f 0 0 0 1 1 0 0 0 g 0 0 1 1 1 1 0 0 h 0 0 1 0 1 1 1 0 R(3) = a b c d e f g h a 0 1 1 1 1 1 1 1 b 0 0 1 1 1 1 1 0 c 0 0 0 1 1 0 0 0 d 0 0 0 0 1 0 0 0 e 0 0 0 0 0 0 0 0 f 0 0 0 1 1 0 0 0 g 0 0 1 1 1 1 0 0 h 0 0 1 1 1 1 1 0 R(4) = a b c d e f g h a 0 1 1 1 1 1 1 1 b 0 0 1 1 1 1 1 0 c 0 0 0 1 1 0 0 0 d 0 0 0 0 1 0 0 0 e 0 0 0 0 0 0 0 0 f 0 0 0 1 1 0 0 0 g 0 0 1 1 1 1 0 0 h 0 0 1 1 1 1 1 0 R(5) = a b c d e f g h a 0 1 1 1 1 1 1 1 b 0 0 1 1 1 1 1 0 c 0 0 0 1 1 0 0 0 d 0 0 0 0 1 0 0 0 e 0 0 0 0 0 0 0 0 f 0 0 0 1 1 0 0 0 g 0 0 1 1 1 1 0 0 h 0 0 1 1 1 1 1 0 R(6) = a b c d e f g h a 0 1 1 1 1 1 1 1 b 0 0 1 1 1 1 1 0 c 0 0 0 1 1 0 0 0 d 0 0 0 0 1 0 0 0 e 0 0 0 0 0 0 0 0 f 0 0 0 1 1 0 0 0 g 0 0 1 1 1 1 0 0 h 0 0 1 1 1 1 1 0 R(7) = a b c d e f g h a 0 1 1 1 1 1 1 1 b 0 0 1 1 1 1 1 0 c 0 0 0 1 1 0 0 0 d 0 0 0 0 1 0 0 0 e 0 0 0 0 0 0 0 0 f 0 0 0 1 1 0 0 0 g 0 0 1 1 1 1 0 0 h 0 0 1 1 1 1 1 0 R(8) = a b c d e f g h a 0 1 1 1 1 1 1 1 b 0 0 1 1 1 1 1 0 c 0 0 0 1 1 0 0 0 d 0 0 0 0 1 0 0 0 e 0 0 0 0 0 0 0 0 f 0 0 0 1 1 0 0 0 g 0 0 1 1 1 1 0 0 h 0 0 1 1 1 1 1 0 Out[32]//MatrixForm= a b c d e f g h a 0 1 1 1 1 1 1 1 b 0 0 1 1 1 1 1 0 c 0 0 0 1 1 0 0 0 d 0 0 0 0 1 0 0 0 e 0 0 0 0 0 0 0 0 f 0 0 0 1 1 0 0 0 g 0 0 1 1 1 1 0 0 h 0 0 1 1 1 1 1 0 \end{mathematica} One can notice that a column of zeroes in the transitive closure matrix characterizes a source while a row of zeroes represents a sink of a digraph. Empty diagonal points to the lack of cycles in the corresponding graph. \subsection{Warshall's algorithm} Function \texttt{warshallclosure} finds the transitive closure matrix for the adjacency matrix \texttt{A}: \begin{mathematica} warshallclosure[A_List] := Module[{i, j, k, n = Length[A], R = A}, For[ k = 1, k <= n, k++, For[ i = 1, i <= n, i++, If[ R[[i, k]] == 1, R[[i]] = Sign /@ (R[[i]] + R[[k]]) ] (* classical version: For[ j = 1, j <= n, j++, If[ R[[i, k]] == 1 && R[[k, j]] == 1, R[[i, j]] = 1] ] *) ] ]; R ]; \end{mathematica} This method gives identical results as the matrix powers method: \begin{mathematica} showmatrix[warshallclosure[A]] . Out[41]//MatrixForm= a b c d e f g h a 0 1 1 1 1 1 1 1 b 0 0 1 1 1 1 1 0 c 0 0 0 1 1 0 0 0 d 0 0 0 0 1 0 0 0 e 0 0 0 0 0 0 0 0 f 0 0 0 1 1 0 0 0 g 0 0 1 1 1 1 0 0 h 0 0 1 1 1 1 1 0 \end{mathematica} %==================================================================== \newpage \section{Problem 6} Verification of obtained results: \begin{mathematica} A = {{1, 0, 0, 0}, {0, 0, 1, 1}, {1, 0, 0, 1}, {0, 0, 1, 0}}; B = {{0, 1, 0, 0}, {1, 1, 0, 0}, {1, 0, 1, 0}, {0, 0, 0, 1}}; MatrixForm[ Map[ Sign, A . B, {2}]] . Out[42]//MatrixForm= 0 1 0 0 1 0 1 1 0 1 0 1 1 0 1 0 \end{mathematica} %==================================================================== \section{Auxiliary functions} Function \texttt{showmatrix} presents a list in a matrix form with letter headings. \begin{mathematica} showmatrix[l_List] := MatrixForm[l, TableSpacing->{0, 2}, TableHeadings->{#, #}]& @ Table[FromCharacterCode[i], {i, 97, Length[l] + 96}]; \end{mathematica} \end{document} \begin{mathematica} nameprint[x_] := Print[#, " = ", TableForm @ ReleaseHold[#]]& @ HoldForm[x]; SetAttributes[nameprint, HoldFirst]; \end{mathematica} %====================================================================