       • To: mathgroup at smc.vnet.net
• Subject: [mg14364] Re: [mg14224] Complex Hadamard Matrix
• From: Jurgen Tischer <jtischer at col2.telecom.com.co>
• Date: Thu, 15 Oct 1998 00:29:04 -0400
• References: <199810070700.DAA13682@smc.vnet.net.>
• Sender: owner-wri-mathgroup at wolfram.com

```Hi Hideya,

Steve told me my notebook didn't come through, so I send my solution
ones more, this time added into the email. I hope this works. (I copied
it into a new notebook and it did work.)

Jurgen

Notebook[{
Cell[BoxData[
\(md[m_] :=
DisplayForm[
GridBox[m, ColumnSpacings -> 0.15, RowSpacings -> \(- .1\)] /. {
1 -> "\<+\>", \(-1\) -> "\<-\>",
I -> StyleBox["\<+\>", \n\ \ \ \ \ \ \ \ \ \ \ \ \ \
FontColor -> RGBColor[1, \ 0, \ 0]],
\(-I\) -> \ \n\ \ \ \ \ \ \ \ \ \ \ \
StyleBox["\<-\>", \n\ \ \ \ \ \ \ \ \ \ \ \ \ \
FontColor -> RGBColor[1, \ 0, \ 0]]}]\)], "Input"],

Cell["\<\
md is just for showing matrices in a compact form, each 1 is represented
by a \
+, -1 by -, I by a red +, -I by a red -. Example:\ \>", "Text"],

Cell[BoxData[
\(md[{{1, 1, I, \(-1\)}, {I, 1, \(-1\), \(-I\)}}]\)], "Input"],

Cell["\<\
Since multiplication of every line of a solution matrix by a line filled
with \
1's, -1's,I's and -I's will give a solution it is enough to list the \
solutions with the first row all 1's. Since multiplication of one line
by -1, \
I or -I gives a solution one can reduce the search for matrices with
first \
row and first column all 1's.\
\>", "Text"],

Cell["\<\
li is the set of all possible rows, li1 the set of all possible real
rows, \
li2 the set of all possible rows containing at least one I.\ \>",
"Text"],

Cell[BoxData[
\(\(li =
Select[Flatten[
Outer[List, {1}, {1, \(-1\), I, \(-I\)}, {1, \(-1\), I,
\(-I\)}, {
1, \(-1\), I, \(-I\)}, {1, \(-1\), I, \(-I\)}, {1, \(-1\),
I,
\(-I\)}, {1, \(-1\), I, \(-I\)}, {1, \(-1\), I, \(-I\)}],
7],
Plus@@# == 0&]; \)\)], "Input"],

Cell[BoxData[
\(\(li1 = Cases[li, {__Integer}]; \)\)], "Input"],

Cell[BoxData[
\(\(li2 = Complement[li, li1]; \)\)], "Input"],

Cell[BoxData[
\(Length/@{li, li1, li2}\)], "Input"],

Cell[BoxData[
\(\(v1 = {1, 1, 1, 1, 1, 1, 1, 1}; \)\)], "Input"],

Cell["\<\
To reduce the number of generated matrices further I \"normalize\" the \
partial solutions. The idea is first to generate all sets of real
partial \
solutions (up to equivalence by normal), the complete with li2-rows.
normal \
uses the fact that the set of solutions is invariant by permutations of
rows \
and/or of columns. I use two different versions of normal for real and \
non-real matrices, normal is NOT a projection, but the reduction is
enough to \
make the code run in reasonable time.\ \>", "Text"],

Cell[BoxData[
\(normal[x : {{__Integer}}] :=
Reverse[Sort[Transpose[Reverse[Sort[Transpose[x]]]]]]\)],
"Input"],

Cell[BoxData[
\(normal[x_] :=
Module[{y = Transpose[Reverse[Sort[Transpose[x]]]]}, \n\t\t
Join[Reverse[Sort[Cases[y, {__Integer}]]],
Reverse[Sort[Cases[y, {___, I, ___}]]]]]\)], "Input"],

Cell["\<\
orto selects out of a list all elements orthogonal to the first
argument.\
\>", "Text"],

Cell[BoxData[
\(\(orto[a : {_?NumberQ .. }, li_] :=
With[{ca = Conjugate[a]}, Select[li, ca . # == 0&]]; \)\)],
"Input"],

Cell[BoxData[
\(orto[a : {{_?NumberQ .. } .. }, li_] :=
Fold[orto[#2, #1]&, li, Rest[a]]\)], "Input"],

Cell["\<\
extentByOrto generates all possible extensions (by one) of the first
argument \
by elements of the second argument. It's used to generate all real
partial \
solutions.\
\>", "Text"],

Cell[BoxData[
\(extentByOrto[x : {{__?NumberQ} .. }, li_] :=
Union[normal/@\((\(Append[x, #]&\)/@orto[x, li])\)]\)], "Input"],

Cell[BoxData[
\(extentByOrto[x : {{{__?NumberQ} .. } .. }, li_] :=
Reverse[Union[Flatten[\(extentByOrto[#, li]&\)/@x, 1]]]\)],
"Input"],

Cell["\<\
completeByOrto is used to complete a real partial solution by non-real \
rows.\
\>", "Text"],

Cell[BoxData[
\(completeByOrto[x_, li_] :=
Nest[extentByOrto[#, li]&, x, 8 - Length[x[\(\)]]]\)],
"Input"],

Cell["\<\
Ok, we start. lir is the list of lists of partial real solutions of the
same \
size. There are so few we can inspect them with md. (I kept them
seperate to \
have an extra control, I \"know\" that some size do not allow
extensions.)\
\>", "Text"],

Cell[BoxData[
\(\(lir = NestList[extentByOrto[#, li1]&, {{v1}}, 7]; \)\)],
"Input"],

Cell[BoxData[
\(Map[md, lir, {2}]\)], "Input"],

Cell["\<\
And now the big search, this takes some time (some 5 minutes on a 300
Mhz \
PC).\
\>", "Text"],

Cell[BoxData[
\(\(lic = \(completeByOrto[#, li2]&\)/@lir; \)\)], "Input"],

Cell[BoxData[
\(Length/@lic\)], "Input"],

Cell["\<\
You may inspect all of them, but that looks quite boring. I just looked
at \
lic[], the matrices with 6 real rows.\ \>", "Text"],

Cell[BoxData[
\(md/@lic[\(\)]\)], "Input"],

Cell["\<\
We can throw away some more matrices and add them up in one list sol.\
\>", "Text"],

Cell[BoxData[
\(\(sol = Union[normal/@Join[Sequence@@lic]]; \)\)], "Input"],

Cell[BoxData[
\(Dimensions[sol]\)], "Input"],

Cell["\<\
The rest is to check if all elements of sol are really solutions.\ \>",
"Text"],

Cell[BoxData[
\(ct[m_] := Conjugate[Transpose[m]]\)], "Input"],

Cell[BoxData[
\(g[m_] := m . ct[m]\)], "Input"],

Cell[BoxData[
\(And@@\((\(g[#] == 8\ IdentityMatrix&\)/@sol)\)\)], "Input"],

Cell["There is just one question left: What is this all good for?",
"Text"]
},
FrontEndVersion->"Microsoft Windows 3.0", ScreenRectangle->{{0, 1024},
{0, 740}}, WindowSize->{578, 658},
WindowMargins->{{11, Automatic}, {Automatic, 5}} ]

Hideya YAMAMURA wrote:
>
> Hi,
>
> There is some complex matrix A, which is 8 x 8's square matrix.
>
>         A * B = n E
>
> B shows complex conjugate transpose matrix of A, * means multiply, n is
> number of column or row. Additionally, E means unitary matrix. The
> element of A takes +1, -1, +i, or -i.
>
> In mathematica, I would like to know how to solve before mentioned
> equation.
>
> Thank you so much for any help or suggestion.
>
> Hideya Yamamura
>
> --
> ---------------------------------------
>  (\$B3t(B)\$BK-ED<+F0?%5! at =:n=j(B  \$B5;=Q3+H/8&5f=j(B
>        \$B;3B<(B \$B=(Lo(B (Hideya Yamamura) Phone: 0562-48-9115/Fax:
> 0562-48-9180 E-mail: ymura at rdc.toyota-shokki.co.jp
> ---------------------------------------

```

• Prev by Date: Re: Mesh on graphics3D objects
• Next by Date: Re: Help With PlotLegend, please.