Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

Sign up
Here's how it works:
  1. Anybody can ask a question
  2. Anybody can answer
  3. The best answers are voted up and rise to the top

I have the following fairly simple routine dot involving PermutationProduct that I wish to speed up using Compile or otherwise.

I am applying the Function simultaneously to large Lists of arguments

X={x1,x2,...}; Y={y1,y2,...}

using ParallelTable in the format

ParallelTable[dot[X[[i]], Y[[j]]], {i, Length[X]}, {j, Length[Y]}]

The Function is defined:

dot[x_, y_] := Block[
  {l = Length[x]}, Cases[Select[#, ! (l < # <= 3 l) &] & /@
     PermutationProduct[
       Cycles[y + 2 l],
       Cycles[Table[{2 l - i + 1, 2 l + i}, {i, l}]],
       Cycles[x]
       ][[1]], Except[{}]]
   /. Table[3 l + i -> i + l, {i, l}]]

The arguments x and y are Lists of the same Length consisting of partitions of the set {1,2,...,2n} into pairs where n is the Length of the arguments; and dot[x,y] is a List of the same form.

For example, where n == 4, the dot of elements

x = {{1, 2}, {3, 8}, {6, 5}, {4, 7}}
y = {{2, 3}, {5, 6}, {4, 1}, {8, 7}}

is

dot[x, y] == {{1, 2}, {3, 4}, {5, 6}, {7, 8}}

The order of the elements and subelements of x, y and dot[x,y] are irrelevant.

Any and all suggestions on improving the efficiency of this code will be enormously appreciated!

Thanks and regards,

Daniel

share|improve this question

closed as off-topic by blochwave, MarcoB, Louis, m_goldberg, Yves Klett Dec 2 '15 at 13:58

This question appears to be off-topic. The users who voted to close gave this specific reason:

  • "The question is out of scope for this site. The answer to this question requires either advice from Wolfram support or the services of a professional consultant." – blochwave, MarcoB, Louis, m_goldberg, Yves Klett
If this question can be reworded to fit the rules in the help center, please edit the question.

4  
Cycles, PermutationProduct et al. are not compilable. The way out would be to rewrite these two functions in a procedural way, C-style and then you might have a better chance of being able to compile. – R. M. Sep 15 '12 at 16:02
2  
This can probably be done with SparseArrays, which although not compilable may present some possibilities for optimization. Perhaps someone with more experience (than me) in this area of mathematics will be able to present an implementation in terms of permutation matrices. – Oleksandr R. Sep 15 '12 at 16:59

I tried a compiled version of PermutationProduct on your cycles. A list of transpositions happen to form a regular array that can be compiled. However, PermutationProduct was just as good, after I compiled to C. So there's not much to be gained there. So I turned my attention to processing its result, which is not a regular array. The following cuts the time by 40% or so. The go-to tools here for dealing with inequalities are UnitStep and Pick. (See for instance, item 2.3 of Leonid Shifrin's answer to Performance tuning in Mathematica?.)

dot2[x_, y_] := Block[{l = Length[x]},
  Mod[DeleteCases[
    Pick[#,
       UnitStep[# - l - 1] UnitStep[3 l - #], 0] &@
     PermutationProduct[
       Cycles[y + 2 l],
       Cycles[Table[{2 l - i + 1, 2 l + i}, {i, l}]],
       Cycles[x]][[1]], {}], 2 l, 1]
  ]

Block[{
  x = Partition[Range[100], 2],
  y = Partition[RandomSample@Range[100], 2]},
 {res = dot[x, y]; // RepeatedTiming, 
  res2 = dot2[x, y]; // RepeatedTiming}
 ]
(*  {{0.00096, Null}, {0.00054, Null}}  *)

res == res2
(*  True  *)
share|improve this answer

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