Showing posts with label code. Show all posts
Showing posts with label code. Show all posts

Monday, December 21, 2009

Dice Roller Deconstructed

As promised, here are the elements of last week's dice rolling code:

use v6;
This is a nice way to say that we are in Perl 6 land.

subset D10 of Int where 1..10;
A "D10" is a 10-sided die, and it can only have integer values in the range 1..10. Subtyping Int is an acceptable way of taking care of that.

sub is_success (D10 $roll, D10 $target) {
Here, I am already using the subtype D10 of Int. This subroutine compares the rolled die $roll with the target number $target, and is called from the subroutine roll() for each die in the dice pool. I chose to create an explicit subroutine because it seems a bit clearer what happens in the special case of a rolled 10, which means that you get to re-roll that die for a potential new success.

    my $n = 0;
if ($roll == 10) {
say "10 again";
$n += roll 1,$target;
}
If we roll a 10, then the roll() subroutine is called with a dice pool of 1 and the same target number as we got originally for determining success.

    $roll >= $target ?? $n + 1 !! $n;
}
We always return the number of successes from the roll for the "10 again" rule (if it happened), and in case this roll was a success, we return an additional success.

sub roll (Int $poolsize where { $_ > 0 }, D10 $target? = 8) {
The dice pool size can of course not be negative, but it also cannot be zero; you always get to roll a die, so I have added a type constraint for that. The target number is optional, defaults to 8, and has to be possible with a D10.

    my D10 @rolls = (1..10).pick($poolsize, :replace);
From left to right:
  • @rolls is an array that will contain the results of the normal die rolls
  • (1..10).pick($poolsize is a way of picking $poolsize dice having possible values in the range 1..10 and "rolling" (randomizing) each of them.
  • pick($poolsize, :replace) means that we not only pick a result, but we also make it possible to achieve the same result again. Specifically, it is important for us that each die can have ANY value, not just values that have not been picked before. The semantics of pick() are explained in .pick your game (the 15th gift in the Perl 6 Advent Calendar).


    say "Roll: " ~ @rolls.sort.join(",");
@rolls.sort.join(",") sorts the elements of the @rolls array and stringifies them joined with a comma, e.g. "1,2,3,3,4" for @rolls = 4,1,3,2,3

    [+] @rolls.map: { is_success $_,$target };
}
This piece of code maps is_success $_,$target on every value in the @rolls array and creates a sum of those results. In other words, it sums up the number of successfull die rolls.

given @*ARGS.elems {
The @*ARGS array contains the command line arguments to the program, and .elems therefore is the number of arguments used.
    when 2   {
say "Target number: " ~ @*ARGS[1];
continue;
}
This block only runs in case we have two arguments, but it explicitly says that we may not be done yet: the continue statement counters the default implisit break to ensure that we can match the input value against other tests.
    when 1|2 {
my $n = roll |@*ARGS>>.Int;
say "Successes rolled: " ~ $n;
$n >= 5 and say "Exceptional success!";
}
We start off with a junction to say that either 1 or 2 is fine by us, we want both to match. Then we call roll() with the same arguments we got in, but each converted to Int. White magic. We store the value, and exclaim that the result is an exceptional success if it is.
    when *   {
$*ERR.say("roll.p6 poolsize [target]");
exit(64);
}
}
This is the equivalent of C's default, the catch-all that handles remaining uncaught cases. We print a helpful usage string to STDERR ($*ERR in Perl 6) and exit with the correct Unix exit code, praying that nobody uses a different kind of system.

Wednesday, December 16, 2009

Dice Rolls for Role-Players

I realize that the title of this post is a bit of an oxymoron, because a Real Role-Player of course doesn't roll dice often. ;)

But in the cases where the Real Role-Player does roll dice, wouldn't it be nice to have a computer program to forget at home rather than some even more easily mislaid dice?

The Perl 6 Advent Calendar provided some inspiration for this post.

A problem with many minor programming examples you see on the net, is that they do not take into account the needs of a role-player. Role-players play many different systems, with different criteria for success in dice rolls. D6 (the regular six-sided cubic dice used for playing Monopoly, Yahtzee, etc.) are not used much in the majority of systems.

Therefore, I'll look at the Storyteller System, which is used in the World of Darkness series of games.

The general principle is that you have a pool of dice to roll, and you count your successes, which in this system is the number of dice that have a value greater than or equal to a given target number for the roll. The standard target number is 8 in most implementations. Five successes in the same roll is an exceptional success. Obviously, it's nice to have many dice to roll!

Here's a real Perl 6 program that works with Rakudo today: it accepts two command line parameters, the first being the size of the dice pool, the optional second parameter defines the target number for success:
use v6;

subset D10 of Int where 1..10;

sub is_success (D10 $roll, D10 $target) {
my $n = 0;
if ($roll == 10) {
say "10 again";
$n += roll 1,$target;
}
$roll >= $target ?? $n + 1 !! $n;
}

sub roll (Int $poolsize where { $_ > 0 }, D10 $target? = 8) {
my D10 @rolls = (1..10).pick($poolsize, :replace);
say "Roll: " ~ @rolls.sort.join(",");
[+] @rolls.map: { is_success $_,$target };
}

given @*ARGS.elems {
when 2 {
say "Target number: " ~ @*ARGS[1];
continue;
}
when 1|2 {
my $n = roll |@*ARGS>>.Int;
say "Successes rolled: " ~ $n;
$n >= 5 and say "Exceptional success!";
}
when * {
$*ERR.say("roll.p6 poolsize [target]");
exit(64);
}
}

Thanks to moritz++ for ironing out two annoying mistakes!

Here are a few usage examples:
$ perl6 roll.p6
roll.pl poolsize [target]

$ perl6 roll.p6 5
Roll: 1,2,7,8,9
Successes rolled: 2

$ perl6 roll.p6 5 2
Target number: 2
Roll: 1,2,2,4,9
Successes rolled: 4

$ perl6 roll.p6 5 4
Target number: 4
Roll: 6,8,9,10,10
10 again
Roll: 8
10 again
Roll: 2
Successes rolled: 6 - Exceptional success!

There are no comments in this piece of code, I want people to try to understand it as-is, based on the Perl 6 Advent Calendar. If you have any questions, comments, corrections, etc., don't hesitate, just write!

In my next blog entry, I'll pick the program apart and comment on what I've done and why, and who knows, maybe someone has come up with an elegant solution to the same problem.

Wednesday, July 8, 2009

Coding styles that make me twitch, part 3

Today's twitchiness is sponsored by ... no, wait, I don't have sponsors. Ah, well.

I have an issue with people who insist on using <"> as a string delimiter when the (static) string itself contains that very character. It gets fugly all too soon:

my $html_output = "<a href=\"http://www.example.com/foobar/$pagename.html\" title=\"Oh, a link to $pagename\"> ...\n";

It's so easy to avoid having to quote the <"> while still allowing variable interpolation:

my $html_output = qq(<a href="http://www.example.com/foobar/$pagename.html" title="Oh, a link to $pagename"> ...\n);

Since the example is HTML (and could be e.g. SQL), and it might be multi-line, why not ...
my $html_output = <<EOL;
<a href="http://www.example.com/foobar/$pagename.html"
title="Oh, a link to $pagename>
EOL

That wasn't so hard? Or fugly?

Monday, June 15, 2009

Frequently freaky freakin' one-liners

So, hey, I'm sitting here without anything good to blog about, probably like most people on the net.

I'm wondering what daily Perl usage that's even vaguely useful that I do, which could be improved upon.

Ah, of course, triple-f one-liners!

As a tool, the perl command often seems to replace a jungle of echo + egrep + cut + tr + sed + awk and whatnot. perl -nawe and ctrl+r (reverse i-search) in bash are good friends of mine, but after using the same one-liners a few times in a row, I usually end up converting them to tidy files with Getopt::Long, comments and other insanities.

And at some stage later, I say to myself: damnit, I should've coded this more generally, I start a recode, get distracted, solve a new problem with one-liners, and the circle of life goes on.

Do I need professional help?

Friday, May 22, 2009

Querying quotas with Quota.pm

I never claimed that this blog would be an exercise in expertise. ;)

Prerequisites: Unixy OS with quotas enabled, Perl 5.8.8, Quota.pm 1.6.3.

I always like to provide some sort of progress display for my programs. As a sysadmin, there are times when it might be prudent to check users' files without inspecting them by hand, e.g. when checking for parasitical exploits in websites. The number of files and/or amount of disk space used seem like reasonable measurements for keeping track of that progress.

So you use Quota; and get coding, right?

Except that you may not know beforehand whether you're scanning a local file system, or a remote file system, and Quota.pm requires that you have a magical device identifier before asking what the quota is.

The manual says that you should do something like this:

my $r_uid; # User's real UID
my $dev = Quota::getqcarg($directory);

my @quotadata = Quota::query($dev, $r_uid);

Now we've got some nice quota data, in the following order:

Current blocks used, block soft limit, block hard limit, soft block time limit, current inodes used, inode soft limit, inode hard limit, soft inode time limit.

But no, there's a catch! If you run this on the local file server, rather than via NFS/RPC, then Quota::query() will barf, because $dev is erroneous. How did that happen?

Well, Quota::query() doesn't work if the device is local!

So we have to do this after calling Quota::getqcarg():

if ($dev =~ m{^/dev/}) {
$dev = "127.0.0.1:$directory";
}

The irony is then that there appears to be a need for an RPC listener on the loopback device, at least.

Anyway, I hope this is useful; it helped me to make tings Just Work.

Thursday, May 7, 2009

Simple print-and-log subroutine

I find that I have a use for this almost all the time. It's a silly little set of subs, but in my role as sysadm, I often need to go back and see what all those printed messages were.

So here is my not-so-elegant workhorse for when I need to stuff things into logs, and shuffling modules isn't an option. I hope it's useful for someone else, too.

Dependencies, assumptions and prerequisites:

  • Perl 5-ish
  • Pre-defined global variables:
    • $level - log level (undef = normal, 1 = warn, 2 = die)
    • $logfile - a logfile that we can append to
    • $msgprefix - a program or subroutine specific prefix
    • $verbose - whether to print to STDOUT
  • Preferably disabled output buffering

Usage:

&plog("Log this");
&plogwarn("Warn about and log this");
&plogdie("Log this and die");

The code:

sub plogwarn
{
my $msg = shift;
&plog ($msg,1);
}

sub plogdie
{
my $msg = shift;
&plog ($msg,2);
exit 1;
}

sub plog
{
my $msg = shift;
my $level = shift;
my @lt = localtime;
# Format current datetime sensibly:
my $dt = sprintf("%d-%02d-%02d %02d:%02d:%02d",
$lt[5]+1900,$lt[4]+1,
$lt[3],$lt[2],$lt[1],$lt[0]);
warn "$dt $0: sub plog: No message!\n" unless defined $msg;
unless (open(F,">>$logfile")) {
warn "$dt $0: sub plog: Failed to open logfile ($logfile) for write.\n";
} else {
print F "$dt $msgprefix$msg\n";
close F;
}
if ($verbose) {
unless (defined($level)) {
print "$dt $msgprefix$msg\n";
} elsif ($level == 1) {
warn "$dt $msgprefix$msg\n";
} elsif ($level == 2) {
die "$dt $msgprefix$msg\n";
}
}
}

Thursday, April 30, 2009

Schwartzian Transform - Perl 5 vs. Perl 6

This isn't quite news, but it's a cool little bit of code anyway.

Perl 5:


@sorted = map { $_->[0] }
sort { $a->[1] cmp $b->[1] }
map { [$_, foo($_)] }
@unsorted;


Perl 6:


@sorted = @unsorted.sort: { .uc };


I'm willing to claim that Perl 6 makes this a bit more readable, in spite of the smoke, mirrors and curtains.

Read more about the Schwartzian Transform in Wikipedia.