Beefy Boxes and Bandwidth Generously Provided by pair Networks
"be consistent"
 
PerlMonks  

Re^4: implementing a scrabble-esque game on Termux III and Path::Tiny output

by Aldebaran (Deacon)
on Dec 03, 2019 at 06:53 UTC ( #11109579=note: print w/replies, xml ) Need Help??


in reply to Re^3: implementing a scrabble-esque game on Termux III
in thread implementing a scrabble-esque game on Termux III

leaving vertical space for respondents...

it prints out every substring with two or more characters

indeed...

$ perl -le ' "abcd" =~ /.{2,}(?{print $&})(*FAIL)/ ' abcd abc ab bcd bc cd $ perl -le ' "abcdefg" =~ /.{2,}(?{print $&})(*FAIL)/ ' abcdefg abcdef abcde abcd abc ab bcdefg bcdef bcde bcd bc cdefg cdef cde cd defg def de efg ef fg $

Alright, well I used 4.say.pl to look at values as they occur in this part of the script. I realize it takes me forever and a day to get through this, but I only get windows of opportunity to do a proper write-up, for example. This one is conditioned on everyone else being asleep. With the dirge of the carol music, it makes a fine perl moment.

$board =~ /(?<!\w).{2,}(?!\w)(?{ push @pat, [ $-[0], $& ] })(*FAIL +)/; #dd @pat; @pat = map expand($_), @pat; @pat = sort { length $b->[1] <=> length $a->[1] } @pat; say "patterns----------------"; dd @pat;

Typical output is:

default is 71 d. old is d. highs is 10 under is d underpat is (?^u:[^db e h i n n o]) words are de do changed is 21 --------------------three choses: 1 38 vibe score: 20 20 .......... 0000000000 .......... 0000000000 .......... 0000000000 .......... 0000000000 ....m..... 0000100000 ..avoid... 0011111000 ...it..... 0001100000 ...bi..... 0001100000 ...ef..... 0001100000 ....s..... 0000100000 /home/bob/4.scripts/distro/games/29-11-2019-16-37-01.txtmove is 2 end of move, continue?

I needed another little helper program to see how the match variables worked:

$ ./1.perlvar.pl 10 15 This is a Hello World program World $

Source:

#!/usr/bin/perl use 5.016; use warnings; my $str="This is a Hello World program"; $str=~/Hello/; say $-[0]; # $-[0] is the offset of the start of the last successful m +atch. say $+[0]; # $+[0] is the offset into the string of the end of the ent +ire match. $str=~/(This)(.*?)Hello(.*?)program/; say $str; say $+; # This returns the last bracket result

I understand the above line in question now and wanted to move down to where I lose my grip again, which is here:

my $newmask = ( $old ^ $word ) =~ tr/\0/\xff/cr; $flip and ( $board, $heights ) = flip $board, $heights; substr $board, $pos, length $word, $word; #say "new mask is $newmask"; substr $heights, $pos, length $highs, ( $highs & $newmask ) =~ tr/0-4/1-5/r | ( $highs & ~$newmask ); $flip and ( $board, $heights ) = flip $board, $heights; my $tiles = join '', @tiles; say "word is $word"; $tiles =~ s/$_// for split //, $word & $newmask;

I still haven't penetrated the logic for this masking. (?) It's similar to the logic used in two of the subroutines, with this as the shorter and more transparent:

sub matchrule { my ( $old, $highs, $word ) = @_; $old eq $word and return 0; my $newmask = ( $old ^ $word ) =~ tr/\0/\xff/cr; ( $newmask & $highs ) =~ tr/5// and return 0; my $tiles = "@tiles"; $tiles =~ s/$_// or return 0 for ( $newmask & $word ) =~ /\w/g; return 1; }

I believe the logic of this routine is that it returns zero if not a legal match and one if it is. I don't understand the relevance of character \xff to any of this, for example. What is the methodology that the use of ^ followed by & ? It would seem to me that the truth value is ^'ed to every bit in $newmask, and the bits correspond to whether the letter in that position matches the one below it. It then meets the logic of where it tests whether it is 5 high, and there it loses me.

As for where I'm going with this, the first "direction" is to get games logged in a reasonable way so that one can manage the output. Any look at the small workings of this program is accompanied by a flood of data, as it is trying out the entire lexicon. I have struggled immensely with Path::Tiny to serialize data that easily shows in STDOUT.

Latest version of working script has a naive way to measure time, but witness these failures:

#my $return2=$save_file->append_utf8(@players); #say "return2 is $return2"; #my $return2=$save_file->append_utf8(@{players}); #say "return2 is $return2"; #my $return2=$save_file->append_utf8($players); #say "return2 is $return2"; #my $return2=$save_file->append_utf8(`dd @players`); #say "return2 is $return2"; #my $return2=$save_file->append_utf8({@players}); #say "return2 is $return2";

, where @player was thus defined:

@ARGV or @ARGV = qw( one two three four ); # for testing # ... my @players; my $maxname = ''; for (@ARGV) { $maxname |= $_; push @players, { name => $_, score => 0, tiles => [ sort splice @drawpile, 0, $maxtiles ] }; }

To see this on STDOUT, all I do is

dd @pat

Similarly, I seek a syntax for printing the time prettily:

# initiate time my $start = [gettimeofday]; #print qq|$time{'yyyymmdd hh:mm:ss.mmm', $start}\n|; #$save_file->append_utf8("$time{'yyyymmdd hh:mm:ss.mmm', $start}\n");

Typical output:

... Duration of move 4 is 27.942196 Current player is 0 Board is .......... .......... .......... .......... .......... .gridders. .......... .......... .......... .......... Heights is 0000000000 0000000000 0000000000 0000000000 0000000000 0324441110 0000000000 0000000000 0000000000 0000000000 patterns---------------- Board is .......... .....g.... .....r.... .....i.... .....d.... .....d.... .....e.... .....r.... .....s.... .......... Heights is 0000000000 0000030000 0000020000 0000040000 0000040000 0000040000 0000010000 0000010000 0000010000 0000000000 patterns---------------- Duration of move 5 is 31.07824 Current player is 1

As the grid fills up in complexity, so does the time for each move. There would need to be a ceiling time of something like 2 minutes. What I would like is a listing of the best 5 words every ten seconds or so.

I have had some successes, as with this related facility for help for wordscapes: find all english words with seven letters or less given their input as a word on ARGV. I've tested it on my phone, and it's a significant tool. I'd like to thank all those who contribute to such mild successes, and in particular tybalt89.

Thanks for your comment,

Replies are listed 'Best First'.
Re^5: implementing a scrabble-esque game on Termux III
by tybalt89 (Prior) on Dec 03, 2019 at 16:42 UTC

    Explanation of the masking in "matchrule"

    sub matchrule { my ( $old, $highs, $word ) = @_; $old eq $word and return 0; my $newmask = ( $old ^ $word ) =~ tr/\0/\xff/cr; ( $newmask & $highs ) =~ tr/5// and return 0; my $tiles = "@tiles"; $tiles =~ s/$_// or return 0 for ( $newmask & $word ) =~ /\w/g; return 1; }

    Let's follow a call to matchrule('hello', '14222', 'world')

    First off, if old and word are the same, it's not a valid move.

    Next, get the mask. ( note: strings have been printed by Data::Dumper::Useqq = 1 )

    'hello' ^ 'world' => "\37\n\36\0\13"

    However, I want to change all non nulls ("\0") to "\xff" so that characters can pass through these positions unchanged.

    my $newmask = ('hello' ^ 'world') =~ tr/\0/\xff/cr => "\377\377\377\0\ +377"

    Now we use this mask against the tile heights and look for any 5's, because the "\xff" in $newmask are at the positions where new tiles will be added.

    ("\377\377\377\0\377" & '14222') => "142\0002"

    and since there is no 5, the new word is not invalid (yet).

    "\377\377\377\0\377" & 'world' => "wor\0d"

    This leaves only the new tiles that must be played, ignoring the "\0" because those positions use the old tile. So remove each new letter from a string of the tile rack, and if any are not there, the move is invalid.

    Hope this helps.

Re^5: implementing a scrabble-esque game on Termux III
by tybalt89 (Prior) on Dec 03, 2019 at 08:43 UTC
    my $newmask = ( $old ^ $word ) =~ tr/\0/\xff/cr; $flip and ( $board, $heights ) = flip $board, $heights; substr $board, $pos, length $word, $word; #say "new mask is $newmask"; substr $heights, $pos, length $highs, ( $highs & $newmask ) =~ tr/0-4/1-5/r | ( $highs & ~$newmask ); $flip and ( $board, $heights ) = flip $board, $heights; my $tiles = join '', @tiles; say "word is $word"; $tiles =~ s/$_// for split //, $word & $newmask;

    let me try...

    my $newmask = ( $old ^ $word ) =~ tr/\0/\xff/cr;

    $newmask is "\xff" where the old and new words differ, that is a new tile must be used. It is "\0" where no tile is to be placed (using existing board state).

    $flip and ( $board, $heights ) = flip $board, $heights; substr $board, $pos, length $word, $word; #say "new mask is $newmask"; # $newmask has unprintable characters +, use something like Data::Dump that will show them. substr $heights, $pos, length $highs, ( $highs & $newmask ) =~ tr/0-4/1-5/r | ( $highs & ~$newmask );

    hehehe! GOAL => increment the stack sizes for only the new tiles.

    $highs & $newmask produces a string that only has non-null characters where new tiles are to be played. In other words, it isolates the stacks for the new tiles, everywhere else is "\0".
    =~ tr/0-4/1-5/r increments the height for each place a new tile is played.
    ~$newmask inverts $newmask to be "\xff" only where old tiles remain visible.
    $highs & ~$newmask produces a string with only the unchanged stack values (and "\0" where the new values are).
    Finally, the | puts the old and new stack counts together so they can be replaced in the heights string.

    $flip and ( $board, $heights ) = flip $board, $heights; my $tiles = join '', @tiles; say "word is $word"; $tiles =~ s/$_// for split //, $word & $newmask;

    This removes the tiles that are used for this word from the string of all tiles, soon to be replaced in @tiles.

    Hope this helps...

      Hope this helps...

      It does. I was able to see these masks by unpacking them as hexidecimal. Here's a bit of output:

      Fishing for tips. Thanks for your comment,

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (3)
As of 2020-11-27 06:37 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?