colomon's Journal http://use.perl.org/~colomon/journal/ colomon's use Perl Journal en-us use Perl; is Copyright 1998-2006, Chris Nandor. Stories, comments, journals, and other submissions posted on use Perl; are Copyright their respective owners. 2012-01-25T02:42:15+00:00 pudge pudge@perl.org Technology hourly 1 1970-01-01T00:00+00:00 colomon's Journal http://use.perl.org/images/topics/useperl.gif http://use.perl.org/~colomon/journal/ Struggles with Trig http://use.perl.org/~colomon/journal/39590?from=rss I'm checking in what I've got of my trig tests / code update, which so far only tackles sin and cos. I thought it would be a good idea to get other people's eyes on it now, before I replicated the changes for all of the other trig functions. I'm up at my in-laws' cabin, had to drive into town to reach the Internet, so this seemed like the best way to pose my questions to the Perl 6 world. <p> 1) Passing non-default $base value does not work for Num.sin / Num.cos or Complex.sin / Complex.cos. As far as I can tell the code is fine, and Num.sin("degrees") seems to work fine using p6eval, but the tests fail for me in trig.t. I thought it was some weird interaction with the fact sin is declared as an operator, but Rat.sin("degrees") works just fine in the tests. I'm stumped on this, if anyone else can offer some insight I'm all ears. </p><p> 2) Equally weirdly, I've got working implementations of sin(Complex) and sin(Complex, $base). But they only work if defined trig.t, moving them to Complex.pm made those tests fail. Do they need "is export" added or something like that? What is "is export" for, anyway? </p><p> 3) In general, I'd love it if a few people could look over the new tests for sine (cosine duplicates them). I'm not 100% comfortable with how repetitive they are. You could obviously change my little AngleAndResult to have a method which allows you to select the base and the numeric type to return, but I don't know how to make that cleanly work with the very much needed SKIP directives. (BTW, these changes I've made add over 1000 tests in trig.t, and they are only the tip of the iceberg.) </p><p> If you could e-mail comments to my user name here at gmail.com, that's probably the best way to reliably get my attention while I am away from the Internet this weekend. Any comments / suggestions would be deeply appreciated. In the meantime I'll play around with replacing "degrees", etc with a proper enum, as per the spec.</p> colomon 2009-09-06T15:17:16+00:00 perl6 My take on Euler #52 in Perl 6 http://use.perl.org/~colomon/journal/39371?from=rss Loved PerlJam's <a href="http://perlpilot.blogspot.com/2009/07/euler-52.html?showComment=1248876821271#c5378786790810306227">Euler #52 post</a>, but instantly wanted to try to optimize it. I think this version is about five times faster than his (not sure because I'm too lazy to run his full program on my system) while being more careful about what it checks.<blockquote><div><p> <tt>use v6;<br> <br>my $pass_start = 5;&nbsp; &nbsp; &nbsp;# start at the first number divisible by three after this one<br>my $pass_end = 17;&nbsp; &nbsp; &nbsp; # skip ahead when we get here<br>my $n;<br>loop ($n = 6; ; $n += 3)<br>{<br>&nbsp; &nbsp; if $n &gt; $pass_end<br>&nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; $pass_start *= 10;<br>&nbsp; &nbsp; &nbsp; &nbsp; $pass_end *= 10;<br>&nbsp; &nbsp; &nbsp; &nbsp; $n = $pass_start;<br>&nbsp; &nbsp; &nbsp; &nbsp; $n -= $n % 3;<br>&nbsp; &nbsp; &nbsp; &nbsp; next;<br>&nbsp; &nbsp; }<br> <br>&nbsp; &nbsp; my $digits = (2*$n).comb.sort;<br>&nbsp; &nbsp; next unless ($digits ~~<nobr> <wbr></nobr>/0|5/);<br>&nbsp; &nbsp; # say "$n ==&gt; $digits";<br> <br>&nbsp; &nbsp; last if<br>&nbsp; &nbsp; &nbsp; &nbsp; $digits eq (3*$n).comb.sort &amp;&amp;<br>&nbsp; &nbsp; &nbsp; &nbsp; $digits eq (4*$n).comb.sort &amp;&amp;<br>&nbsp; &nbsp; &nbsp; &nbsp; $digits eq (5*$n).comb.sort &amp;&amp;<br>&nbsp; &nbsp; &nbsp; &nbsp; $digits eq (6*$n).comb.sort;<br>}<br>say $n;</tt></p></div> </blockquote> colomon 2009-07-29T17:26:24+00:00 perl6 Improved Version of Last Script http://use.perl.org/~colomon/journal/38579?from=rss New version handles my standard "trimmed_surface" becomes "TrimmedSurface" convention, and has a rather more elegant main loop.<blockquote><div><p> <tt>#!/Users/colomon/tools/rakudo/perl6<br>my $search_word = @*ARGS.shift;<br>my $replacement = @*ARGS.shift;<br> <br>sub UpperCaseEachWord($word)<br>{<br>&nbsp; &nbsp; my @words = $word.split('_');<br>&nbsp; &nbsp; my @uppered = map {$_.lc.ucfirst}, @words;<br>&nbsp; &nbsp; return @uppered.join('');<br>}<br> <br>my %substitutions;<br>%substitutions{$search_word.lc} = $replacement.lc;<br>%substitutions{$search_word.uc} = $replacement.uc;<br>%substitutions{UpperCaseEachWord($search_word)} = UpperCaseEachWord($replacement);<br> <br># for %substitutions.pairs -&gt; $x<br># {<br>#&nbsp; &nbsp; &nbsp;say "{$x.key}, {$x.value}";<br># }<br> <br>for =$*IN -&gt; $text is rw<br>{<br>&nbsp; &nbsp; for %substitutions.pairs -&gt; $sub<br>&nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; $text<nobr> <wbr></nobr>.= subst($sub.key, $sub.value,<nobr> <wbr></nobr>:g);<br>&nbsp; &nbsp; }<br>&nbsp; &nbsp; say $text;<br>}</tt></p></div> </blockquote> colomon 2009-03-02T19:04:14+00:00 perl6 My First Useful Perl 6 Script! http://use.perl.org/~colomon/journal/38528?from=rss I wanted to extend TextMate to do a case-aware search-and-replace. I decided to try it in Perl 6 because I wanted to use the<nobr> <wbr></nobr>:samecase modifier. Unfortunately, I was not able to get<nobr> <wbr></nobr>:samecase to work, but a simple modification made the script equally useful for me. I know this is mind-bogglingly simple, but it's now a practical part of my development environment for work.<blockquote><div><p> <tt>#!/Users/colomon/tools/parrot-latest/languages/rakudo/perl6<br>my $search_word = @*ARGS.shift;<br>my $replacement = @*ARGS.shift;<br> <br>for =$*IN -&gt; $x<br>{<br>&nbsp; &nbsp; my $y = $x.subst($search_word.lc, $replacement.lc,<nobr> <wbr></nobr>:g);<br>&nbsp; &nbsp; my $z = $y.subst($search_word.uc, $replacement.uc,<nobr> <wbr></nobr>:g);<br>&nbsp; &nbsp; say $z.subst($search_word.lc.ucfirst, $replacement.lc.ucfirst,<nobr> <wbr></nobr>:g);<br>}</tt></p></div> </blockquote><p>I'll probably tweak this with some further improvements, including one that<nobr> <wbr></nobr>:samecase couldn't have handled anyway. But I just wanted to celebrate my first practical Perl 6 script!</p> colomon 2009-02-22T11:26:52+00:00 perl6 Project Euler Problem #8 Script http://use.perl.org/~colomon/journal/38449?from=rss The goal is to find the highest product of five consecutive digits in the huge "number". (Obviously made more sense to treat it as a string.) Besides forgetting that string concatenation is now <code>~</code> instead of<nobr> <wbr></nobr><code>.</code>, there were only minor issues trying to find a version of the loop's body that worked in the compiler. <code>[*] $num.substr($i,5).split('')</code> didn't work, for instance. Probably the code is clearer as it is anyway.<blockquote><div><p> <tt>my $num = "73167176531330624919225119674426574742355349194934"<br>&nbsp; &nbsp; &nbsp; &nbsp; ~ "96983520312774506326239578318016984801869478851843"<br>&nbsp; &nbsp; &nbsp; &nbsp; ~ "85861560789112949495459501737958331952853208805511"<br>&nbsp; &nbsp; &nbsp; &nbsp; ~ "12540698747158523863050715693290963295227443043557"<br>&nbsp; &nbsp; &nbsp; &nbsp; ~ "66896648950445244523161731856403098711121722383113"<br>&nbsp; &nbsp; &nbsp; &nbsp; ~ "62229893423380308135336276614282806444486645238749"<br>&nbsp; &nbsp; &nbsp; &nbsp; ~ "30358907296290491560440772390713810515859307960866"<br>&nbsp; &nbsp; &nbsp; &nbsp; ~ "70172427121883998797908792274921901699720888093776"<br>&nbsp; &nbsp; &nbsp; &nbsp; ~ "65727333001053367881220235421809751254540594752243"<br>&nbsp; &nbsp; &nbsp; &nbsp; ~ "52584907711670556013604839586446706324415722155397"<br>&nbsp; &nbsp; &nbsp; &nbsp; ~ "53697817977846174064955149290862569321978468622482"<br>&nbsp; &nbsp; &nbsp; &nbsp; ~ "83972241375657056057490261407972968652414535100474"<br>&nbsp; &nbsp; &nbsp; &nbsp; ~ "82166370484403199890008895243450658541227588666881"<br>&nbsp; &nbsp; &nbsp; &nbsp; ~ "16427171479924442928230863465674813919123162824586"<br>&nbsp; &nbsp; &nbsp; &nbsp; ~ "17866458359124566529476545682848912883142607690042"<br>&nbsp; &nbsp; &nbsp; &nbsp; ~ "24219022671055626321111109370544217506941658960408"<br>&nbsp; &nbsp; &nbsp; &nbsp; ~ "07198403850962455444362981230987879927244284909188"<br>&nbsp; &nbsp; &nbsp; &nbsp; ~ "84580156166097919133875499200524063689912560717606"<br>&nbsp; &nbsp; &nbsp; &nbsp; ~ "05886116467109405077541002256983155200055935729725"<br>&nbsp; &nbsp; &nbsp; &nbsp; ~ "71636269561882670428252483600823257530420752963450";<br> <br>my $max_value = 0;<br>my $i;<br>loop($i = 0; $i &lt; $num.chars(); $i++)<br>{<br>&nbsp; &nbsp; my @numbers = $num.substr($i,5).split('');<br>&nbsp; &nbsp; my $value = [*] @numbers;<br>&nbsp; &nbsp; $max_value = $value if ($value &gt; $max_value);<br>}<br>say "$max_value";</tt></p></div> </blockquote> colomon 2009-02-10T15:36:24+00:00 perl6 Sixth Script: First Working Version http://use.perl.org/~colomon/journal/38254?from=rss Find all the primes to 200. Straightforward sieve implementation. Lacking some elegance, but when I attempted to use<nobr> <wbr></nobr><code>:by(2)</code> it didn't work for me.<blockquote><div><p> <tt>my @nonprime;<br> <br>say 2;<br>for 3..200 -&gt; $x, $y<br>{<br>&nbsp; &nbsp; unless (@nonprime.exists($x))<br>&nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; say $x;<br>&nbsp; &nbsp; &nbsp; &nbsp; my $i;<br>&nbsp; &nbsp; &nbsp; &nbsp; loop ($i = $x; $i &lt; 200; $i += 2 * $x)<br>&nbsp; &nbsp; &nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; @nonprime[$i] = 1;<br>&nbsp; &nbsp; &nbsp; &nbsp; }<br>&nbsp; &nbsp; }<br>}</tt></p></div> </blockquote> colomon 2009-01-10T19:58:35+00:00 perl6 Fifth Script: First Working Version http://use.perl.org/~colomon/journal/38253?from=rss After a couple of weeks' layoff from this project, I got back to work at 4am last night. I never successfully interpolated a variable in a regex like originally wanted to. Luckily, I realized a simple string equality test was all that was needed. After that, everything went very quickly, the only complications being the modified pattern matching syntax. This code doesn't strike me as wildly Perl6ish, but I suspect this is how I might do day-to-day programming in Perl 6 -- sort of a sturdy traditional Perl 5 structure with little dabs of convenient new stuff. This may be the first time I've ever really used grep -- I was never fully comfortable with the Perl 5 syntax for it for some reason -- and it makes me happy. This code isn't brilliant, but I like it.<blockquote><div><p> <tt>my $wordfile = "wordlist.txt";<br> <br>my @words = do<br>{<br>&nbsp; &nbsp; my $words = open($wordfile)<nobr> <wbr></nobr>// die "Unable to open $wordfile: $!\n";<br>&nbsp; &nbsp; =$words;<br>};<br> <br>for (@*ARGS) -&gt; $password<br>{<br>&nbsp; &nbsp; say;<br>&nbsp; &nbsp; say $password;<br> <br>&nbsp; &nbsp; my $score = 13;<br> <br>&nbsp; &nbsp; my %dictionary_checks;<br>&nbsp; &nbsp; %dictionary_checks{$password.subst(/0/, "o").lc}<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; = "Password is word with ohs changed to zeroes.";<br>&nbsp; &nbsp; %dictionary_checks{$password.subst(/1/, "l").lc}<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; = "Password is word with ells changed to ones.";<br>&nbsp; &nbsp; %dictionary_checks{$password.lc}<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; = "Password is a word in the dictionary.";<br>&nbsp; &nbsp; %dictionary_checks{$password.chop.lc}<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; = "Password minus last character is a word in the dictionary.";<br>&nbsp; &nbsp; %dictionary_checks{$password.substr(1).lc}<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; = "Password minus first character is a word in the dictionary.";<br> <br>&nbsp; &nbsp; my @hits = grep { %dictionary_checks.exists($^a) }, @words;<br>&nbsp; &nbsp; for @hits -&gt; $trouble<br>&nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; $score--;<br>&nbsp; &nbsp; &nbsp; &nbsp; say "{%dictionary_checks{$trouble}}";<br>&nbsp; &nbsp; }<br> <br>&nbsp; &nbsp; if ($password.elems &lt; 10 || $password.elems &gt; 20)<br>&nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; $score--;<br>&nbsp; &nbsp; &nbsp; &nbsp; say "Password should be 10-20 characters.";<br>&nbsp; &nbsp; }<br> <br>&nbsp; &nbsp; unless ($password ~~<nobr> <wbr></nobr>/\d/)<br>&nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; $score--;<br>&nbsp; &nbsp; &nbsp; &nbsp; say "Password should have a digit in it.";<br>&nbsp; &nbsp; }<br> <br>&nbsp; &nbsp; unless ($password ~~<nobr> <wbr></nobr>/&lt;[A..Z]&gt;/)<br>&nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; $score--;<br>&nbsp; &nbsp; &nbsp; &nbsp; say "Password should have an uppercase letter in it.";<br>&nbsp; &nbsp; }<br> <br>&nbsp; &nbsp; unless ($password ~~<nobr> <wbr></nobr>/&lt;[a..z]&gt;/)<br>&nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; $score--;<br>&nbsp; &nbsp; &nbsp; &nbsp; say "Password should have a lowercase letter in it.";<br>&nbsp; &nbsp; }<br> <br>&nbsp; &nbsp; unless ($password ~~<nobr> <wbr></nobr>/\W/)<br>&nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; $score--;<br>&nbsp; &nbsp; &nbsp; &nbsp; say "Password should have a non-alphanumeric character in it.";<br>&nbsp; &nbsp; }<br> <br>&nbsp; &nbsp; if ($password ~~<nobr> <wbr></nobr>/&lt;[A..Z]&gt;**4/)<br>&nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; $score--;<br>&nbsp; &nbsp; &nbsp; &nbsp; say "Password has four uppercase letters in a row.";<br>&nbsp; &nbsp; }<br> <br>&nbsp; &nbsp; if ($password ~~<nobr> <wbr></nobr>/&lt;[a..z]&gt;**4/)<br>&nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; $score--;<br>&nbsp; &nbsp; &nbsp; &nbsp; say "Password has four lowercase letters in a row.";<br>&nbsp; &nbsp; }<br> <br>&nbsp; &nbsp; my %letter_freq;<br>&nbsp; &nbsp; for $password.split('') -&gt; $x<br>&nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; %letter_freq{$x}++;<br>&nbsp; &nbsp; }<br>&nbsp; &nbsp; if (%letter_freq.values.max &gt; 1)<br>&nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; $score--;<br>&nbsp; &nbsp; &nbsp; &nbsp; say "Password has duplicate characters.";<br>&nbsp; &nbsp; }<br> <br>&nbsp; &nbsp; say "Score: $score";<br>}</tt></p></div> </blockquote><p>That last test (the <code>%letter_freq</code> one) compiled and worked on the first try, probably my biggest "Perl 6 just works" moment so far. I'm a bit uncomfortable with all the repetition in there. I can imagine making the code more elegant by wrapping up the tests as closures and mapping them to the messages, but it seems like that would make it more obscure. Possibly a well-written function (macro of some sort?) to wrap the notion of test, failure message, and dock points?</p> colomon 2009-01-10T17:59:11+00:00 perl6 Fifth Script: Glitch http://use.perl.org/~colomon/journal/38173?from=rss Skipping the fourth script, since the proper Perl-y way to do it is just call "cal", and the longer way really wants some sort of CPAN module to do it properly. <p> With the fifth script, I may have hit a glitch, either in Raduko or in my understanding of Perl 6.</p><blockquote><div><p> <tt>my $wordfile = "wordlist.txt";<br> <br>my @words = do<br>{<br>&nbsp; &nbsp; my $words = open($wordfile)<nobr> <wbr></nobr>// die "Unable to open $wordfile: $!\n";<br>&nbsp; &nbsp; =$words;<br>}<br> <br>for (@*ARGS) -&gt; $password<br>{<br>&nbsp; &nbsp; say $password;<br>}</tt></p></div> </blockquote><p>fails with</p><blockquote><div><p> <tt>Statement not terminated properly at line 9, near "-&gt; $passwo"<br> <br>current instr.: 'parrot;PGE;Util;die' pc 129 (runtime/parrot/library/PGE/Util.pir:83)<br>called from Sub 'parrot;Perl6;Grammar;eat_terminator' pc 28665 (src/gen_grammar.pir:3378)<br>called from Sub 'parrot;Perl6;Grammar;statementlist' pc 27321 (src/gen_grammar.pir:2845)<br>called from Sub 'parrot;Perl6;Grammar;statement_block' pc 24757 (src/gen_grammar.pir:1838)<br>called from Sub 'parrot;Perl6;Grammar;TOP' pc 20647 (src/gen_grammar.pir:207)<br>called from Sub 'parrot;PCT;HLLCompiler;parse' pc 634 (src/PCT/HLLCompiler.pir:388)<br>called from Sub 'parrot;PCT;HLLCompiler;compile' pc 428 (src/PCT/HLLCompiler.pir:301)<br>called from Sub 'parrot;PCT;HLLCompiler;eval' pc 862 (src/PCT/HLLCompiler.pir:500)<br>called from Sub 'parrot;PCT;HLLCompiler;evalfiles' pc 1217 (src/PCT/HLLCompiler.pir:669)<br>called from Sub 'parrot;PCT;HLLCompiler;command_line' pc 1398 (src/PCT/HLLCompiler.pir:759)<br>called from Sub 'parrot;Perl6;Compiler;main' pc 18987 (perl6.pir:162)</tt></p></div> </blockquote><p> Switching it to</p><blockquote><div><p> <tt>my $wordfile = "wordlist.txt";<br> <br>my @words = do<br>{<br>&nbsp; &nbsp; my $words = open($wordfile)<nobr> <wbr></nobr>// die "Unable to open $wordfile: $!\n";<br>&nbsp; &nbsp; =$words;<br>};<br> <br>for (@*ARGS) -&gt; $password<br>{<br>&nbsp; &nbsp; say $password;<br>}</tt></p></div> </blockquote><p>makes it work perfectly. </p><p> Should the semicolon always be there after the do construct? If so, why does it work if you insert a "say;" before the for statement?</p> colomon 2008-12-29T03:53:58+00:00 perl6 Third Script: Second Draft http://use.perl.org/~colomon/journal/38169?from=rss After a lot of really helpful suggestions from Aristotle, here is my second version of the third script. This version feels much more satisfyingly Perl6ish to me.<blockquote><div><p> <tt>my $votes_file = "votes.txt";<br> <br>sub EffectiveVote ( Str $vote, Hash %skip ) {<br>&nbsp; &nbsp; return $vote.split( ',' ).first( { ! %skip{$_}.defined } )<br>&nbsp; &nbsp; &nbsp; &nbsp;<nobr> <wbr></nobr>// die "No valid vote?!";<br>}<br> <br>sub CountRound (Array @votes, Hash %skip)<br>{<br>&nbsp; &nbsp; my %count;<br>&nbsp; &nbsp; for @votes -&gt; $vote<br>&nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; %count{EffectiveVote($vote, %skip)}++;<br>&nbsp; &nbsp; }<br>&nbsp; &nbsp; return %count;<br>}<br> <br>my @votes = do<br>{<br>&nbsp; &nbsp; my $votes = open($votes_file);<br>&nbsp; &nbsp; =$votes;<br>}<br> <br>my $count = 0;<br>my %skip;<br> <br>loop<br>{<br>&nbsp; &nbsp; say "\nRound {++$count}";<br>&nbsp; &nbsp; my @ranking = CountRound(@votes, %skip).pairs.sort({.value}).reverse;<br> <br>&nbsp; &nbsp; say sprintf("%s: %s",<nobr> <wbr></nobr>.key,<nobr> <wbr></nobr>.value / @votes.elems)<br>&nbsp; &nbsp; &nbsp; &nbsp; for @ranking;<br> <br>&nbsp; &nbsp; my $top_rank = @ranking[0];<br>&nbsp; &nbsp; if ($top_rank.value &gt; @votes.elems / 2)<br>&nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; say "\nThe winner is {$top_rank.key} with {$top_rank.value / @votes.elems * 100.0}% of the vote.";<br>&nbsp; &nbsp; &nbsp; &nbsp; exit;<br>&nbsp; &nbsp; }<br> <br>&nbsp; &nbsp; my $skip = @ranking.pop.key;<br>&nbsp; &nbsp; %skip{$skip} = 1;<br>&nbsp; &nbsp; say "Dropping $skip";<br>}</tt></p></div> </blockquote> colomon 2008-12-27T14:03:16+00:00 perl6 Third Script: Finished Version http://use.perl.org/~colomon/journal/38167?from=rss This is the instant runoff election task. I don't feel like I had terrible problems writing it, but I feel like it's a very satisfying piece of code, either.<blockquote><div><p> <tt>my $votes_file = "votes.txt";<br> <br>sub EffectiveVote (Str $vote, Hash %skip)<br>{<br>&nbsp; &nbsp; my @vote = split ',', $vote;<br>&nbsp; &nbsp; for @vote -&gt; $choice<br>&nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; if (! %skip{$choice}.defined)<br>&nbsp; &nbsp; &nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; return $choice;<br>&nbsp; &nbsp; &nbsp; &nbsp; }<br>&nbsp; &nbsp; }<br>&nbsp; &nbsp; die "No valid vote?!";<br>}<br> <br>sub CountRound (Array @votes, Hash %skip)<br>{<br>&nbsp; &nbsp; say "{@votes.elems} votes";<br> <br>&nbsp; &nbsp; my %count;<br>&nbsp; &nbsp; my $total = 0;<br>&nbsp; &nbsp; for @votes -&gt; $vote<br>&nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; my $choice = EffectiveVote($vote, %skip);<br>&nbsp; &nbsp; &nbsp; &nbsp; %count{$choice}++;<br>&nbsp; &nbsp; &nbsp; &nbsp; $total++;<br>&nbsp; &nbsp; }<br> <br>&nbsp; &nbsp; my %percentages;<br>&nbsp; &nbsp; for %count.keys -&gt; $choice<br>&nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; %percentages{$choice} = %count{$choice} / $total;<br>&nbsp; &nbsp; }<br>&nbsp; &nbsp; return %percentages;<br>}<br> <br>my @votes;<br> <br>my $votes = open($votes_file);<br>for (=$votes) -&gt; $vote<br>{<br>&nbsp; &nbsp; push @votes, $vote;<br>}<br> <br>my $count = 0;<br>my %skip;<br>while (1)<br>{<br>&nbsp; &nbsp; say;<br>&nbsp; &nbsp; say "Round {++$count}";<br>&nbsp; &nbsp; my %percentages = CountRound(@votes, %skip);<br>&nbsp; &nbsp; my @ordered = sort { %percentages{$^b} &lt;=&gt; %percentages{$^a} }, %percentages.keys;<br>&nbsp; &nbsp; for @ordered -&gt; $vote<br>&nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; say "$vote: {%percentages{$vote}}";<br>&nbsp; &nbsp; }<br> <br>&nbsp; &nbsp; if (%percentages{@ordered[0]} &gt; 0.5)<br>&nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; say;<br>&nbsp; &nbsp; &nbsp; &nbsp; say "The winner is {@ordered[0]} with {%percentages{@ordered[0]} * 100.0}% of the vote.";<br>&nbsp; &nbsp; &nbsp; &nbsp; exit;<br>&nbsp; &nbsp; }<br> <br>&nbsp; &nbsp; my $skip = @ordered.pop;<br>&nbsp; &nbsp; %skip{$skip} = 1;<br>&nbsp; &nbsp; say "Skipping $skip";<br>}</tt></p></div> </blockquote><p>Two difficulties of note here. First, I initially tried making @votes an array of arrays. I couldn't figure out any obvious way to make this work in Perl 6. Second problem is</p><blockquote><div><p> <tt>perl6(28102) malloc: *** error for object 0x2eb5a10: double free<br>*** set a breakpoint in malloc_error_break to debug<br>Segmentation fault</tt></p></div> </blockquote><p>after the script properly finishes.</p> colomon 2008-12-27T02:15:01+00:00 perl6 Phone Number Script, Improved Version http://use.perl.org/~colomon/journal/38162?from=rss I just realized that my problem with <code>trans</code> was that I had that extra space between the function call and the paren. With that removed, <code>trans</code> works perfectly, and makes a more elegant version of my script:<blockquote><div><p> <tt>my $wordlist_filename = "wordlist.txt";<br>my $test_numbers_filename = "numbers.txt";<br> <br>sub Number (Str $s)<br>{<br>&nbsp; &nbsp; my $result = lc($s);<br>&nbsp; &nbsp; $result.=trans('abc' =&gt; '2', 'def' =&gt; '3', 'ghi' =&gt; '4',<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;'jkl' =&gt; '5', 'mno' =&gt; '6', 'prs' =&gt; '7',<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp;'tuv' =&gt; '8', 'wxy' =&gt; '9');<br>&nbsp; &nbsp; return $result;<br>}<br> <br>my $wordlist = open($wordlist_filename);<br>&nbsp; &nbsp; # err die "Could not open $wordlist: $!\n";<br> <br>my %numbers;<br> <br>for (=$wordlist) -&gt; $word<br>{<br>&nbsp; &nbsp; if ($word ~~<nobr> <wbr></nobr>/^\w\w\w\w\w\w\w$/)<br>&nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; my $number = Number($word);<br>&nbsp; &nbsp; &nbsp; &nbsp; say "$word ==&gt; $number";<br>&nbsp; &nbsp; &nbsp; &nbsp; %numbers{$number} = $word;<br>&nbsp; &nbsp; }<br>}<br>close ($wordlist);<br> <br>my $test_numbers = open($test_numbers_filename);<br>for (=$test_numbers) -&gt; $number<br>{<br>&nbsp; &nbsp; my $word = %numbers{$number};<br>&nbsp; &nbsp; say "$number ==&gt; $word";<br>}<br>close ($test_numbers);</tt></p></div> </blockquote><p>Note that in a comment jj suggests a much more spiffy and Perlish way of doing this, which I may try translating to Perl 6 if I get ambitious....</p> colomon 2008-12-25T01:51:38+00:00 perl6 Second Script Game: Finished Script http://use.perl.org/~colomon/journal/38157?from=rss Quibbles in my last post aside, this one pretty much just worked beautifully:<blockquote><div><p> <tt>my $file = "skaters.txt";<br> <br>my @names;<br>my %scores;<br> <br>my $skaters = open ($file);<br>for (=$skaters) -&gt; $skater<br>{<br>&nbsp; &nbsp; my @scores = split ",", $skater;<br>&nbsp; &nbsp; my $name = shift @scores;<br>&nbsp; &nbsp; push @names, $name;<br>&nbsp; &nbsp; my $score = (([+] @scores) - (@scores.min() + @scores.max())) / 5.0;<br>&nbsp; &nbsp; %scores{$name} = $score;<br>&nbsp; &nbsp; say "$name =&gt; $score";<br>}<br>close $skaters;<br> <br>my @sorted_names = sort { %scores{$^b} &lt;=&gt; %scores{$^a} }, @names;<br>say "Gold medal: {@sorted_names[0]}, {%scores{@sorted_names[0]}}";<br>say "Silver medal: {@sorted_names[1]}, {%scores{@sorted_names[1]}}";<br>say "Bronze medal: {@sorted_names[2]}, {%scores{@sorted_names[2]}}";</tt></p></div> </blockquote><p> I was a little surprised the extra braces were required in the say statements, but it still is pretty darned elegant.</p> colomon 2008-12-24T15:56:57+00:00 perl6 Second Script Game: Skating Scores http://use.perl.org/~colomon/journal/38156?from=rss This one is simple: take a list of skating scores, drop the highest and lowest, and take the average of the remaining to get the actual score. Perl 6 shines here, with <code>split</code> and the reduction meta operator making for elegant code. But I've hit on a weird snag:<blockquote><div><p> <tt>$score = $score - (@scores.min () + @scores.max ());</tt></p></div> </blockquote><p>doesn't compile. Err... but</p><blockquote><div><p> <tt>$score = $score - (@scores.min() + @scores.max());</tt></p></div> </blockquote><p>does. Is space before function parameters no longer allowed?</p> colomon 2008-12-24T15:28:14+00:00 perl6 "Finished" script http://use.perl.org/~colomon/journal/38155?from=rss I don't think this code is going to win any converts to Perl 6, but here's what I've got:<blockquote><div><p> <tt>my $wordlist_filename = "wordlist.txt";<br>my $test_numbers_filename = "numbers.txt";<br> <br>sub Number (Str $s)<br>{<br>&nbsp; &nbsp; # $s.=trans ('abc' =&gt; '2', 'def' =&gt; '3', 'ghi' =&gt; '4');<br>&nbsp; &nbsp; # $s ~~ tr/abcdefghijklmnopqrstuvwxyz/222333444555666777888999/;<br> <br>&nbsp; &nbsp; my $result;<br>&nbsp; &nbsp; for (0..6) -&gt; $i<br>&nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; my $c = lc($s.substr($i,1));<br>&nbsp; &nbsp; &nbsp; &nbsp; given $c<br>&nbsp; &nbsp; &nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; when $c eq "a" || $c eq "b" || $c eq "c" { $c = '2'; }<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; when $c eq "d" || $c eq "e" || $c eq "f" { $c = '3'; }<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; when $c eq "g" || $c eq "h" || $c eq "i" { $c = '4'; }<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; when $c eq "j" || $c eq "k" || $c eq "l" { $c = '5'; }<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; when $c eq "m" || $c eq "n" || $c eq "o" { $c = '6'; }<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; when $c eq "p" || $c eq "r" || $c eq "s" { $c = '7'; }<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; when $c eq "t" || $c eq "u" || $c eq "v" { $c = '8'; }<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; when $c eq "w" || $c eq "x" || $c eq "y" { $c = '9'; }<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; # when $c ~~<nobr> <wbr></nobr>/defDEF/ { $c = '3'; }<br>&nbsp; &nbsp; &nbsp; &nbsp; }<br>&nbsp; &nbsp; &nbsp; &nbsp; $result = $result ~ $c;<br>&nbsp; &nbsp; }<br> <br>&nbsp; &nbsp; return $result;<br>}<br> <br>my $wordlist = open($wordlist_filename);<br>&nbsp; &nbsp; # err die "Could not open $wordlist: $!\n";<br> <br>my %numbers;<br> <br>for (=$wordlist) -&gt; $word<br>{<br>&nbsp; &nbsp; if ($word ~~<nobr> <wbr></nobr>/^\w\w\w\w\w\w\w$/)<br>&nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; my $number = Number($word);<br>&nbsp; &nbsp; &nbsp; &nbsp; say "$word ==&gt; $number";<br>&nbsp; &nbsp; &nbsp; &nbsp; %numbers{$number} = $word;<br>&nbsp; &nbsp; }<br>}<br>close ($wordlist);<br> <br>my $test_numbers = open($test_numbers_filename);<br>for (=$test_numbers) -&gt; $number<br>{<br>&nbsp; &nbsp; my $word = %numbers{$number};<br>&nbsp; &nbsp; say "$number ==&gt; $word";<br>}<br>close ($test_numbers);</tt></p></div> </blockquote><p> Notes: The <code>Number</code> function works okay, but it is an awful hack -- what should be one line of code somehow becomes fifteen. <code>err die</code> error checking sadly does not work. I couldn't find a sane way to get the number of letters in a word. I couldn't figure out how to read from standard input. </p><p> On the plus side, the new <code>for</code> syntax is appealing. I love having named parameters for subroutines. The <code>given</code> statement is nice, though I wish I hadn't had to use it in this example. And hashes work correctly.</p> colomon 2008-12-24T14:35:42+00:00 perl6 switch statement versus ~~ http://use.perl.org/~colomon/journal/38154?from=rss I would have thought<blockquote><div><p> <tt>&nbsp; &nbsp; &nbsp; &nbsp; given $c<br>&nbsp; &nbsp; &nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; &nbsp; &nbsp; when $c ~~<nobr> <wbr></nobr>/defDEF/ { $c = '3'; }<br>&nbsp; &nbsp; &nbsp; &nbsp; }</tt></p></div> </blockquote><p>would have worked? This isn't a big deal, it's easy enough to work around, but it does lose elegance points. </p><p> PS Looks like <code>$s.substr($i,1) = $c;</code> doesn't work yet, either? Or is there something wrong with the syntax of that?</p> colomon 2008-12-24T13:52:36+00:00 perl6 Messing Around With Scripting Games http://use.perl.org/~colomon/journal/38150?from=rss So, I dived straight in with "Advanced Event 1: Could I Get Your Phone Number?" I messed around with Pugs a bit a few years back, but this is my first real attempt to do something with Raduko. <p> The problem is to convert a seven digit phone number to a seven letter word from the dictionary they provide. Trying to generate all the possible words from a given number seems too much like work to me, so I'm looking at the problem the other way around -- each seven letter word in the dictionary generates a unique number. I'll put those in a hash, and then looking up a word for a number will be easy. At least, that's my plan. </p><p> I didn't think of creating this journal until I'd worked on the problem a bit, so I don't have my earliest missteps handy. My first effort was just to read the wordlist file and find all the seven letter words. (BTW, this is with Parrot fetched from Subversion last night, and I suppose it's possible I borked my install because I had a previous version of Parrot (from tarball) installed on my machine.) It took a bit of playing around to figure out the new syntax for this sort of thing. The first big roadblock I hit was that I couldn't get the <code>readline</code> function to work for me. <code>=$filehandle</code> works instead, so that wasn't a show stopper. </p><p> My next attempt was to figure out a way to check if a string had exactly seven letters. It looked to me like<nobr> <wbr></nobr><code>.elems</code> was the way to do that in P6, but it always seemed to return 1. (Possibly it was treating it as an array with one string in it, rather than a string with N characters in it?)<nobr> <wbr></nobr><code>.bytes</code> and<nobr> <wbr></nobr><code>.codes</code> didn't seem to be recognized at all. </p><p> I finally solved this with a clumsy but working regex: <code>if ($word ~~<nobr> <wbr></nobr>/^\w\w\w\w\w\w\w$/)</code>. </p><p> Then I worked on a sub to convert the input word to a number. New sub parameter syntax, yay! Laziness kicking in again, I figured good old tr was the easiest way to do the conversion. So far this one has me stumped, however. I haven't found a syntax for tr that Raduko likes yet. </p><p> Here's my current code: </p><blockquote><div><p> <tt>my $wordlist_filename = "wordlist.txt";<br> <br>sub Number (Str $s)<br>{<br>&nbsp; &nbsp; $s.=trans ('abc' =&gt; '2', 'def' =&gt; '3');<br>&nbsp; &nbsp; # $s ~~ tr/abcdefghijklmnopqrstuvwxyz/222333444555666777888999/;<br>&nbsp; &nbsp; return $s;<br>}<br> <br>my $wordlist = open($wordlist_filename);<br>&nbsp; &nbsp; # err die "Could not open $wordlist: $!\n";<br> <br>for (=$wordlist) -&gt; $word<br>{<br>&nbsp; &nbsp; if ($word ~~<nobr> <wbr></nobr>/^\w\w\w\w\w\w\w$/)<br>&nbsp; &nbsp; {<br>&nbsp; &nbsp; &nbsp; &nbsp; my $number = Number($word);<br>&nbsp; &nbsp; &nbsp; &nbsp; say "$word ==&gt; $number";<br>&nbsp; &nbsp; }<br>}<br> <br>close ($wordlist);</tt></p></div> </blockquote><p> (Also note that <code>err die</code> failed to compile, which is why it is commented out.)</p> colomon 2008-12-24T10:04:13+00:00 perl6