# A code deal with Lists operation ---Needs optimizion

I have written some code to deal with lists, But the speed of the code is slow, Could Someone help me to speed up it?

Probably could rewrite it with Functional Programming!

Give me some ideas!

The whole code is located on

Find sublists of a list match conditions (2)

CountTrue[list_] := Module[
{},
Count[list, True] >= 1
];

Bcen_, Ccen_, R1_, RetainElementsIndex_] := Module[
{RELPtsIndex, temp1, temp2},

temp1 =
Reap[Do[Sow[  ElemPtsCoord[[RELPtsIndex[[i]]  ]] ], {i, 1,
Length[RELPtsIndex]} ] ][[2, 1]];
temp2 = Table[Table[{Acen, Bcen, Ccen}, {4}], {Length[temp1]}];

Flatten[
Position[
Map[
CountTrue,
Negative[
Map[Norm, temp1 - temp2, {2}] -
Table[Table[R1, {4}], {Length[temp1 - temp2]}]
]
],
True]
]

];

40, 40, 10, RetainElementsIndex]] // Timing

• I'm sorry, my heart is not in this kind of problem right now. Hopefully someone else feels more inclined to help. I retagged the question as seemed appropriate. – Mr.Wizard Jul 22 '14 at 13:10
• I ate something and it put me in a better mood. Please see my answer below. I only refined the code presented; I did not attempt to refine the algorithm itself or reimagine the solution. – Mr.Wizard Jul 22 '14 at 14:01

### Regarding CountTrue:

1. There is generally no need for the empty Module. You can use CompoundExpression if you need several operations in sequence. Here even that is not necessary.

2. There is no need to count all appearances of True in an expression to determine if one is present: instead use MemberQ.

That gives us:

CountTrue[list_] := MemberQ[list, True]


### Regarding the main function:

Regarding the line:

temp1 =
Reap[Do[Sow[ElemPtsCoord[[RELPtsIndex[[i]]]]], {i, 1, Length[RELPtsIndex]}]][[2, 1]]

1. Sow and Reap are not needed here; a simple Table would suffice.
2. Rather than a numeric iterator i from 1 to Length[RELPtsIndex] you could use:

Table[ElemPtsCoord[[i]], {i, RELPtsIndex}]

3. Even that is overkill as a Map will do:

ElemPtsCoord[[#]] & /@ RELPtsIndex


Regarding the line:

temp2 = Table[Table[{Acen, Bcen, Ccen}, {4}], {Length[temp1]}];

1. You do not need to nest Table commands; there is a compound syntax:

Table[{Acen, Bcen, Ccen}, {Length[temp1]}, {4}]


Regarding the line(s):

Flatten[Position[
Map[CountTrue,
Negative[Map[Norm, temp1 - temp2, {2}] -
Table[Table[R1, {4}], {Length[temp1 - temp2]}]]], True]]

1. Length[temp1 - temp2] is strange; a subtraction is carried out on the arrays but the result is simply equivalent to Length[temp1]

2. Table[Table[ . . . could again be replaced with one Table, but:

3. The entire Table (or ConstantArray) output is simply taking the place of the Listable attribute, which the operator already has. Use instead:

Map[Norm, temp1 - temp2, {2}] - R1

4. Negative, CountTrue, Position and Flatten can all be replaced with:

SparseArray[UnitStep[a] ~Total~ {2}, Automatic, 4]["AdjacencyLists"]


Where a represents the output from (3) above.

### Rolling all of this into one:

ProjectedElemsIndex[
ElemPtsCoord_,
Acen_, Bcen_, Ccen_, R1_,
RetainElementsIndex_
] :=
Module[{RELPtsIndex, temp1, temp2, a},
temp1 = ElemPtsCoord[[#]] & /@ RELPtsIndex;
temp2 = Table[{Acen, Bcen, Ccen}, {Length[temp1]}, {4}];
a = Map[Norm, temp1 - temp2, {2}] - R1;
];


Timing:

ProjectedElemsIndex[ElemPtsCoord, ElemElemsMadeofPtsIndex, 40, 40, 40, 10,
RetainElementsIndex] // Length // Timing

{0.327602, 2797}


{2.262014, 2797}