Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
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
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            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 about the Monastery: (3)
    As of 2015-07-06 00:12 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









      Results (68 votes), past polls