4
$\begingroup$

Suppose I have a vector.

I assign to every vector index a four-element array, in such a way that index i corresponds to {x1,p1,x2,p2}, where x1,x2 range from a $[-n,n]$ interval ($n$ is a constant defined elsewhere, used to define the dimension of my system) while p1,p2 are either $0$ or $1$. So, if the vector is {a,b,c,d,...,z}, for example, for $n=1$, I have

1 ------> {-1,0,-1,0}------> a
2 ------> {-1,0,-1,1}------> b
3 ------> {-1,0,0,0} ------> c
...
36------> {1,1,1,1}  ------> z

What I want to do now is rearranging the vector in such a way that the indexes are ordered like {x1,x2,p1,p2}:

1 ------> {-1,0,-1,0}------> a
2 ------> {-1,0,-1,1}------> b
7 ------> {-1,1,-1,0}------> g
8 ------> {-1,1,-1,1}------> h
...
36 -----> {1,1,1,1}  ------> z

Then, I'll have to generate another vector summing a+b+g+h as the first element, and so on, summing 4 elements at a time. At the end, I'll have a 9-element vector:

1 -----> {-1,-1} -----> a+b+g+h
...
9 -----> {1,1}   -----> j+k+y+z

Where j,k are the appropriate elements, chosen by the above rule.

What I do is writing a function that gives me all the 4-elements arrays with x1,p1,x2,p2s, then riffling this with my original vector, then ordering by x1 and x2, and finally summing the elements.

Is there a faster way to do this?

Here's my solution:

I start defining a positionFinder function:

positionFinder[index_Integer,n_]:=  
    PadLeft[IntegerDigits[index,MixedRadix[{2n+1,2,2n+1,2}]],4,0] - {n,0,n,0};

Then I define indexes as Length[vector[n]], and

poleposition[n_]:= Table[positionFinder[i-1,n],{i,1,indexes}];
positions[n_]:=
    Partition[Riffle[Part[poleposition[n],All,1],
                     Part[poleposition[n],All,3]],2];

So I have the positions list, i.e. an array {{-n(* ,0 *),-n(* ,0 *))},{-n (* ,0 *),-n (* ,1 *)},{-n(* ,1 *),-n+1(* ,0 *)}, ... , {-n(* ,1 *),-n(* ,0 *)},{-n(* ,1 *),-n(* ,1 *)},{-n(* ,1 *),-n+1(* ,0 *)} ... ,{n(* ,1 *),n(* ,1 *)}} (I commented the p1,p2 which make my array disordered). Now, I do

probGet[n_]:=Partition[Flatten[Riffle[positions[n],vector[n]]],3];

to join the positions and their correspondent vector element and

probCompute[n_]:=Sort[Sort[probGet[n],#1[[2]]>#2[[2]]&],#1[[1]]<#2[[1]]&];

to order my total array by the positions. Finally,

probExtract[n_]:= Part[probCompute[n],1;;-1;;4] + Part[probCompute[n],2;;-1;;4] + 
                  Part[probCompute[n],3;;-1;;4] + Part[probCompute[n],4;;-1;;4];
$\endgroup$
  • $\begingroup$ Post your solution! That way if we come up with different solutions, we can test speed against your solution (and we won't reproduce your solution). Also: how is n chosen? Is it related to the length of some list? Or is it a parameter in your problem? $\endgroup$ – march Oct 22 '15 at 15:36
  • $\begingroup$ @march that's correct, letters don't matter, that's why I chose j and k at the end. I'll edit the question with my solution. $\endgroup$ – Enzo Oct 22 '15 at 15:47
  • $\begingroup$ I was going to use your code to test my solution against yours, but MixedRadix is new in V10.2, which I don't have, so I have another question. How does "summing a+b+g+h" result in {-1, 1}? That part is unclear. However: your finding of positions and such is unnecessary, because of you just Sort your list of 4-tuples, it will bring it automatically into the form you want. You can then Partition[ ..., 4] and sum over those rows. I can show this if you can clear up the part about the final summation. $\endgroup$ – march Oct 22 '15 at 16:34
  • $\begingroup$ Summing a+b+g+h means summing the elements which are indexed by the same position. In the end, I'll have a vector like {{-1,-1,a+b+g+h}, ... ,{1,1,j+k+y+z}}. So "summing" does not result in {-1,-1}, they simply become "associated". I'm sorry if I'm being unclear. $\endgroup$ – Enzo Oct 22 '15 at 16:40
  • $\begingroup$ Ok, I edited again, I hope it's clearer now $\endgroup$ – Enzo Oct 22 '15 at 16:47
4
$\begingroup$

Since I cannot reproduce the ordering of your original list, I will make my own:

orderingList = RandomSample[
 Flatten[
   Outer[Riffle, Tuples[Range[-n, n], 2], Tuples[{0, 1}, 2], 1, 1]
  , 1];

We then get the correct ordering of this list by using SortBy with a custom ordering function using SortBy:

ordering = Last /@ SortBy[MapIndexed[Flatten@{#1, #2} &, orderingList], {#[[1]] &, #[[3]] &, #[[2]] &, #[[4]] &}];

Finally, we apply this ordering to the original list, partition, and sum. As an example, let's suppose that the values {a, b, c, ...} are

vals = Array[v, 36];

Then:

summedVals = Total /@ Partition[vals[[ordering]], 4];

should do the trick. Finally, add back in the coordinates, which we didn't have to keep track of because Mathematica sorts things consistently:

MapThread[Append[#1, #2] &, {Tuples[Range[-1, 1], 2], summedVals}]
$\endgroup$
  • $\begingroup$ Ok, it works perfectly. Thank you very much! $\endgroup$ – Enzo Oct 22 '15 at 21:22
3
$\begingroup$

Proposition

listForComponent[vec_, n_] := Flatten[
   Table[{x1, p1, x2, p2, 
          vec[[4 (2 n + 1) (x1 + n) + 2 (2 n + 1) p1 + 2 (x2 + n) + p2 + 1]]}, 
         {x1, -n, n}, {p1, 0, 1}, {x2, -n, n}, {p2, 0, 1}], 
   {1, 2, 3, 4}];

gatherComponents[vec_, n_] := GatherBy[listForComponent[vec, n],
                                        {#[[1]], #[[3]]} &];

addComponents[{{x1_, _, x2_, _, c1_}, {x1_, _, x2_, _, c2_}, 
               {x1_, _, x2_, _, c3_}, {x1_, _, x2_, _, c4_}}] := 
   {x1, x2, c1 + c2 + c3 + c4};

toNewVector[vec_, n_] := addComponents /@ gatherComponents[vec, n];

Explanation

I explain the above code by means of the following test vector:

testvector = Join[CharacterRange["a", "z"], CharacterRange["A", "J"]];
testvector // Short

(* {"a", "b", "c", "d", "e", <<26>>, "F", "G", "H", "I", "J"} *)

listForComponent generates the indices {x1, p1, x2, p2} for each vector component. The assignment follows the structure you detailed in your example and is given in the form {x1, p1, x2, p2, *Component*}.

listForComponent[testvector, 1] // Short

(* {{-1, 0, -1, 0, "a"}, {-1, 0, -1, 1, "b"}, <<33>>, {1, 1, 1, 1, "J"}} *)

gatherComponents gathers the vector components with respect to their values {x1, x2}.

gatherComponents[testvector, 1] // Short

(* {{{-1, 0, -1, 0, "a"}, {-1, 0, -1, 1, "b"}, {-1, 1, -1, 0, "g"}, 
     {-1, 1, -1, 1, "h"}}, <<8>>} *)

addComponents provides the sum of the vector components having the same {x1, x2}, and returns a list of the form {x1, x2, *SumOfComponents*}.

At last, toNewVector, the main function, uses addComponents on the output given by gatherComponents to return the result sought-after.

toNewVector[testvector, 1]

(* {{-1, -1, "a" + "b" + "g" + "h"}, {-1, 0, "c" + "d" + "i" + "j"}, 
    {-1, 1, "e" + "f" + "k" + "l"}, {0, -1, "m" + "n" + "s" + "t"}, 
    {0, 0, "o" + "p" + "u" + "v"}, {0, 1, "q" + "r" + "w" + "x"}, 
    {1, -1, "E" + "F" + "y" + "z"}, {1, 0, "A" + "B" + "G" + "H"}, 
    {1, 1, "C" + "D" + "I" + "J"}} *)

Comments

Given a vector and a specification n, the code will work only if the length of the vector is greater or equal to 4(2n+1)(2n+1). The "equal situation" has been shown above; for the "greater situation" the code will apply on the first 4(2n+1)(2n+1) components.

Timings

Here are some timings on my computer.

For n = 1 and an initial vector of length 36 ("equal situation")

Mean@Table[AbsoluteTiming[toNewVector[testvector, 1]][[1]], 1000]

(* 0.000367063 *)

For n = 2 and an initial vector of length 100 ("equal situation")

ltestvector = Array[v, 100];
Mean@Table[AbsoluteTiming[toNewVector[ltestvector, 2]][[1]], 1000]

(* 0.00105849 *)
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.