0
$\begingroup$

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?

$\endgroup$
2
$\begingroup$

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\} $$

$\endgroup$
  • $\begingroup$ That is great, thank you so much! I have never heard of pseudoinverses before, I really like your idea! $\endgroup$ – amator2357 May 29 at 12:55

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.