RE: Re: Re: Pattern Matching in Lists
- To: mathgroup at smc.vnet.net
- Subject: [mg35675] RE: [mg35633] Re: [mg35586] Re: Pattern Matching in Lists
- From: "DrBob" <majort at cox-internet.com>
- Date: Thu, 25 Jul 2002 04:46:13 -0400 (EDT)
- Reply-to: <drbob at bigfoot.com>
- Sender: owner-wri-mathgroup at wolfram.com
Fred's two solutions (both ingenious!) are simons1 and simons2 in the
code below. Allan Hayes' f5 is about ten times as fast as simons1, but
simons2 beat f5 with a p-value of 5.4% over 100 lists (for the lists of
2 million that I'm using).
On another trial with 200 lists, simons2 beat f5 by 8.4% with a p-value
of .00009. The % difference in Timing had the following 95% confidence
interval:
<< "Statistics`ConfidenceIntervals`"
MeanCI[(t1 - t2)/Mean[t1]]
{0.040925889018143896, 0.12796682963766004}
Hence simons2 is the winner by a margin between 4% and 13%.
Of course, it's possible that lists of different lengths or different
distributions of 0's and 1's would give different results.
I also replaced If with Which to get simons3. This made no real
difference, as I should have expected! (For 200 trials, I got a
difference of 0.8% and a p-value of 38.3%.)
Bobby
Needs["Statistics`HypothesisTests`"]
f1[w_] := Count[Partition[w, 2, 1], {1, 0}]
f2[w_] := Count[Drop[w, -1] - Drop[w, 1], 1] (* Allan Hayes *)
f3[w_] := Count[Drop[w + 2RotateRight[w], 1], 2]
f4[w_] := Tr[Drop[w, -1](Drop[w, -1] - Drop[w, 1])]
f5[w_] := (Tr[w] - Tr[BitAnd[w, RotateLeft[w]]]) + If[w[[1]] ==
0 && w[[-1]] == 1, -1, 0] (* Carl K. Woll, Allan Hayes *)
f6[w_] := (Tr[#] - Tr[# Drop[w, 1]]) &[Drop[w, -1]] (* Allan Hayes *)
f7 = Compile[{{w, _Integer, 1}}, Count[Drop[w, -1] - Drop[w,
1], 1]] (* Andrzej Kozlowski *);
f8[w_List] /; Last[w] == 1 && First[w] == 0 := Count[w - RotateLeft[w],
1];
f8[w_List] := Count[Drop[w, -1] - Drop[w, 1], 1] (* Andrzej *);
f9[w_] := Count[w - RotateLeft[w], 1] (* Andrzej *)
simons1[w_] := Count[ListCorrelate[{1, -1}, w], 1]
simons2[lst_] := (Tr[BitXor[lst, RotateLeft[lst]]] + If[lst[[1]] == 1,
0, If[lst[[-1]] == 1, -2, 0]])/2
simons3[w_] := (Tr[BitXor[w, RotateLeft[w]]] + Which[w[[1]] ==
1, 0, w[[-1]] == 1, -2, True, 0])/2
trial[f_, g_] := (n = 2000000; w = Table[Random[Integer], {n}];
First@Timing[#[w];]/Second & /@ {f, g}
)
test[f_, g_, n_Integer] := (
{t1, t2} = Transpose[trial[f, g] & /@ Range[n]];
Print[Mean /@ {t1, t2}];
Print[r = MeanTest[t1 - t2, 0, FullReport -> True]];
meanDiff = (FullReport /. r)[[1, 1, 1]];
Print["% difference = ", meanDiff/Mean[t1]])
test[f5, simons1, 40]
{0.07045000000000243, 0.7038500000000006}
{FullReport -> TableForm[{{"Mean", "TestStat", "Distribution"},
{-0.6333999999999982, -122.74356937717243,
StudentTDistribution[39]}},
TableHeadings -> {None, {"Mean", "TestStat", "Distribution"}}],
OneSidedPValue -> 2.1679176203297467*^-52}
% difference = -8.990773598
test[f5, simons2, 100]
{0.06879000000000246, 0.0654299999999978}
{FullReport -> TableForm[{{"Mean", "TestStat", "Distribution"},
{0.003360000000004675, 1.6229487334543304,
StudentTDistribution[99]}},
TableHeadings -> {None, {"Mean", "TestStat", "Distribution"}}],
OneSidedPValue -> 0.053890293563366165}
% difference = 0.04884430876587519
Here's timing for one list, for all 12 solutions:
Timing[#[w]]/{Second, 1} & /@ {f1, f2, f3, f4, f5, f6, f7,
f8, f9, simons1, simons2, simons3}
{{1.266, 500515}, {0.547, 500515}, {0.5, 500515}, {0.171, 500515},
{0.063, 500515}, {0.141, 500515}, {0.14, 500515}, {0.516, 500516},
{0.515, 500516}, {0.672, 500515}, {0.047, 500515}, {0.078, 500515}}
Bobby Treat
-----Original Message-----
From: Fred Simons [mailto:f.h.simons at tue.nl]
To: mathgroup at smc.vnet.net
Subject: [mg35675] [mg35633] Re: [mg35586] Re: Pattern Matching in Lists
Many postings have appeared how to find the number of occurences (1,0)
in a
sequence consisting of zeros and ones. My interest in these postings is
mainly in the various techniques used to solve the problem rather than
the
speed of the solution, though I immediately agree that a short and
elegant
solution usually is fast as well.
No doubt the shortest and most elegant solution is found by splitting
the
list into pairs and simply count the number of lists {1,0}. But that
turns
out not to be the fastest solution. The idea behind all other solutions
is
to look at the sequence of successive differences and then count the
number
1. So how to find this list of differences?
Two ways have been demonstrated:
Drop[lst, -1] - Drop[lst, 1]
Drop[lst - RotateLeft[lst], 1]
These two solutions are about as fast. Andrzej Kozlowsky noted that
dropping
the last element in the second solution is only necessary when the list
has
the structure {0, ..., 1} which for long lists may give some gain of
speed.
There is a third way, as fast as the two others:
ListCorrelate[{1,-1}, lst ]
The list of differences consists of the elements 1, 0 and -1. Instead of
using Count for counting the number of ones, Carl Woll in an ingenious
way
replaced the elements -1 by 0 and then used the trace function to count
the
number of ones. Successive improvements in the implementation of this
idea
bij Allan Hayes and Carl Woll lead to an amazing fast solution by Allan
Hayes.
Still another approach is possible, based on the observation that
between
any two occurences of {1,0} in the list there must be an occurence of
{0,1}. Therefore when the list starts with 1 and ends with 0, the number
of
1's in the list of diffences is one more than the number of -1's, etc.
Using
the same techniques as developed by Carl Woll and Allan Hayes we arrive
at
the following solution:
(Tr[BitXor[lst, RotateLeft[lst]]] + If[lst[[1]]==1,
0,If[lst[[-1]]==1, -2,0]]) / 2
Here is a timing for a list of length 5 10^6, compared with Alan's
solution:
In[126]:= lst = Table[Random[Integer], {5000000}];
(Tr[lst]-Tr[BitAnd[lst,RotateLeft[lst]]])+
If[lst[[1]]\[Equal]0&&lst[[-1]]\[Equal]1,-1,0]//Timing
(Tr[BitXor[lst, RotateLeft[lst]]]+
If[lst[[1]]\[Equal]1, 0,If[lst[[-1]]\[Equal]1, -2,0]]) / 2 //
Timing
Out[127]=
{1.42 Second,1249704}
Out[128]=
{0.88 Second,1249704}
Fred Simons
Eindhoven University of Technology