Groups | Search | Server Info | Keyboard shortcuts | Login | Register [http] [https] [nntp] [nntps]


Groups > comp.soft-sys.math.mathematica > #1745

Re: Another AppendTo replacement problem

From Peter Pein <petsie@dordos.net>
Newsgroups comp.soft-sys.math.mathematica
Subject Re: Another AppendTo replacement problem
Date 2011-04-17 11:54 +0000
Organization Steven M. Christensen and Associates, Inc and MathTensor, Inc.
Message-ID <ioekco$n27$1@smc.vnet.net> (permalink)
References <iobuv2$bec$1@smc.vnet.net>

Show all headers | View raw


Am 16.04.2011 13:36, schrieb Iván Lazaro:
> 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!.
>

Hi Iván,

there is no need to build a list while calculating, because there is 
already M. With a few nested anonymous functions and heavy mapping:

NumBasis=10^4;
SeedRandom[1]; (* to make result comparable *)
matr=RandomComplex[{-1-I,1+I},{2,2}];
M=RandomComplex[{-1-I,1+I},{NumBasis,2,2}];

AbsoluteTiming[
  M=Orthogonalize/@M;
  First[Results=
   SortBy[
    Transpose[{M,
     (Total[Eigenvalues[#1]]&) /@
      Map[(#1/Tr[#1.#1]&)[matr.#1]&,
       MapThread[KroneckerProduct,{M,Conjugate[M]},2],
      {2}][[All,2]]
     }],
    Abs[#1[[2]]]&]
  ]
]

gives

{0.4700006,
   {
   {{ 0.552668 - 0.232809 I, -0.550734 - 0.58056 I},
    {-0.760505 + 0.248977 I, -0.375566 - 0.467538 I}},
   0.297748 + 0.654164 I
} }

hth,
Peter

Back to comp.soft-sys.math.mathematica | Previous | NextPrevious in thread | Next in thread | Find similar | Unroll thread


Thread

Another AppendTo replacement problem Iván Lazaro <gaminster@gmail.com> - 2011-04-16 11:36 +0000
  Re: Another AppendTo replacement problem Peter Pein <petsie@dordos.net> - 2011-04-17 11:54 +0000
  Re: Another AppendTo replacement problem Albert Retey <awnl@gmx-topmail.de> - 2011-04-17 11:53 +0000

csiph-web