MathGroup Archive 2011

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Another AppendTo replacement problem

  • To: mathgroup at smc.vnet.net
  • Subject: [mg118225] Re: Another AppendTo replacement problem
  • From: DrMajorBob <btreat1 at austin.rr.com>
  • Date: Sun, 17 Apr 2011 07:52:35 -0400 (EDT)

The following is fast enough, I think.

(I removed spurious items, including {k, 1, 2} at the end of everything 
added to "result" and the List around statements executed inside Do.)

numBasis = 10000;
q = matrA = ma = ConstantArray[0, 2];
m = Orthogonalize /@
    RandomComplex[{-1 - I, 1 + I}, {numBasis, 2, 2}];
matr = RandomComplex[{-1 - I, 1 + I}, {2, 2}];
results = First@Last@Reap@Do[
       ma[[k]] =
        KroneckerProduct[m[[nBase, k]], Conjugate[m[[nBase, k]]]];
       matrA[[k]] = Chop[matr.ma[[k]]];
       matrA[[k]] = matrA[[k]]/Tr[matrA[[k]].matrA[[k]]] // Chop;
       k == 2 && Sow@{m[[nBase]], Eigenvalues[matrA[[k]]]},
       {nBase, 1, numBasis},
       {k, 1, 2}];
m = Sort[results, #1[[2]] < #2[[2]] &][[1, 1]];

The Sort does nothing, however, since a Complex number can't be less than 
another Complex number:

Take[results[[All, 2]], 2]

{{1.57232 + 0.360493 I, -1.15992*10^-15 +
    1.06536*10^-15 I}, {-0.901276 - 1.57282 I, -5.931*10^-16 -
    6.57242*10^-16 I}}

Sort[results, #1[[2]] < #2[[2]] &] == results

True

results[[1, 1]] == m

True

If you want absolute value as the criterion, you can eliminate the sort 
and use:

m = results[[Ordering[Abs@results[[All, 2]], 1], 1]]

{{{0.0884531 + 0.0561493 I,
    0.459436 + 0.88201 I}, {-0.99425 + 0.0221514 I,
    0.0918089 + 0.0504761 I}}}

Bobby

On Sat, 16 Apr 2011 06:35:17 -0500, Iv=E1n Lazaro <gaminster at gmail.com> 
wrote:

> Hi dear group!
>
> I've read multiple times in this forum about the slow performance of
> AppendTo with big lists. I have now a problem with it, but have not
> been able to replace it properly. This is a toy version of my problem.
> The code below have to be run multiple times, but it is really slow. I
> wonder if somebody have an idea about this AppendTo problem.
>
>
> NumBasis = 10000;
> q = matrA = ma = Table[0, {i, 2}];
> M = RandomComplex[{-1 - I, 1 + I}, {NumBasis, 2, 2}];
> M = Map[Orthogonalize, M];
> matr = RandomComplex[{-1 - I, 1 + I}, {2, 2}]
> Results = {};
>
> Do[{ma[[k]] =
>     KroneckerProduct[M[[Nbase, k]], Conjugate[M[[Nbase, k]]]];
>    matrA[[k]] = Chop[matr.ma[[k]]];
>    matrA[[k]] = matrA[[k]]/Tr[matrA[[k]].matrA[[k]]] // Chop;
>    If[k == 2,
>     AppendTo[
>      Results, {M[[Nbase]], Eigenvalues[matrA[[k]]], {k, 1, 2}}]];
>    }, {Nbase, 1, NumBasis}, {k, 1, 2}];
>
> M = Sort[Results, #1[[2]] < #2[[2]] &][[1, 1]];
>
> Thanks in advance!.
>


--
DrMajorBob at yahoo.com


  • Prev by Date: Re: Sharing numerical data along with a Mathematica notebook
  • Next by Date: Re: Another AppendTo replacement problem
  • Previous by thread: Re: Another AppendTo replacement problem
  • Next by thread: Re: Another AppendTo replacement problem