Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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
           ];

        ProjectedElemsIndex[ElemPtsCoord_, ElemElemsMadeofPtsIndex_, Acen_, 
           Bcen_, Ccen_, R1_, RetainElementsIndex_] := Module[
           {RELPtsIndex, temp1, temp2},

           RELPtsIndex = ElemElemsMadeofPtsIndex[[RetainElementsIndex]];

           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]
            ]

           ];

    Length[ProjectedElemsIndex[ElemPtsCoord, ElemElemsMadeofPtsIndex, 40, 
       40, 40, 10, RetainElementsIndex]] // Timing
share|improve this question
    
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 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 at 14:01

1 Answer 1

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_,
 ElemElemsMadeofPtsIndex_,
 Acen_, Bcen_, Ccen_, R1_,
 RetainElementsIndex_
] :=
 Module[{RELPtsIndex, temp1, temp2, a},
   RELPtsIndex = ElemElemsMadeofPtsIndex[[RetainElementsIndex]];
   temp1 = ElemPtsCoord[[#]] & /@ RELPtsIndex;
   temp2 = Table[{Acen, Bcen, Ccen}, {Length[temp1]}, {4}];
   a = Map[Norm, temp1 - temp2, {2}] - R1;
   SparseArray[UnitStep[a] ~Total~ {2}, Automatic, 4]["AdjacencyLists"]
 ];

Timing:

ProjectedElemsIndex[ElemPtsCoord, ElemElemsMadeofPtsIndex, 40, 40, 40, 10, 
   RetainElementsIndex] // Length // Timing
{0.327602, 2797}

Your original code yields:

{2.262014, 2797}
share|improve this answer
    
@ Mr.Wizard,Yes, Your answer is very quick and cool, thanks for your help these days. and now I realize how powerful Mathematica it is, and so many things I need to learn. A good code design will save me so many time. Thanks! –  user18688 Jul 22 at 14:12
    
I want to know what you ate to change your mood. I could use a little something that would excite my interest in some of the current crop of questions. As long as it not an illegal substance, of course :-) –  m_goldberg Jul 22 at 14:58
    
@m_goldberg I'm afraid my strange eating habits will help no one, but since you asked: corn chips and salsa, summer squash, and chocolate. (Not all together.) I'm having an artichoke next. Bet you've never had that meal before. :o) –  Mr.Wizard Jul 22 at 15:02
    
No, can't say I have. But it doesn't sound bad. I like all the individual ingredients you mentioned. –  m_goldberg Jul 22 at 15:05
    
@m_goldberg You're right, it was not bad. I guess the strange part is my eating it at 7:00AM. :^) –  Mr.Wizard Jul 22 at 15:07

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.