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

Groups > comp.soft-sys.math.mathematica > #1722 > unrolled thread

Re: Another AppendTo replacement problem

Back to article view | Back to comp.soft-sys.math.mathematica

Contents

  Re: Another AppendTo replacement problem Iván Lazaro <gaminster@gmail.com> - 2011-04-16 11:37 +0000
    Re: Another AppendTo replacement problem ADL <alberto.dilullo@tiscali.it> - 2011-04-17 11:51 +0000
    Re: Another AppendTo replacement problem "Sjoerd C. de Vries" <sjoerd.c.devries@gmail.com> - 2011-04-17 11:51 +0000
      Re: Another AppendTo replacement problem Ray Koopman <koopman@sfu.ca> - 2011-04-17 23:15 +0000

#1722 — Re: Another AppendTo replacement problem

I made a mistake in the code. Now it's fine. Sorry.

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]], Total[Eigenvalues[matrA[[k]]]]}]];
  }, {Nbase, 1, NumBasis}, {k, 1, 2}];

M = Sort[Results, #1[[2]] < #2[[2]] &][[1, 1]];

Thanks in advance!

[toc] | [next] | [standalone]

#1739

On 16 Apr, 13:37, Iv=E1n Lazaro <gamins...@gmail.com> wrote:
> I made a mistake in the code. Now it's fine. Sorry.
>
> 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]], Total[Eigenvalues[matrA[[k]]]]}]];
>   }, {Nbase, 1, NumBasis}, {k, 1, 2}];
>
> M = Sort[Results, #1[[2]] < #2[[2]] &][[1, 1]];
>
> Thanks in advance!

You might try with Reap and Sow. In my system it is four/five times
faster:

reapVersion := (
  NumBasis = 10000;
  q = matrA = ma = Table[0, {i, 2}];
  M = RandomComplex[{-1 - I, 1 + I}, {NumBasis, 2, 2}];
  M = Orthogonalize /@ M;
  matr = RandomComplex[{-1 - I, 1 + I}, {2, 2}];
  Results =
    Last[Reap[
      Do[{ma[[k]] = KroneckerProduct[M[[Nbase,k]],
           Conjugate[M[[Nbase,k]]]]; matrA[[k]] =
          Chop[matr . ma[[k]]]; matrA[[k]] =
          Chop[matrA[[k]]/Tr[matrA[[k]] . matrA[[k]]]];
         If[k == 2, Sow[{M[[Nbase]], Total[Eigenvalues[
              matrA[[k]]]]}]]; }, {Nbase, 1, NumBasis},
       {k, 1, 2}]
    ]];
  M=Sort[Results][[1,1]];
  M
)

[toc] | [prev] | [next] | [standalone]

#1742

The usual trick is to replace AppendTo[list,elem] with list {list,elem}.

The list is going to look like
{{{{{{elem1},elem2},elem3},elem4},elem5},elem6}

At the end you do a list = Flatten[list] and all is fine;

In this case your elements have a structure which has to be protected
against Flatten.
That can be done by replacing the list that contains them with a dummy
head (fl) like this:

Results= {Results, fl[M[[Nbase]], Total[Eigenvalues[matrA[[k]]]]]}

Right after the loop you Flatten and get rid of the head fl:

Results2 = Flatten[Results] /. fl -> List;

For NumBasis =10000 this version is twice as fast, but for NumBasis
=100,000 the speedup is already a factor of 20!

Cheers -- Sjoerd

Turn to StackOverflow for faster answers to Mathematica questions
http://stackoverflow.com/questions/tagged/mathematica



On Apr 16, 1:37 pm, Iv=E1n Lazaro <gamins...@gmail.com> wrote:
> I made a mistake in the code. Now it's fine. Sorry.
>
> 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]], Total[Eigenvalues[matrA[[k]]]]}]];
>   }, {Nbase, 1, NumBasis}, {k, 1, 2}];
>
> M = Sort[Results, #1[[2]] < #2[[2]] &][[1, 1]];
>
> Thanks in advance!

[toc] | [prev] | [next] | [standalone]

#1770

On Apr 17, 4:51 am, "Sjoerd C. de Vries" <sjoerd.c.devr...@gmail.com>
wrote:
> The usual trick is to replace AppendTo[list,elem] with list {list,elem}.

See Maxim Rytin, "Two heads are better than one",
http://forums.wolfram.com/mathgroup/archive/2006/May/msg00175.html

The trick he suggests builds just as fast as,
and unravels twice as fast as, the usual trick.

Timing[s = {}; Do[s = {s, h[i,-i] }, {i,1*^6}]; Length@s]
Timing[Length[ss = Flatten@s /. h->List]]

{4.23 Second,2}
{1.82 Second,1000000}

Timing[z = h[]; Do[z = h[z, {i,-i} ], {i,1*^6}]; Length@z]
Timing[Length[zz = List @@ Flatten[z,Infinity,h]]]

{4.25 Second,2}
{0.71 Second,1000000}

zz === ss

True

[toc] | [prev] | [standalone]

Back to top | Article view | comp.soft-sys.math.mathematica

csiph-web