A Word Game (Update 3)

Yes I play this game every day on the web. I just wanted to see if I could do it.

There are probably still bugs!

Tested with xterm on Debian.

If this is a copyright violation please remove it.

<Reveal this spoiler or all spoilers in this node or all in this thread>

Update

I think I've fixed the bugs pointed out by toolic. Let me know if you find any more.

~~<Reveal this spoiler>~~

Update number 2

I think that this now works correctly, but if you find any bugs please let me know. TIA

Update number 3

Thanks to toolic and wazoox for helping to find bugs. I hope that this fix is the last. :)

#!/usr/bin/perl
use warnings;
use strict;

use Term::ANSIColor ':constants';


my $clear = `clear`;
my $reset = RESET;
my $white_on_red    = BRIGHT_WHITE . ON_RED;
my $white_on_green  = BRIGHT_WHITE . ON_GREEN;
my $white_on_yellow = BRIGHT_WHITE . ON_YELLOW;
my $white_on_gray   = BRIGHT_WHITE . ON_BRIGHT_BLACK;

my $divider = "   ---   ---   ---   ---   ---\n";

my $kb = <<KB;
    Q  W  E  R  T  Y  U  I  O  P 

     A  S  D  F  G  H  J  K  L 

      Z  X  C  V  B  N  M 

KB

my @lines = (
    [ ( '   ' ) x 5 ],
    [ ( '   ' ) x 5 ],
    [ ( '   ' ) x 5 ],
    [ ( '   ' ) x 5 ],
    [ ( '   ' ) x 5 ],
    [ ( '   ' ) x 5 ],
    );
my $curr_line = 0;

my %dict;
{
    open my $FH, '<', '/usr/share/dict/words' or die "Cannot open '/us
+r/share/dict/words' because: $!";
    @dict{ map uc, grep /[aeiou]|.y./, map /^([a-z]{5})$/, <$FH> } = (
+);
    }
my $curr_word = ( keys %dict )[ rand keys %dict ];

{    local $| = 1;

    print
        $clear,
        "   ${white_on_gray}Letter not used.$reset\n",
        "   ${white_on_yellow}Letter is used.$reset\n",
        "   ${white_on_green}Letter in correct place.$reset\n",
        "   ${white_on_red}Not a valid word.$reset\n",
        "\n",
        map( { my $line = $_; $divider, ' ', map( " |$_|", @{ $lines[ 
+$line ] } ), "\n", $divider } 0 .. $#lines ),
        "\n\n",
        $kb,
        "\n";

    if ( $curr_line == @lines ) {
        #print "\L$curr_word\n";
        last;
        }

    print 'Enter five letter word: ';
    my ( $word ) = map uc, <STDIN> =~ /^([a-zA-Z]{5})/;
    my @letters = split //, $word;
    @letters == 5 or redo;

    # Not a valid five letter word
    unless ( exists $dict{ $word } ) {
        $lines[ $curr_line ] = [ map "$white_on_red $_ $reset", @lette
+rs ];
        redo;
        }

    # The correct answer
    if ( $word eq $curr_word ) {
        $lines[ $curr_line ] = [ map "$white_on_green $_ $reset", @let
+ters ];
        for my $letter ( @letters ) {
            $kb =~ s/(?:\e\[\d+m\e\[\d+m)? $letter (?:\e\[0m)?/$white_
+on_green $letter $reset/;
            }
        $curr_line = @lines;
        redo;
        }

    # Default; all letters to white on gray
    $lines[ $curr_line ] = [ map "$white_on_gray $_ $reset", @letters 
+];
    for my $letter ( @letters ) {
        $kb =~ s/(?:\e\[\d+m\e\[\d+m)? $letter (?:\e\[0m)?/$white_on_g
+ray $letter $reset/;
        }

    # Find exact matches
    my @found = ( 0 ) x 5;
    my $xor_word = $word ^ $curr_word;
    while ( $xor_word =~ /\0/g ) {
        $found[ $-[ 0 ] ] = 1;
        my $letter = $letters[ $-[ 0 ] ];
        $lines[ $curr_line ][ $-[ 0 ] ] = "$white_on_green $letter $re
+set";
        $kb =~ s/(?:\e\[\d+m\e\[\d+m)? $letter (?:\e\[0m)?/$white_on_g
+reen $letter $reset/;
        }

    my $curr_remains = join '', ( split //, $curr_word )[ grep !$found
+[ $_ ], 0 .. $#found ];

    # Find other correct letters
    for my $index ( 0 .. $#letters ) {
        next if $found[ $index ];
        my $letter = $letters[ $index ];
        if ( $curr_remains =~ s/$letter/ / ) {
            $lines[ $curr_line ][ $index ] = "$white_on_yellow $letter
+ $reset";
            $kb =~ s/(?:\e\[\d+m\e\[\d+m)? $letter (?:\e\[0m)?/$white_
+on_yellow $letter $reset/;
            }
        }

    ++$curr_line;
    redo;
    }
[download]

Comment on A Word Game (Update 3) Select or Download Code

Replies are listed 'Best First'.
Re: A Word Game by Fletch (Bishop) on Feb 09, 2022 at 07:16 UTC
Related an interesting dive attempting to automate (and optimize) playing and the information theory underneath. The cake is a lie. The cake is a lie. The cake is a lie.	[reply]
Re: A Word Game by toolic (Bishop) on Feb 09, 2022 at 22:55 UTC
I think I see a minor bug. For example, if I hack the code to add the following line after the `my $curr_word = ...` line: `$curr_word = 'QUOTE';` [download] this has the affect of forcing a specific word, just for debug. When I run it, and guess the word "emote", it displays: `--- --- --- --- --- \| E \| \| M \| \| O \| \| T \| \| E \| --- --- --- --- ---` [download] "M" shows up as gray, and "OTE" shows up as green, as expected. However, the 1st "E" shows up as yellow. I interpret that to mean that the word should have 2 "E"'s. I expect the 1st "E" to be gray. If I guess the word "smote", it displays the "S" as gray, as expected. Therefore, I think there is a problem when the guess has 2 of the same letter. What do you think?	[reply] [d/l] [select]
Re^2: A Word Game (update) by LanX (Saint) on Feb 09, 2022 at 23:25 UTC
I think you are right about the behavior and it's not the way I saw wordle handling this case. But the OP didn't want to infringe any copyrights anyway... ;-) update more explicitly; The code does # Find letters that are in the word # Find letters that are in the word and at the correct position it should be the other way round, and correct positions excluded previous to step 2 Cheers Rolf _{(addicted to the Perl Programming Language :) Wikisyntax for the Monastery}	[reply]
Re^2: A Word Game by jwkrahn (Abbot) on Feb 10, 2022 at 00:48 UTC
Thank you for the feedback. Yes, this is the bug to which I eluded, but I am working on it.	[reply]
Re^3: A Word Game by toolic (Bishop) on Feb 10, 2022 at 18:32 UTC
I tried the updated code, but I still get the same result. Did you test the code with QUOTE as the current word and EMOTE as the guess? Don't you see the 1st "E" as yellow?	[reply]
Re^4: A Word Game by jwkrahn (Abbot) on Feb 10, 2022 at 21:28 UTC
Re^4: A Word Game by jwkrahn (Abbot) on Feb 13, 2022 at 00:47 UTC
Re^5: A Word Game by wazoox (Prior) on Feb 14, 2022 at 15:43 UTC
Some notes below your chosen depth have not been shown here
Re: A Word Game by toolic (Bishop) on Feb 09, 2022 at 20:16 UTC
Thanks for this! I was unfortunate enough to randomly get a non-word from my `/usr/share/dict/words` file: `fldxt` [download] I added a `grep` to only allow words with a vowel (or "y"): `@dict{ map uc, grep /[aeiouy]/, map /^([a-z]{5})$/, <$FH> } = ();` [download] I found this out by adding an option to print the current word at the end: `print "\n Answer = $curr_word\n" if @ARGV;` [download]	[reply] [d/l] [select]
Re^2: A Word Game by choroba (Cardinal) on Feb 09, 2022 at 21:28 UTC
> non-word It seems it is a word: fluid extract (used in Amercian prescriptions). `map{substr$_->[0],$_->[1]\|\|0,1}[\\|\|{},3],[[]],[ref qr-1,-,-1],[{}],[sub{}^ARGV,3]`	[reply] [d/l]
Re^2: A Word Game by LanX (Saint) on Feb 09, 2022 at 20:42 UTC
> I added a grep to only allow words with a vowel (or "y"): since "j" is a variant of "i", I wouldn't be surprised if it was occasionally used as a vowel Cheers Rolf _{(addicted to the Perl Programming Language :) Wikisyntax for the Monastery}	[reply]
Re^3: A Word Game by jdporter (Paladin) on Feb 09, 2022 at 21:15 UTC
Not in English. What we do see is the use of 'j' in place of 'i' when that 'i' is functioning more like a consontantal 'y'. For example, eject from Latin eiectus	[reply]
Re^4: A Word Game by LanX (Saint) on Feb 09, 2022 at 21:56 UTC
Re^5: A Word Game by hippo (Bishop) on Feb 10, 2022 at 10:29 UTC
Some notes below your chosen depth have not been shown here
Re^5: A Word Game by GotToBTru (Prior) on Feb 10, 2022 at 19:50 UTC
Some notes below your chosen depth have not been shown here
Re^3: A Word Game by kcott (Archbishop) on Feb 10, 2022 at 01:49 UTC
"since "j" is a variant of "i", I wouldn't be surprised if it was occasionally used as a vowel" The word "fjord" springs to mind. I expect there are others. — Ken	[reply]
Re^4: A Word Game by eyepopslikeamosquito (Archbishop) on Feb 11, 2022 at 07:12 UTC
Re^5: A Word Game by erix (Prior) on Feb 11, 2022 at 07:26 UTC
Re^5: A Word Game by LanX (Saint) on Feb 11, 2022 at 08:44 UTC
Some notes below your chosen depth have not been shown here
Re^4: A Word Game by jdporter (Paladin) on Feb 10, 2022 at 20:52 UTC
Re^5: A Word Game by kcott (Archbishop) on Feb 11, 2022 at 02:57 UTC
Some notes below your chosen depth have not been shown here
Re^5: A Word Game by LanX (Saint) on Feb 10, 2022 at 21:47 UTC
Some notes below your chosen depth have not been shown here
Re: A Word Game by LanX (Saint) on Feb 09, 2022 at 11:29 UTC
> If this is a copyright violation please remove it. I would have guessed that Wordle is already infringing the patent of Mastermind. (almost same rules, just with letters from "real" words instead of colors). But it turns out that Mastermind is "inspired" by an old pen-and-paper game called Bulls and Cows So if you are worried just generalize the mechanisms slightly and add new dictionaries to create a "new" game. � Cheers Rolf _{(addicted to the Perl Programming Language :) Wikisyntax for the Monastery} �) For instance: I was thinking of adapting perlglossary, one would need a way to incorporate words of different length and starting position. :)	[reply]
Re: A Word Game (my solution) by jdporter (Paladin) on Feb 15, 2022 at 14:41 UTC
# given a wordle W and a guess G, calculate the result. package Wordle; use strict; use warnings; # returns a vector of match codes: 2=right/right; 1=right/wrong; 0=w +rong. sub guess { my( $wordl, $guess ) = @_; my @result=(0)x5; # first, look for the right/right: for my $i ( 0 .. 4 ) { if ( substr($wordl, $i, 1) eq substr($guess, $i, 1) ) { $result[$i] = 2; substr($wordl, $i, 1) = ' '; substr($guess, $i, 1) = ' '; } } $guess eq ' ' and return(5,0); # done # second, look for the right/wrong: for my $i ( 0 .. 4 ) { my $l = substr $guess, $i, 1; next if $l eq ' '; if ( $wordl =~ /$l/ ) { $result[$i] = 1; substr($wordl, $i, 1) = ' '; substr($guess, $i, 1) = ' '; } } @result } # returns a vector of counts ( right/right, right/wrong ) sub numeric_guess { my( $wordl, $guess ) = @_; # first, look for the right/right: my $right=0; for my $i ( reverse( 0 .. 4 ) ) { if ( ord(substr $wordl, $i, 1) eq ord(substr $guess, $i, 1) ) { $right++; substr($wordl, $i, 1) = ''; substr($guess, $i, 1) = ''; } } $right == 5 and return(5,0); # done # second, look for the right/wrong: my $wrong = 0; for my $l ( split '', $guess ) { $wordl =~ s/$l// and $wrong++; } join '', ($right, $wrong) } __PACKAGE__ [download]	[reply] [d/l]
Re: A Word Game (Updated) by jdporter (Paladin) on Feb 11, 2022 at 14:25 UTC
Has anyone found the dictionary Josh W uses? He must have one, for when determining whether a guess is a "valid word". I asked him by email; have not gotten a response.	[reply]
Re^2: A Word Game (Updated) by LanX (Saint) on Feb 11, 2022 at 17:35 UTC
I suppose it's loaded with the JS. There is no network traffic while playing. update check the array `Oa` with its 10600 entries, please note that the solutions from `Ma` are not included. Cheers Rolf _{(addicted to the Perl Programming Language :) Wikisyntax for the Monastery} PS: I'm wondering how long the NY-Times will need to shut down the commercial copycats.	[reply] [d/l] [select]
Re^3: A Word Game (Updated) by jdporter (Paladin) on Feb 14, 2022 at 12:25 UTC
Thank you so much! Now I'm just sad that the official dictionary being used is almost double the size of the one I had.	[reply]


laziness, impatience, and hubris
	PerlMonks

A Word Game (Update 3)

update

update