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];
Improve this question
$\endgroup$
10
  • $\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$ Commented Oct 22, 2015 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$ Commented Oct 22, 2015 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$ Commented Oct 22, 2015 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$ Commented Oct 22, 2015 at 16:40
  • $\begingroup$ Ok, I edited again, I hope it's clearer now $\endgroup$ Commented Oct 22, 2015 at 16:47

2 Answers 2

Reset to default
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}]
Improve this answer
$\endgroup$
1
  • $\begingroup$ Ok, it works perfectly. Thank you very much! $\endgroup$ Commented Oct 22, 2015 at 21:22
4
$\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 *)
Improve this answer
$\endgroup$

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.