Tracking back a variable corresponding to an output

Question

I have a function:

An[n_Integer]:=  
 Join[-Table[Subscript[\[Alpha], i],{i,1,n}],Table[Subscript[\[Alpha], i],{i,1,n}],
  Plus@@@Flatten[Table[Partition[#,i,1],{i,2,n}]& @ Table[Subscript[\[Alpha], i],{i,1,n}],1]
  ] 

Which gives me a list, for example:

An[2]

{-Subscript[[Alpha], 1], -Subscript[[Alpha], 2], Subscript[[Alpha], 1], Subscript[[Alpha], 2], Subscript[[Alpha], 1] + Subscript[[Alpha], 2]}

Now I assign:

SR = Table[Subscript[\[Alpha], i]=ReplacePart[ConstantArray[0,n+1],{i->1,i+1->-1}],{i,1,n}]

So now if An is executed all the elements in the output list are determined by SN, for instance:

An[2][[1]]

{-1, 1, 0}

Now, I have a function that finds a reflection of a vector, in a mirror through the origin, normal to some vector:

Reflection[l_List,k_List]:=Module[{rt=ReflectionTransform[l]}, rt[k] ]

So for instance:

Reflection[Subscript[\[Alpha], 1],Subscript[\[Alpha], 1]]

{-1, 1, 0}

We can see that the list above corresponds to An[2][[1]] which was -Subscript[[Alpha], 1] before the SR was defined. This is my question, how can I define this 'tracking back' computationally? So, basically, the output of the Reflection function should be one of the

{-Subscript[[Alpha], 1], -Subscript[[Alpha], 2], Subscript[[Alpha], 1], Subscript[[Alpha], 2], Subscript[[Alpha], 1] + Subscript[[Alpha], 2]}

or an empty list, if the vector after reflection doesn't match with any of the An, where An is executed after defining SR. I fell like I am somehow over complicating this, but don't seem to be able to figure this out. Can someone help?

Answer 1

Best would be to never make any assignments to the $\alpha_i$ and keep the replacement rules in SR as a list of rules. Also, the decomposition at the end can be done with a PseudoInverse. Here's a working version:

An[n_Integer] := 
  Join[-Table[Subscript[α, i], {i, 1, n}], 
        Table[Subscript[α, i], {i, 1, n}], 
        Plus @@@ Flatten[Table[Partition[#, i, 1], {i, 2, n}] &@
          Table[Subscript[α, i], {i, 1, n}], 1]]

An[2]

$$ \left\{-\alpha _1,-\alpha _2,\alpha _1,\alpha _2,\alpha _1+\alpha _2\right\} $$

Construct SR as a list of rules instead of assigning to the $\alpha_i$:

With[{n = 2},
  SR = Table[Subscript[α, i] -> 
    ReplacePart[ConstantArray[0, n + 1], {i -> 1, i + 1 -> -1}], {i, 1, n}]]

$$ \left\{\alpha _1\to \{1,-1,0\},\alpha _2\to \{0,1,-1\}\right\} $$

Extract the information from these rules:

F = PseudoInverse[SR[[All, 2]]];
f = SR[[All, 1]];

Try out the rules:

An[2] /. SR

$$ \{\{-1, 1, 0\}, \{0, -1, 1\}, \{1, -1, 0\}, \{0, 1, -1\}, \{1, 0, -1\}\} $$

Reflection[l_List, k_List] := Module[{rt = ReflectionTransform[l]}, rt[k]]

Try out a reflection:

Reflection[Subscript[α, 1] /. SR, Subscript[α, 1] /. SR]

$$ \{-1, 1, 0\} $$

Convert into an expression with $\alpha_i$:

(%.F).f

$$ -\alpha_1 $$

Do this with all elements of An[2]:

((An[2] /. SR).F).f

$$ \left\{-\alpha _1,-\alpha _2,\alpha _1,\alpha _2,\alpha _1+\alpha _2\right\} $$