# Adding and subtracting from elements in a list

I'm trying to solve an aparently simple problem.

Given a list of length n, {a1,b1,c1,d1...} I want to perform two simple operations, and form a new list from each one: {a1+1,b1-1,c1,d1...}, {a1,b1+1,c1-1,d1...}, {a1,b1,c1+1,d1-1...} and so on, and {a1-1,b1+1,c1,d1...} and so on.

The list elements must not be greater or less than certain values after the addition or substraction. In {a1+1,b1-1,c1,d1...}, {a1,b1+1,c1-1,d1...}, {a1,b1,c1+1,d1-1...} each element must be constrained: a1<max and b1>0, b1<max and c1>0, etc.

Using this lists I finally use the original list and the n new lists to get a list of the form: {Join[list,new1],Join[list,new2],...}

To solve this problem I wrote a code that although works, takes a very long time to calculate for several sets of list {{a1,b1,c1,d1...}, {a2,b2,c2,d2...}...}. Here I post an example using only a list with two sublists, with four elements each one: {{1, 2, 0, 2}, {2, 2, 1, 1}}

lst1 = {{1, 2, 0, 2}, {2, 2, 1, 1}};
dim = Partition[Range[Length@First@lst1], 2, 1];
list = li[]; (*to save the "composed" lists*)

(lst = #;
lst2 = Partition[lst, 2, 1];

lst31 = MapThread[If[#1 < 2 && #2 > 0, {#1 + 1, #2 - 1}, {#1, #2}] &,Transpose@lst2];
lst41 = Union@MapThread[ReplacePart[lst, {#1[[1]]-> #2[[1]], #1[[2]]-> #2[[2]]}]&, {dim,lst31}];

lst32 = MapThread[If[#1 > 0 && #2 < 2, {#1 - 1, #2 + 1}, {#1, #2}]&,Transpose@lst2];
lst42 = Union@MapThread[ReplacePart[lst, {#1[[1]]-> #2[[1]], #1[[2]]-> #2[[2]]}]&, {dim, lst32}];

lst61 = Join[lst, #] & /@ lst41;
lst62 = Join[lst, #] & /@ lst42;
lst6 = Union@Join[lst61, lst62];
list = li[list, lst6];
) & /@ lst1;

list = List @@ Flatten@list


Any advice to improve the performance of the code would be greatly appreciated!

Edit

Based on comments, I tried to explain better the second part of my problem giving a numerical example.

Edit 2

I have added a more precise description about the constraints of the elements of the lists.

-
Could you give a numerical example of your composed lists? I'm not sure I understand what you mean there. – Vincent Tjeng Mar 26 '13 at 5:09
Hi! I already put in there a numerical example. Thanks! – kurush Mar 26 '13 at 13:13
kurush, I looked at your code again and I am wondering if it really is working as you intend. For example, should there be {1, 2, 0, 2, 0, 2, 0, 2} in the output for the first input list? What about these for the second?: {{2, 2, 1, 1, 1, 2, 1, 1}, {2, 2, 1, 1, 2, 1, 1, 1}, {2, 2, 1, 1, 2, 2, 0, 1}} – Mr.Wizard Mar 30 '13 at 23:13
That's weird. I'm getting from the first input list {{1, 2, 0, 2, 1, 1, 1, 2}, {1, 2, 0, 2, 1, 2, 0, 2}, {1, 2, 0, 2, 1, 2, 1, 1}, {1, 2, 0, 2, 2, 1, 0, 2}} and from the second one {{2, 2, 1, 1, 2, 1, 2, 1}, {2, 2, 1, 1, 2, 2, 0, 2}, {2, 2, 1, 1, 2, 2, 1, 1}, {2, 2, 1, 1, 2, 2, 2, 0}} as intended. – kurush Mar 31 '13 at 17:00

I don't understand the second part of your question so I shall address the first.
Here is a method that should be reasonably fast and versatile.

lst = CharacterRange["a", "j"];
n = Length @ lst;
offsets = NestList[RotateRight, PadRight[{1, -1}, n], n - 2];
lst2 = lst + # & /@ offsets;

lst2 // Column

{1+a,-1+b,c,d,e,f,g,h,i,j}
{a,1+b,-1+c,d,e,f,g,h,i,j}
{a,b,1+c,-1+d,e,f,g,h,i,j}
{a,b,c,1+d,-1+e,f,g,h,i,j}
{a,b,c,d,1+e,-1+f,g,h,i,j}
{a,b,c,d,e,1+f,-1+g,h,i,j}
{a,b,c,d,e,f,1+g,-1+h,i,j}
{a,b,c,d,e,f,g,1+h,-1+i,j}
{a,b,c,d,e,f,g,h,1+i,-1+j}


Here is a faster method based on techniques described here.

lst = CharacterRange["a", "j"];
n = Length @ lst;
offsets = Sum[DiagonalMatrix[SparseArray[{}, n - 1, 1 - 2 i], i, {n - 1, n}], {i, 0, 1}];
lst2 = ConstantArray[lst, n - 1] + offsets;

-
Thanks for your answer. In the original post I already put a better explanation of the second part of the question. However, is there some way to put constraints in the values of the lists elements? If you have {...a+1,b-1...} exclude results if a is greater than a certain value (say 2) or if b is less than a certain value (say 0)? – kurush Mar 26 '13 at 13:14
Well, thanks. Your suggestions really improved the performance of my code. – kurush Mar 29 '13 at 15:37
@kurush Sorry, I somehow didn't see the update to your question until I noticed the Accept. (Thanks.) Let me see if I understand this right: if the additions or subtractions on any specific element would cause it to be outside the interval [0, 2] the original value should be used instead. Is that correct? Are you inputs always integer valued lists? If so we can efficiently use Clip. Let me know and I'll update my answer either way. – Mr.Wizard Mar 29 '13 at 18:22
Yes, that's the part of my code MapThread[If[#1 < max && #2 > min, {#1 + 1, #2 - 1}, {#1, #2}] &,Transpose@lst2]. If the elements are outside the interval defined by [min,max] then the program returns the default value. And yes, they are always integers. In my version using your suggestions this part stayed untouched. – kurush Mar 30 '13 at 1:34

For completeness (since it's also mentioned in the link provided by Mr. Wizard), here is an approach using Band:

lst = CharacterRange["a", "j"];
Outer[Times, Most[1 & /@ lst], lst] +
SparseArray[{Band[{1, 1}] -> 1, Band[{1, 2}] -> -1}, {# - 1, #} &@
Length[lst]]


$\left( \begin{array}{cccccccccc} \text{a}+1 & \text{b}-1 & \text{c} & \text{d} & \text{e} & \text{f} & \text{g} & \text{h} & \text{i} & \text{j} \\ \text{a} & \text{b}+1 & \text{c}-1 & \text{d} & \text{e} & \text{f} & \text{g} & \text{h} & \text{i} & \text{j} \\ \text{a} & \text{b} & \text{c}+1 & \text{d}-1 & \text{e} & \text{f} & \text{g} & \text{h} & \text{i} & \text{j} \\ \text{a} & \text{b} & \text{c} & \text{d}+1 & \text{e}-1 & \text{f} & \text{g} & \text{h} & \text{i} & \text{j} \\ \text{a} & \text{b} & \text{c} & \text{d} & \text{e}+1 & \text{f}-1 & \text{g} & \text{h} & \text{i} & \text{j} \\ \text{a} & \text{b} & \text{c} & \text{d} & \text{e} & \text{f}+1 & \text{g}-1 & \text{h} & \text{i} & \text{j} \\ \text{a} & \text{b} & \text{c} & \text{d} & \text{e} & \text{f} & \text{g}+1 & \text{h}-1 & \text{i} & \text{j} \\ \text{a} & \text{b} & \text{c} & \text{d} & \text{e} & \text{f} & \text{g} & \text{h}+1 & \text{i}-1 & \text{j} \\ \text{a} & \text{b} & \text{c} & \text{d} & \text{e} & \text{f} & \text{g} & \text{h} & \text{i}+1 & \text{j}-1 \\ \end{array} \right)$

-
Outer[Times, Most[1 & /@ lst], lst] seems wasteful; why did you choose that? – Mr.Wizard Mar 26 '13 at 6:40
What's wrong with Outer[ ] in this context? Is there a slicker way to make the matrix? – bill s Mar 26 '13 at 6:48
@bill There's nothing wrong with it, but the Map and Times operations are not needed, hence "wasteful" -- it seems pragmatically better to me to use ConstantArray[lst, Length@lst - 1]. – Mr.Wizard Mar 26 '13 at 6:53
Nice! So you could just say: ConstantArray[lst, Length[lst] - 1] + SparseArray[{Band[{1, 1}] -> 1, Band[{1, 2}] -> -1}, {# - 1, #} &@ Length[lst]] – bill s Mar 26 '13 at 7:22
Thanks for the answers! – kurush Mar 26 '13 at 13:15