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 <tchrist@cs.Colorado.EDU>
Subject: Re: OID compare
Message-ID: <CH0DMu.D7z@Colorado.EDU>
Originator: tchrist@wraeththu.cs.colorado.edu
Sender: news@Colorado.EDU (USENET News System)
Reply-To: tchrist@cs.colorado.edu (Tom Christiansen)
Organization: University of Colorado, Boulder
References: <9311231850.AA23981@eng.xyplex.com> <COOPERCL.93Nov24104714@dso052.sch.ge.com>
Date: Wed, 24 Nov 1993 18:20:53 GMT
Lines: 167

:-> In comp.lang.perl, coopercl@dso052.sch.ge.com (Clark Cooper) writes:
:
:craig@chs.xyplex.com (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      tchrist@cs.colorado.edu       
      "Will Hack Perl for Fine Food and Fun"
	Boulder Colorado  303-444-3212