Beefy Boxes and Bandwidth Generously Provided by pair Networks
Keep It Simple, Stupid
 
PerlMonks  

Personal stats

by Tanktalus (Canon)
on Jan 14, 2006 at 18:09 UTC ( #523196=perlmeditation: print w/replies, xml ) Need Help??

I understand that XP isn't everything. It's not even a good indicator of anything past some vague idea of participation in PerlMonks. However, it is a guage of that participation, as are a few other stats you can easily get from your own homenode.

I initially wrote a quick tool to entertain myself with XP stats. In fact, I wrote it soon enough after joining PM that I also put in the ability to save my XP for the day to a CSV file, by date, for historical purposes.

Since then, I've used it in CB a few times as a cheap parlour trick to entertain a number of the other monks. And since it's just a simple perl script that does all the calculations immediately, it looks like I do this very quickly. That's what parlour tricks are for, right?

As it has been requested a few times now, here it is. I wonder what others would add to the stats?

#! /usr/bin/perl use strict; use warnings; use LWP::Simple qw(); use HTML::Parser; use Date::Parse; use Data::Dumper; use Term::ANSIColor qw(:constants); use DBI; use FindBin; my $user = shift or die "Need to pass in user name!"; my @convert = ( [ 1, '%02d', 'sec' ], [ 60, '%02d:', 'min' ], [ 60, '%2d:', 'hr' ], [ 24, '%d ', 'd' ], ); sub convert_seconds { my $sec = shift; my @c = @convert; my @vals = ($sec); my $output = ' %s'; while (my $c = shift @c) { if ($vals[0] > $c->[0]) { $output = $c->[1] . $output; unshift @vals, int($vals[0] / $c->[0]); $vals[1] %= $c->[0]; $vals[-1] = $c->[2]; } else { last; } } sprintf $output, @vals; } my $html = LWP::Simple::get('http://www.perlmonks.org/index.pl?node=' +. $user); if ($html) { my %data = (done => 1); my $p = HTML::Parser->new(api_version => 3); $p->report_tags(qw(tr td)); $p->handler(start => sub { return if $data{done}; my ($tagname, $attr) = @_; if ($tagname eq 'tr') { delete $data{key}; delete $data{td}; } return unless $tagname eq 'td'; #return if keys %$attr; $data{start} = $tagname; }, 'tagname, attr'); $p->handler(end => sub { return if $data{done}; my ($tagname) = @_; return unless $tagname eq 'td'; if (exists $data{key}) { $data{$data{key}} = $data{td}; delete $data{key}; delete $data{td}; } elsif (exists $data{td}) { $data{key} = $data{td}; delete $data{td}; } delete $data{start}; if ($tagname =~ /Scratchpad:/) { $data{done}++; } }, 'tagname'); $p->handler(text => sub { return if $data{done}; my $text = shift; $text =~ s/^\s+//; $text =~ s/[:\s]+$//; $data{td} .= $text; #delete $data{start}; }, 'text'); $p->handler(comment => sub { my ($tagname) = @_; if ($tagname =~ /contained/) { $data{done} = $tagname =~ m./contained.; } }, 'tagname' ); $p->parse($html); $p->eof(); my $table_file = File::Spec->catfile($FindBin::Bin,'stats.' . $use +r); my $eol = -e $table_file ? "\n" : ', '; my $since = $data{'User since'}; $since =~ s/\s\S*$//; $since =~ s/at //; my $tbegin = str2time($since, 'GMT'); my $tdiff = time - $tbegin; my $duration = $tdiff / (60 * 60 * 24); if ($eol =~ /^\s*$/) { print $user,$/; print '-' x (length $user), $/; } else { print "[$user] stats: "; } printf "Member for: %.3f days%s", $duration, $eol; println('Experience: ', $data{Experience}, $duration); print $eol; println('Writeups: ', $data{Writeups}, $duration); print $eol; printf("Which makes it %s%.3f%s XP per writeup!\n", BOLD.RED, ($data{Experience} / $data{Writeups}, RESET)); #/)); if (-e $table_file) { my $dbh = DBI->connect('dbi:CSV:f_dir=' . $FindBin::Bin . ";cs +v_eol=\n") or warn "Can't connect to DBI"; $dbh->{csv_tables}->{stats} = { file => $table_file, }; my $total = $dbh->selectall_arrayref('select sum(xp) from stat +s')->[0][0]; if ($total != $data{Experience}) { require Time::localtime; my $lt = Time::localtime::localtime(time() + (2 * 60 * 60) +); my $date = sprintf("%04d-%02d-%02d", $lt->year + 1900, $lt +->mon + 1, $lt->mday); #print "Today is $date\n"; my $count = $dbh->selectall_arrayref('select count(*) from + stats where date = ?', {}, $date)->[0][0]; my $cur = $dbh->selectall_arrayref('select xp from stats w +here date = ?', {}, $date); $cur = $cur->[0] while $cur and ref $cur; my $gained = $data{Experience} - $total; printf "%s %s%d%s XP!\n", $gained > 0 ? "Gained" : "Lost", + RED.BOLD, abs($gained), RESET; if ($count) { $cur += $gained; print "Updating today ($date) to be XP = $cur\n"; $dbh->do('update stats set xp = ? where date = ?', und +ef, $cur, $date); } else { $cur = $gained; print "Inserting into today to be XP = $cur\n"; $dbh->do('insert into stats (date,xp) values(?,?)', {} +, $date,$cur); } } } } else { print "Can't get node for $user\n"; } sub println { my ($type, $data, $duration) = @_; my $rate = $data / $duration; my $per = 24 * 60 * 60 / $rate; printf("%s %d (%s%.3f%s per day, or 1 per %s%s%s)", $type, $data, BLUE.BOLD, $rate, RESET, BOLD.BLUE, convert_s +econds($per), RESET); }
And then there is a tool I use to read my own stats. To get this working, you need to create the csv file as "stats.<username>" before running the above script. This allows you to track multiple users if you so wish.
#! /usr/bin/perl5.8 use warnings; use strict; use IO::File; use FindBin; use File::Spec; use DBI; my $user = shift; my $dbh = DBI->connect('dbi:CSV:f_dir=' . $FindBin::Bin . ";csv_eol=\n +") or warn "Can't connect to DBI"; my $table_file = File::Spec->catfile($dbh->{f_dir},'stats'); $table_file .= '.'.$user if -e "$table_file.$user"; $dbh->{csv_tables}->{stats} = { file => $table_file, # col_names => [qw(DATE XP)], }; my @markers_old = ( [ Initiate => 0 ], [ Novice => 20 ], [ Acolyte => 50 ], [ Scribe => 100 ], [ Monk => 200 ], [ Friar => 500 ], [ Abbot => 1000 ], [ Bishop => 1600 ], [ Pontiff => 2300 ], [ Saint => 3000 ], ); my @markers = ( [ Initiate => 0 ], [ Novice => 20 ], [ Acolyte => 50 ], [ Sexton => 90 ], [ Beadle => 150 ], [ Scribe => 250 ], [ Monk => 400 ], [ Pilgrim => 600 ], [ Friar => 900 ], [ Hermit => 1300 ], [ Chaplain => 1800 ], [ Deacon => 2400 ], [ Curate => 3000 ], [ Priest => 4000 ], [ Vicar => 5400 ], [ Parson => 7000 ], [ Prior => 9000 ], [ Monsignor => 12000 ], [ Abbot => 16000 ], [ Canon => 22000 ], [ Chancellor => 30000 ], [ Bishop => 40000 ], [ Archbishop => 50000 ], [ Cardinal => 60000 ], [ Sage => 70000 ], [ Saint => 80000 ], [ Apostle => 90000 ], [ Pope => 100000 ], ); my $total; my %best = ( XP => 0 ); #my $sth = $dbh->prepare('select * from stats order by date'); #$sth->execute(); #while (my $line = $sth->fetchrow_hashref()) my $query = $dbh->selectall_arrayref('select * from stats', {Slice=>{}}); my @lens; my @data; foreach my $line (@$query) { next unless length $line->{XP}; $total += $line->{XP}; my @d = ( $line->{DATE}, $total ); if ($line->{XP}) { push @d, sprintf "%s%d", $line->{XP} > 0 ? '+' : '', $line->{ +XP}; } else { push @d, '0'; } my @made = ''; unless ($best{XP} >= $line->{XP}) { %best = %$line; push @made, 'New daily record!'; } unless (@markers) { if (int($total / 1000) > int(($total - $line->{XP})/1000)) { push @made, sprintf "(Reached %d000 XP!)", int($total/1000 +); } } while (@markers and $total >= $markers[0][1]) { push @made, sprintf "(Made %s!)", $markers[0][0]; shift @markers; } push @d, join ' ', @made; push @data, \@d; } use Text::Table; my $sep = '|'; my $tb = Text::Table->new('Date',\$sep, 'Total',\$sep, "Gain\n&right", +\$sep, 'Notes'); $tb->load(@data); my @col_range = $tb->colrange(-1); foreach (@data) { my $notes = $_->[-1]; $_->[-1] = '*' x ($_->[2] * $col_range[1] / $best{XP}) if $_->[2] +> 0; substr($_->[-1], 0, length($notes)) = $notes; } $tb->clear()->load(@data); print $tb; #$sth->finish(); if ($total) { printf( "Only %d more XP to becoming %s!\n", ($markers[0][1] - $tot +al), $markers[0][0] ) if @markers; printf("Best day: %s at %dXP!\n", @best{qw(DATE XP)}); }

Note how both the old levels and the new levels are there. This means I know when I became a Pilgrim, for example (Jan 25, 2005). Or Friar (Jan 31, 2005). Or Deacon (Mar 10, 2005). Or Prior (Sep 29, 2005). All dates prior to actually doing the changeover. ;-)

Of course, if you haven't kept track of your daily XP to this point, this won't help with the historical data. But can still be entertaining of itself.

The stats shown are quite simple: how long the user has been a monk, total XP (and XP per day, and average time between XP gains), writeups (and writeups per day, and average time between writeups), and XP per writeup. If you are running this on a user whose stats you're monitoring (likely just yourself), you get output that's relatively easy to read. For others, you get output that's relatively easy to paste in to the CB to entertain others. Of course, that's still pretty trivial to change.

Yesterday, chargrill was asking "me next!" after I had posted someone else's stats. He was a might bit disappointed with what the stats showed him. Since then, I see he has nearly doubled his XP and his writeups. I imagine he is suddenly a larger participant because of this game. And that's what XP is about, right? Encouraging positive participation? :-) (I'll leave chargrill's exact stats to anyone who wants to run this...)

Replies are listed 'Best First'.
Re: Personal stats
by demerphq (Chancellor) on Jan 14, 2006 at 23:08 UTC

    I haven't looked at the code closely, but i have a feeling that you might find The XP xml ticker and 'node_id=USERID;displaytype=xml' useful to avoid the HTML parsing.

    See also What XML generators are currently available on PerlMonks?

    Don't take this note in a negative way, I liked your little info message in the CB the other day, its just that if you use the XML your code will most likely never stop working because of site modifications wheras scraping the HTML means that your client could break if we ever change the layout of the user page.

    ---
    $world=~s/war/peace/g

      You're right - had I known within the first 2 weeks of joining PM, I probably would have done it with XML rather than HTML - the HTML parsing is kinda ugly. ;-) That said, it works at the moment, and I'm not exactly one to change things that are working. If it stops working, I'll take a look at which is easier - ripping out the HTML::Parser and replacing it with XML::Twig (my favourite XML handler), or just tweaking it. :-)

      As for the XML xml ticker - given how frequently that changes, I think I'm doing both of us a favour by not using it. As in, I try not to hit the monastary for anything I don't need ;-)

      ... ok, I tried the conversion quickly. Of course, XML::Twig overwhelms the whole process to take longer ...

      I'm sure there's a faster way ... but whatever, it's just a cheap parlour trick anyway :-)

      Updated: one line in the code still had the old HTML field of "User since" rather than the xml field name of "created". Fixed. Output looks better, too.

Re: Personal stats
by Anonamous Monk (Novice) on Jan 14, 2006 at 18:44 UTC
    I understand that XP isn't everything. It's not even a good indicator of anything past some vague idea of participation in PerlMonks.

    In my opinion, XP is a measure only of the popularity of a post, not of its value, correctness, relevance, or anything else. I have often seen intelligent, pertinent comments downvoted because they displease people - an example might be a post that discusses shortcomings of Perl. Similarly, many enthusiastic but essentially content-free comments are upvoted despite having little to say besides, "Perl Rocks!" (which it does - but that's beside the point).

    Ideally, of course, we'd all vote objectively on the content of the comments, judging only on the accuracy and usefulness of the posts. And there'd be an end to world hunger, war, and sickness, too. Unfortunately, we're moved by less noble motives and we often yield to the temptation to downvote unpleasant facts...

    XP is still the best system I have seen for encouraging participation, checking facts, and interacting in a friendly, cooperative way with each other. But it's not really a good measure of anything other than popularity.

      XP is a measure only of the popularity of a post, not of its value, correctness, relevance, or anything else.

      You are confusing XP and node reputation. XP is a property of a user; node reputation is a property of a post. The former follows from the latter (though not only).

      Makeshifts last the longest.

      A reply falls below the community's threshold of quality. You may see it by logging in.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlmeditation [id://523196]
Approved by xdg
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (5)
As of 2021-06-13 14:42 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    What does the "s" stand for in "perls"? (Whence perls)












    Results (56 votes). Check out past polls.

    Notices?