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 am doing this to learn association rules. The data d is in format {id, value}, for example:

{{0, 29}, {1, 30}, {1, 31}, {1, 32}, {2, 33}, {2, 34}, {2, 35}, {3, 36}, {3, 37}, {3, 38},
 {3, 39}, {3, 40}, {3, 41}, {3, 42}, {3, 43}, {3, 44}, {3, 45}, {3, 46}, {4, 38}, {4, 39},
 {4, 47}, {4, 48}, {5, 38}, {5, 39}, {5, 48}}

Bigger data example (task I am using it for has x100 amount data)

I want to find number of id's that contain values {x, y} and P(x|y). Something like:

Contains[d_, x_] := Take[Transpose[Select[d, #[[2]] == x &]], 1][[1]]
ContainsBoth[d_, x_, y_] := Length[Intersection[Contains[d, x], Contains[d, y]]]
ProbabilityOfXGivenY[d_, x_, y_] := ContainsBoth[d, x, y]/Length[Contains[d, y]]

I would like to print out a table or export into a file

enter image description here

As my effort, I can write a brute force solution, that works well for input size of 100 instances.

GetRow[d_, {x_, y_}] := {x, y, ContainsBoth[d, x, y], 
  100 ProbabilityOfXGivenY[d, x, y] // N, 
  100 ProbabilityOfXGivenY[d, y, x] // N}
Select[GetRow[d, #] & /@ 
  Select[Tuples[DeleteDuplicates[Transpose[d][[2]]], 2], 
    (#[[1]] < #[[2]]) &], #[[3]] > 1 &];
TableForm[%, TableHeadings -> {Automatic, {"x", "y", "\[Exists]{x,y}", "P(x|y)", "P(y|x)"}}]

edit: I slightly improved my bruteforce solution:

d = Import["https://raw.github.com/gist/4040530/
  fb175e2134559351354572a4aa0554d462cae31b/gistfile1.txt", "Package"];
data = Take[d, 100000];

MultiSet[hm_, key_, value_] := hm[key] = value;
ContainsBoth[hm_, x_, y_] := Length[Intersection[MS[x], MS[y]]]
P[hm_, x_, y_] := 100 (ContainsBoth[hm, x, y]/Length[hm[y]])
GetRow[d_, {x_, y_}] := {x, y, ContainsBoth[d, x, y], P[d, x, y] // N, P[d, y, x] // N}

Timing[
 Clear[MS];
 MultiSet[MS, #[[1, 2]], #[[All, 1]]] & /@ SplitBy[SortBy[data, Last], Last];
 parsedData = {#[[1, 1]], #[[All, 2]]} & /@ SplitBy[SortBy[data, First], First];
 nrnodes = Length[pairs = DeleteDuplicates[Flatten[Subsets[#, {2}] & /@ 
   parsedData[[All, 2]], 1]]];
 result = GetRow[MS, #] & /@ pairs;
 nrnodes]

This completes in 41.091 s on my computer.

Export[FileNameJoin[{NotebookDirectory[], "datax.csv"}], Reverse[SortBy[result, #[[3]] &]]]
share|improve this question
    
I suspect your question might be, is there a more efficient method ? –  image_doctor Nov 8 '12 at 20:01
    
Well the Select[Tuples[DeleteDuplicates and Take[Transpose[Select[d, #[[2]] == x &]], 1][[1]] are like the dumbest things ever, but I am not sure how to store the data in Mathematica. –  Margus Nov 8 '12 at 20:05
add comment

2 Answers

up vote 5 down vote accepted

(Edited to respond to comments: the algorithm has been changed and evidence added to show how it reproduces the example in the question.)


Why not exploit built-in procedures to do this work? I refer to matrix multiplication (Dot) for the counting and SparseArray for managing its results. These will do fine given that $x$ and $y$ are integers falling within reasonable ranges. To make life easy, I add $1$ to their values (because SparseArray cannot index from $0$) and later subtract $1$--watch for these moves.

Also, it appears that trivial co-occurrences are not to be reported: only table entries where the third column exceeds $1$ should be output.

a = SparseArray[data + 1 -> ConstantArray[1, Length[data]]];
colsums = Total /@ Transpose[a];
x = Union[data[[All, 2]]] + 1;
x = Select[{x, colsums[[x]]}\[Transpose], Last[#] > 1 & ][[All, 1]];
b = a[[All, x]]\[Transpose] . a[[All, x]]

All the needed information is contained in matrix b:

AbsoluteTiming[
    results = Flatten[ParallelTable[{x[[i]] - 1, x[[j]] - 1, b[[i, j]], 
      b[[i, j]] / b[[j, j]], b[[i, j]] / b[[i, i]]}, 
     {i, 1, Length[x] - 1}, {j, i + 1, Length[x]}], 1];]

{66.3937166, Null}

As an example of how this works, let's consider the data in the question:

data = {{0, 29}, {1, 30}, {1, 31}, {1, 32}, {2, 33}, {2, 34}, {2, 35}, {3, 36}, {3, 37}, {3, 38}, {3, 39}, {3, 40}, {3, 41}, {3, 42}, {3, 43}, {3, 44}, {3, 45}, {3, 46}, {4, 38}, {4, 39}, {4, 47}, {4, 48}, {5, 38}, {5, 39}, {5, 48}};

The a and b matrices look like these:

ArrayPlot[a]

Array a

ArrayPlot[b]

ArrayP b

A tabulation of results shows how the output in the question is correctly reproduced:

TableForm[results, TableHeadings -> {Range[Length[results]], {"x", "y", "Pairs", "x|y", "y|x"}}]

Table

share|improve this answer
    
Tally does not seem to do any reduction of the data, i.e. Length[data] == Length[Tally[data]]. –  Sasha Nov 8 '12 at 23:39
    
@Sasha Try it--look at the output. Or experiment with a subset of the data. I can't speak to what's in the data, of course: if it happens to be the case that each ordered pair occurs just once, you can eliminate Tally. For the general problem as stated (and illustrated), tallying seems like an essential step. –  whuber Nov 8 '12 at 23:41
    
I see, the intent of Tally was to help get to the SparseArray rules. You could have done SparseArray[Thread[(1+data)->1]] instead. I'm not nitpicking, just trying to understand what you did. –  Sasha Nov 8 '12 at 23:47
1  
@Sasha That's fine--I really appreciate the review, because I'm concerned I may have overlooked something crucial (my solution looks too simple!) For an example of why Tally might be needed, consider processing an artificial dataset such as data = RandomInteger[MultivariatePoissonDistribution[30, {20, 40}], 100000]. Note how the output of Tally (in variable t) is needed at the end. –  whuber Nov 8 '12 at 23:55
    
That is efficient code. However it is completely wrong or I miss to understand what you did. Maybe this will help, in case of data = Take[data, 1000]; the result I am looking for looks like: img831.imageshack.us/img831/8020/newsql.png. –  Margus Nov 9 '12 at 1:38
show 1 more comment

Read in you data:

data = Import[
   "https://raw.github.com/gist/4040530/\
fb175e2134559351354572a4aa0554d462cae31b/gistfile1.txt", "Package"];

Parse the list of {id,value} into the aggregated list {{id1, valuesList1},{id2,valuesList2},...}}.

parsedData = {#[[1, 1]], #[[All, 2]]} & /@ 
   SplitBy[SortBy[data, First], First];

We can now rebuild your function GetRow to compute the count and conditional probabilities in one go for efficiency:

oGetRow[pd_, {x_, y_}] := 
 Block[{mask = 
    Cases[pd, {id_, vals_} :> 
      Block[{h1 = MemberQ[vals, x], 
        h2 = MemberQ[vals, y]}, {Boole[h1], Boole[h2]} /; h1 || h2]], 
   both},
  both = Count[mask, {1, 1}];
  If[both > 1,
   {x, y, both, 100. both/Count[mask[[All, 2]], 1], 
    100. both/Count[mask[[All, 1]], 1]},
   {x, y, both, 0, 0}
   ]
  ]

Selecting pairs of values, where the count is greater than 0 can be done much more efficiently:

In[14]:= Length[
 pairs = DeleteDuplicates[
   Flatten[Subsets[#, {2}] & /@ parsedData[[All, 2]], 1]]]

Out[14]= 565322

You original attempt would need to go through approximately 3*10^8 pairs, vast majority of which would need to be discarded.

Now going through the entire data set takes some time, so it can use ParallelMap:

AbsoluteTiming[
 res = Cases[
    ParallelMap[oGetRow[parsedData, #] &, pairs], {_, _, 
     Except[0 | 1], _, _}];]

Using 4 cores this takes over 15 minutes.

So I decided to get a subset of pairs to estimate the timing.

In[18]:= AbsoluteTiming[
 res = Cases[
    ParallelMap[oGetRow[parsedData, #] &, pairs[[;; 1000]]], {_, _, 
     Except[0 | 1], _, _}];]

Out[18]= {42.486000, Null}

Thus the projected time on a 4-core machine is almost 7 hours, so within reach of an overnight computation.

In[21]:= 42.486 565/3600.

Out[21]= 6.66794

Using 16-core machine it finished much faster.

In[5]:= AbsoluteTiming[
 res = Cases[
    ParallelMap[oGetRow[parsedData, #] &, pairs], {_, _, 
     Except[0 | 1], _, _}];]                        


Out[5]= {2271.047723, Null}

In[6]:= Length[res]

Out[6]= 76660

In[7]:= Export["~/res.m", res]

Out[7]= ~/res.m

If you are interested in the output, let me know.

share|improve this answer
1  
It takes me a bit to follow but, ˇLength[pairs = DeleteDuplicates[Flatten[Subsets[#, {2}] & /@ parsedData[[All, 2]], 1]]]ˇ in this case is 565322 and not 5357. –  Margus Nov 8 '12 at 22:19
    
My bad. The result of my evaluation was for the subset of data. I will correct that –  Sasha Nov 8 '12 at 22:23
    
@Margus It looks like processing the entire data-set will require some 7 hours of a 4-core machine (mine is few years old laptop). –  Sasha Nov 8 '12 at 23:09
add comment

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.