| Author |
Comment/Response |
Yiannis Proestos
|
 09/19/06 09:30am
Hi,
Please, I would like some help regarding a special type of list manipulation that I want to perform in Mathematica. My question comes in two parts:
Given a list of the form:
ListA={{{b,1},{a1},{a,3}},{{b,1},{a3},{a,1}},{{a,2},{a,2},{b,1}},…,{{b,1},{a,2},{a,2}}, {{a,2},{b,1},{a,2}}},
where each element is rotationally invariant,
1. I want to eliminate instances that appear more than once. For example,
{{a,2},{a,2},{b,1}}, {{b,1},{a2},{a,2}} and {{a,2},{b,1},{a,2}} are rotationally the same and thus two of them must be dropped.
2. Form the final list that includes only the rotationally distinct elements, i.e.,
ListB={{{b,1},{a1},{a,3}},{{b,1},{a3},{a,1}},{{a,2},{a,2},{b,1}}}.
Thanks in advance,
Yiannis
P.S: I tried it by forming a "do-loop" that checks if two elements are rotationally equiv. I named it "sameclosedloops[loop1_, loop2]". The loops in this toy case where of the form
ListA[[i]]= {b[1],a[2],a[2]}, etc..
Then I formed the following functions that are trying to delete the rot. equivalent instances:
1. CompareJ[j_Integer,ListA_List]:=Cases[Table[If[sameclosedloops[ListA[[j]], ListA [[i+1]]]True,Cases[ListA,_?(# ListA [[i+1]]&)], ListA [[i+1]]],{i,j,Length[ListA]-1}],_?(#{}&)];
2. newListA[j_Integer,ListA_List]:=Join[Take[ListA,j],CompareJ[j,ListA]];
Then I tried use the last one in a recursion relation of the form:
ListB=newListA[n, newListA[n-1,newListA[... [newListA[1, ListA]]]]].
However, I have trouble telling the program to exit when the wanted ListB, which includes only the distinct elements is found. I tried by hand for a case where each element
had length 6 but it is very very time consuming. For my actual calculation I have elements that are up to length 16, and this approach seems inefficient.
URL: , |
|
