Article 8322 of comp.lang.perl:

Article 8322 of comp.lang.perl:
Xref: feenix.metronet.com comp.lang.perl:8322
Newsgroups: comp.lang.perl
Path: feenix.metronet.com!news.utdallas.edu!hermes.chpc.utexas.edu!cs.utexas.edu!uunet!boulder!wraeththu.cs.colorado.edu!tchrist
From: Tom Christiansen <[email protected]>
Subject: Re: OID compare
Message-ID: <[email protected]>
Originator: [email protected]
Sender: [email protected] (USENET News System)
Reply-To: [email protected] (Tom Christiansen)
Organization: University of Colorado, Boulder
References: <[email protected]> <[email protected]>
Date: Wed, 24 Nov 1993 18:20:53 GMT
Lines: 167

:-> In comp.lang.perl, [email protected] (Clark Cooper) writes:
:
:[email protected] (Craig H. Smith) writes:
:> Here is an example of sorting OIDs (this brief list of OIDs is
:> sorted).
:>
:> 1
:> 1.1
:> 1.2
:> 1.2.3
:> 2
:> 3.9.1.20.11
:> 3.10.1.1
:>
:>
:> I've written a dirty OID compare algorithm:
:> ...
:> I would like to speed it up as much as I can because my program
:> becomes slow when sorting 900+ oids. Any hints/suggestions?
:
:Well, if the elements never exceed 255, you could convert them to
:strings with split and pack and use the regular string comparison.
:
:For instance:
:
:sub by_oid {
: pack("C*", split('\.', $a)) cmp pack("C*", split('\.', $b));
:}
:
:@ol = ('2','1.1','3.10.1.1','1','1.2.3','3.9.1.20.11','1.2');
:
:foreach (sort by_oid @ol)
:{
: print "$_\n";
:}
:
:If you needed to do more than one comparison or sort, it might be
:better to permanently place the related string into an associative
:array and use that for comparison.

That's still too slow. I can make it 5x faster.

# This is a shell archive. Remove anything before this line,
# then unpack it by saving it in a file and typing "sh file".
#
# Wrapped by on Wed Nov 24 11:18:42 MST 1993
# Contents: mkdata sid

echo x - mkdata
sed 's/^@//' > "mkdata" <<'@//E*O*F mkdata//'
#!/usr/bin/perl

srand;

for ($n = shift || 1000; $n > 0; $n--) {
for ($count = 1+rand(3); $count > 0; $count--) {
print int rand 20;
print "." if $count > 1;
}
print "\n";
}
@//E*O*F mkdata//
chmod u=rw,g=rw,o=r mkdata

echo x - sid
sed 's/^@//' > "sid" <<'@//E*O*F sid//'
#!/usr/bin/perl

$NTRIES = shift || 5;

while (<>) {
push(@data, $_);
}

&bench(<<'EOF');
print sort by_oid @data;
EOF

for (1 .. @data) {push(@idx, "1000000")}

&bench(<<'EOF');
$mask = "%03d" x 5;
@idx = ();
for (@data) {
push (@idx, sprintf($mask, split(/\./)));
}
for $i (sort { $idx[$a] <=> $idx[$b] } 0..$#idx ) {
print STDOUT $data[$i];
}
EOF

&bench(<<'EOF');
$mask = "%03d" x 5;
@idx = ();
for (@data) {
push (@idx, sprintf($mask, split(/\./)));
}
print STDOUT @data [ sort { $idx[$a] <=> $idx[$b] } 0..$#idx ];

EOF

&bench(<<'EOF');
foreach (sort pby_oid @data) { print }
EOF

&bench(<<'EOF');
@idx = ();
for (@data) { push (@idx, pack("C*", split('\.'))) }
print @data[sort { $idx[$a] cmp $idx[$b] } 0..$#idx];
EOF

sub pby_oid {
pack("C*", split('\.', $a)) cmp pack("C*", split('\.', $b));
}

sub ignore {};
sub IGNORE {};

sub bench {
local($code) = shift;
$Method_Count++;
local($su, $ss);

print STDERR "method $Method_Count:\n$code\n";

for ($try = 1; $try <= $NTRIES; $try++) {
print STDERR "\ttry $try: ";
($u, $s) = times;
eval $code;
die "CODE ERROR: $@\n $CODE\n" if $@;
($nu, $ns) = times;
printf STDERR "%8.4fu %8.4fs\n", ($nu - $u), ($ns - $s);
$su += ($nu - $u);
$ss += ($ns - $s);
}
printf STDERR "\nmethod $Method_Count, AVG: %8.4fu %8.4fs\n\n",
$su / $NTRIES,
$ss / $NTRIES;
}

sub by_oid {
local($oid1, $oid2) = ($a, $b);
local($pos, $max, @aa, @bb) = (0, 0);

@aa = split('\.', $oid1);
@bb = split('\.', $oid2);

$max = ( $#aa > $#bb ? $#aa : $#bb );

for(; $pos <= $max; $pos++) {
(return -1) if ( !defined($aa[$pos]) );
(return 1) if ( !defined($bb[$pos]) );
if ( $aa[$pos] != $bb[$pos] ) {
last;
}
}
return ( $aa[$pos] - $bb[$pos] );
}
@//E*O*F sid//
chmod u=rw,g=rw,o=r sid

exit 0
--
Tom Christiansen [email protected]
"Will Hack Perl for Fine Food and Fun"
Boulder Colorado 303-444-3212