Beefy Boxes and Bandwidth Generously Provided by pair Networks Cowboy Neal with Hat
go ahead... be a heretic
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
All,
I was was looking at Fastest Rising Monks by blakem and was sort of disapointed that I was not among the elite. Then curiosity got the better of me as I wanted to know how many monks that joined after me had more XP than me. I am not overly concerned with XP, but I do log in more than what mental health professions would consider healthy. Here is what I came up with:
#!/usr/bin/perl use strict; use warnings; use CGI ':standard'; use DBI; use File::Basename 'basename'; use Getopt::Std; use LWP::Simple; use HTML::TableExtract; use File::Temp 'tempfile'; my %opt; Get_Args(); Get_Data() if $opt{u}; my @top = map { [ '', '', '', '', '', 100 ] } 0 .. $opt{t}; my @items = qw(id name xp total higher p); Get_Stats(); Print_Stats(); sub Build_DB { if ( -e $opt{d} ) { unlink $opt{d} or die "Unable to remove $opt{d}"; } $opt{file} = basename( $opt{file} ); my $dbh = DBI->connect( "dbi:SQLite:dbname=$opt{d}" ) or die $DBI: +:errstr; $dbh->do( "CREATE TABLE pm (node_id, name, xp)" ) or die $dbh- +>errstr; $dbh->do( "COPY pm FROM '$opt{file}'" ) or die $dbh- +>errstr; $dbh->disconnect; } sub Get_Args { my $Usage = qq{Usage: $0 options -h : This help message. -d : Database name -m : Maximum number of monks to check -o : Output file -p : Per page monks to check -s : Skip monks with XP less than this number -t : Top number of monks for report -u : Update database } . "\n"; getopts( 'hd:m:o:p:s:t:u' , \%opt ) or die $Usage; die $Usage if $opt{h}; $opt{d} ||= 'pmstats.db'; $opt{m} ||= 2000; $opt{p} ||= 50; $opt{s} ||= 0; $opt{t} ||= 50; $opt{t}--; $opt{u} = 1 if exists $opt{u}; } sub Get_Data { my $table = new HTML::TableExtract( headers => [ 'Rank', 'Node ID', 'Name', 'Experience' ], ); my $url = 'http://tinymicros.com/pm/index.php?goto=MonkStats&start +='; my $offset = 0; while ( $offset < $opt{m} ) { my $html = get( $url . $offset ); $table->parse( $html ); $offset += $opt{p}; } ( my $fh, $opt{file} ) = tempfile( UNLINK => 1, DIR => '.' ); for my $table_state ( $table->table_states ) { for my $row ( $table_state->rows ) { print $fh join "\t" , @{$row}[1..3]; print $fh "\n"; } } Build_DB(); } sub Get_Stats { my $dbh = DBI->connect( "dbi:SQLite:dbname=$opt{d}" ) or die $DBI: +:errstr; my $sth = $dbh->prepare("SELECT * FROM pm"); my $sth_t = $dbh->prepare("SELECT COUNT(*) FROM pm WHERE node_id > + ?"); my $sth_h = $dbh->prepare("SELECT COUNT(*) FROM pm WHERE node_id > + ? AND xp > ?"); $sth->execute() or die $dbh->errstr; while ( my @rec = $sth->fetchrow_array ) { next if ! $rec[2] || $rec[2] < $opt{s}; $sth_t->execute( $rec[0] ) or die $dbh->errstr; $sth_h->execute( $rec[0], $rec[2] ) or die $dbh->errstr; my ($total) = $sth_t->fetchrow_array; next if ! $total; my ($higher) = $sth_h->fetchrow_array; my $percent = ($higher / $total) * 100; next if $percent > $top[-1][5]; for my $id ( 0 .. $opt{t} ) { if ( $percent < $top[$id][5] ) { my @stats = ($total, $higher, $percent); splice @top, $id, 0, [ @rec, @stats]; pop @top; last; } } } $sth_t->finish(); $sth_h->finish(); $dbh->disconnect; } sub Print_Stats { if ( $opt{o} ) { open( HTML, '>', $opt{o} ) or die "Unable to open $opt{o} for +writing : $!"; select HTML; } my $url = 'http://www.perlmonks.org/index.pl?node_id='; print start_html( -title => "Fastest Rising Monks", -bgcolor => "#fff +fcc" ), div( { -align => "center" }, p(h1( "Monks XP Compared To Newer Monk's XP" ) ), p(h2( "Selected from the top $opt{m} monks" ) ), p(h3( "Skipped Monks with XP less than $opt{s}" ) ), table( { -bgcolor => "#000000", -border => "0", -cellpadding => "2", -cellspacing => "1", }, Tr( { -style => "background-color:#CCCCCC" }, th( [ qw(Rank Monk XP), '# After', '# > XP', 'Perce +nt' ] ), ), Tr( { -style => "background-color:#CCCCCC" }, [ map {td([ $_ + 1, a({ href=>$url . $top[$_][0]}, $top[$_][1] +), $top[$_][2], $top[$_][3], $top[$_][4], sprintf( "%.4f", $top[$_][5] ), ]), } 0 .. $opt{t} ] ), ), ), end_html; }
Here is an example of the output.
$ pmstats -s 100 -t 500 -m 25000 -o pmstats.html
Out of the top 25,000 monks, 8,523 joined after me. Of those, only 7 have higher XP. I will leave modifying the code to spit out which monks as an excersise for the reader (as well as any other modifications you want to make).

Cheers - L~R

Update 1: Used more descriptive column labels, fixed platform dependencies (hopefully), and fixed a bug pointed out in the CB.
Update 2: Re-ran the stats using the top 25,000 and took bart's suggestion about using the full floating point percentage for ranking.

In reply to Fastest Rising Monks - Revisited by Limbic~Region

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others examining the Monastery: (7)
    As of 2014-04-20 16:30 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      April first is:







      Results (485 votes), past polls