Hi everyone,
I have a code here that should in the end give an array containing chains (arrays of three dimensional points). I've tested it and have produced a small array of 32 chains of length 4 points.
The data should be small, and running the same code multiple times should not increase memory use... However, mine is always increasing, and MemoryUse[] returns values too high compared to the size of my data !
I can't find what's wrong ! Could someone help me ? I've given my code below, I left undetailed BooleanTuplesOneByOne, a basic subroutine I've written which gives one by one the elements of Tuples[{False,True},n] because I did not want to store Tuples[{False,True},n] in memory. I know for sure it's not causing the leak, I tested it and it is a simple alphabetical ordering algorithm... so nothing could go wrong there!
If needed I can explain the reasons behind all these routines, but it would be long and I was hoping someone could help me just by looking at the code structure rather than the why's and how's of my coding. I'm naturally more than happy to give any info I may have neglected to give!
Result = {{{0, 0, 0}}};
(*Liste des sauts premiers voisins d'un site octahédrique à un autre*)
NextSite = {{1/2, 1/2, 0}, {-(1/2), 1/2, 0}, {1/2, -(1/2),
0}, {-(1/2), -(1/2), 0}, {1/2, 0, 1/2}, {0, 1/2, 1/2}, {-(1/2), 0,
1/2}, {0, -(1/2), 1/2}, {1/2, 0, -(1/2)}, {0, 1/
2, -(1/2)}, {-(1/2), 0, -(1/2)}, {0, -(1/2), -(1/2)}};
NewResult = {};
While[Length[Result[[1]]] < 4,
Print[Timing[
NewResult = Fold[Function[{u, v},
Fold[Function[{x, y},
If[! MemberQ[v, v[[Length[v]]] + y] && !
CheckIfAlreadyInChainArrayBySymmetryAndNewOrigin[x,
Append[v, v[[Length[v]]] + y]],
Append[x, Append[v, v[[Length[v]]] + y]],
x
]
], u
, NextSite]
], NewResult
, Result];
Print["Time (s) :"];
][[1]]];
Result = NewResult;
NewResult = {};
Print["Size of Table : "];
Print[Result // Length];
Print["MemoryInUse : "];
Print[MemoryInUse[]];
Print["Context Length : "];
Print[Length[Names[$Context <> "*"]]];
Print["-------------------"];
];
CheckIfAlreadyInChainArrayBySymmetryAndNewOrigin[ResultArray_,
NewChain_] :=
Module[{BooleanResult, Index, f, BinaryBooleanArray,
TransformationNumber, TransformedNewChain, TransformationsArray},
BooleanResult = False;
f[1] = Function[u, (#*{-1, 1, 1}) & /@ u];
f[2] = Function[u, (#*{1, -1, 1}) & /@ u];
f[3] = Function[u, (#*{1, 1, -1}) & /@ u];
f[4] = Function[u, (#.{{0, -1, 0}, {-1, 0, 0}, {0, 0, 1}}) & /@ u];
f[5] = Function[u, (#.{{0, 1, 0}, {1, 0, 0}, {0, 0, 1}}) & /@ u];
f[6] = Function[u, (#.{{1, 0, 0}, {0, 0, -1}, {0, -1, 0}}) & /@ u];
f[7] = Function[u, (#.{{1, 0, 0}, {0, 0, 1}, {0, 1, 0}}) & /@ u];
f[8] = Function[u, (#.{{0, 0, 1}, {0, 1, 0}, {1, 0, 0}}) & /@ u];
f[9] = Function[u, (#.{{0, 0, -1}, {0, 1, 0}, {-1, 0, 0}}) & /@ u];
TransformationNumber = 9;
BinaryBooleanArray = Table[False, {i, 1, TransformationNumber}];
Index = 1;
TransformedNewChain = NewChain;
While[BooleanResult == False && Index <= Length[TransformedNewChain],
BooleanResult =
MemberQ[ResultArray,
Map[Function[u, u - TransformedNewChain[[Index]]],
TransformedNewChain]];
Index = Index + 1;
];
While[BooleanResult == False &&
BinaryBooleanArray != Table[True, {i, 1, TransformationNumber}],
BinaryBooleanArray = BooleanTuplesOneByOne[BinaryBooleanArray];
TransformedNewChain = NewChain;
TransformationsArray = MapIndexed[Function[{u, v},
If[u,
f[v[[1]]],
# &
]
], BinaryBooleanArray];
TransformedNewChain = Fold[Function[{u, v},
v[u]
], TransformedNewChain
, TransformationsArray];
Index = 1;
While[BooleanResult == False &&
Index <= Length[TransformedNewChain],
BooleanResult =
MemberQ[ResultArray,
Map[Function[u, u - TransformedNewChain[[Index]]],
TransformedNewChain]];
Index = Index + 1;
];
];
BooleanResult
]
