Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

Regex to compare (if) two strings (Uniquely - I will explain inside)

by chickenlips (Initiate)
on Nov 24, 2012 at 17:26 UTC ( #1005402=perlquestion: print w/ replies, xml ) Need Help??
chickenlips has asked for the wisdom of the Perl Monks concerning the following question:

Obtained 8 random chars in a sub. Called it $random_string.

Input a word from user (that they make FROM the 8 random chars such as in Scrabble).

Gotta validate the inputted word by checking that it indeed consists of the chars in $random_string.

The KEY BIT I CANNOT FIGURE OUT IS: I need to check that any letters used in the randomly generated for the inputted word are only used ONCE.

Basically a simple version of Scrabble, this is what i have so far:

print "Please enter a word from the letters above: "; chomp(my $word = <STDIN>); #INPUT WORD if ($word =~ /[$random_string]$/i) { print "Good word\n"; last; } else { print "try again\n"; print "\n"; }

Comment on Regex to compare (if) two strings (Uniquely - I will explain inside)
Download Code
Re: Regex to compare (if) two strings (Uniquely - I will explain inside)
by moritz (Cardinal) on Nov 24, 2012 at 17:35 UTC
    if ($word =~ /[$random_string]$/i)

    That only checks the last character from $word.

    I don't think regexes are a good tool for the job. Instead keep a hash of how often each character may appear in the string. Iterate through all characters of the string, and for each character check if it's still allowed. If no, give out an error message. If yes, decrease the allowed count for that character.

Re: Regex to compare (if) two strings (Uniquely - I will explain inside)
by aitap (Deacon) on Nov 24, 2012 at 17:38 UTC
    Use a hash. Create a hash containing all possible letters (something like my %letters = map { $_ => 1 } "a" .. "z";) and get letters in a loop, delete'ing each used letter from the hash.
    Sorry if my advice was wrong.
Re: Regex to compare (if) two strings (Uniquely - I will explain inside)
by BrowserUk (Pope) on Nov 24, 2012 at 17:43 UTC

    Sort the letters in both strings and compare the results:

    $randword = join'', ('A'..'Z')[ map rand 26, 1..8 ];; print $randword;; LDAZAJSA chomp( $input = <STDIN> );; AAADJLSZ print join('', sort split '', $randword ) eq join( '', sort split '', +$input ) ? 'Ok' : 'Bad';; Ok

    With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.

    RIP Neil Armstrong

      I really like the way you are generating the random word; however, my understanding is that sub-sets of letters may be used to make words and your comparison at the end will only work if all letters are used when the user creates a word.

        Looking at the OP a second time:

        Input a word from user (that they make FROM the 8 random chars such as in Scrabble).

        You are probably right. Mea culpa.


        With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
        Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
        "Science is about questioning the status quo. Questioning authority".
        In the absence of evidence, opinion is indistinguishable from prejudice.

        RIP Neil Armstrong

Re: Regex to compare (if) two strings (Uniquely - I will explain inside)
by Kenosis (Priest) on Nov 24, 2012 at 18:29 UTC

    Gotta validate the inputted word by checking that it indeed consists of the chars in $random_string.

    Perhaps I'm misunderstanding you, but this sounds like you want to validate that the two sets of string characters are equal (the 'compare uniquely')--not that the two strings are equal. If this is the case, the following is an option:

    use strict; use warnings; my $word = 'FHDJSKAL'; my $random_string = 'ALSKDJFH'; if ([sort ("\U$word" =~ /./g)] ~~ [sort ("\U$random_string" =~ /./g)]) + { print "Good word.\n"; } else { print "Try again.\n"; print "\n"; }

    Hope this helps!

    Update: Replaced the hash solution with one using the smart operator (~~), as the former didn't match properly.

Re: Regex to compare (if) two strings (Uniquely - I will explain inside)
by AnomalousMonk (Monsignor) on Nov 24, 2012 at 18:39 UTC

    When chickenlips makes reference to Scrabble, what I assume is meant is that a word formed from the random characters need not use all of the random characters, but must use only those characters. E.g., 'mad' can be formed from 'randam', but 'madam' cannot (two 'm' characters).

    use warnings FATAL => 'all' ; use strict; use Data::Dump; use constant DEBUG => 0; use constant { DBPR_DD_1 => 1 && DEBUG, }; my $random = 'randam'; my %r_count; $r_count{$_}++ for split '', $random; dd \%r_count if DBPR_DD_1; for my $word (qw(a mad ran madnar madam ranx xxxxxx x)) { my %u_count = %r_count; my $ok = scrabblicious($word, %u_count); my $len = 2 + length $random; printf qq{%*s %sproperly formed from '$random' \n}, $len, qq{'$word'}, $ok ? ' ' : 'im'; } sub scrabblicious { my ($word, %u_count) = @_; for my $c (split '', $word) { return if --$u_count{$c} < 0; } return 1; }

    Output:

    'a' properly formed from 'randam' 'mad' properly formed from 'randam' 'ran' properly formed from 'randam' 'madnar' properly formed from 'randam' 'madam' improperly formed from 'randam' 'ranx' improperly formed from 'randam' 'xxxxxx' improperly formed from 'randam' 'x' improperly formed from 'randam'

    Update: The definition of  scrabblicious() given above will accept an empty string as a match for a 'tray' of characters. So just add
        return if not length $word;
    before the for-loop.

Re: Regex to compare (if) two strings (Uniquely - I will explain inside)
by CountZero (Bishop) on Nov 24, 2012 at 19:08 UTC
    Using a regex:
    use Modern::Perl; my $randword = join '', ('A'..'Z')[ map rand 26, 1..8 ]; say $randword; say "Make a word with the above characters"; my $word = <>; chomp $word; my $regex = (join '?', sort split '', $randword) . '?'; $word = join '', sort split '', $word; say "Comparing $word with $regex"; if ($word and $word =~ m/^$regex$/i){ say 'OK'; } else { say 'NOT OK'; }

    CountZero

    A program should be light and agile, its subroutines connected like a string of pearls. The spirit and intent of the program should be retained throughout. There should be neither too little or too much, neither needless loops nor useless variables, neither lack of structure nor overwhelming rigidity." - The Tao of Programming, 4.1 - Geoffrey James

    My blog: Imperial Deltronics
Re: Regex to compare (if) two strings (Uniquely - I will explain inside)
by frozenwithjoy (Curate) on Nov 24, 2012 at 19:13 UTC
    Comparing 'random hash' to 'input hash' of letters:
    #!/usr/bin/env perl use strict; use warnings; use feature 'say'; my $randword = join'', ('A'..'Z')[ map rand 26, 1..8 ]; print "Enter a word using '$randword': "; chomp( my $input = <STDIN> ); die "You didn't enter anything..." unless $input; my %rand_hash; $rand_hash{$_}++ for split //, $randword; my %user_hash; $user_hash{$_}++ for split //, uc $input; my $bad_word; foreach (sort keys %user_hash) { if ( ! exists $rand_hash{$_} || $user_hash{$_} > $rand_hash{$_} ) +{ $bad_word = 1; say "Shame on you! You used too many $_\'s!"; } } say "WOW! You are amazing and so is '$input'!" unless $bad_word;
Re: Regex to compare (if) two strings (Uniquely - I will explain inside)
by Tommy (Chaplain) on Nov 24, 2012 at 19:36 UTC

    Sidenote: before comparing characters or using them to build a hash, I'd call uc on each one... for obvious reasons. This is demonstrated in the example from frozenwithjoy

    --
    Tommy
    $ perl -MMIME::Base64 -e 'print decode_base64 "YWNlQHRvbW15YnV0bGVyLm1lCg=="'
Re: Regex to compare (if) two strings (Uniquely - I will explain inside)
by AnomalousMonk (Monsignor) on Nov 24, 2012 at 20:10 UTC

    The solutions of BrowserUk, Kenosis and CountZero seem to be going after anagrams, but my understanding from the reference  allusion to Scrabble in the OP is that words with fewer letters than the 'random' set are acceptable, e.g., 'no' and 'won' as well as 'wonk' from the random set 'know'. Am I off-base on this?

      I agree that OP is leaning more towards Scrabble with the caveat that Scrabble requires the use of at least one (non-random) letter already on the board.

        Hey, I just noticed this! It gives the whole assignment (if you can decode it). Now I'm a little bit sorry I contributed.

      Check my solution once more: it will return "OK" for a "Scrabble" word.

      CountZero

      A program should be light and agile, its subroutines connected like a string of pearls. The spirit and intent of the program should be retained throughout. There should be neither too little or too much, neither needless loops nor useless variables, neither lack of structure nor overwhelming rigidity." - The Tao of Programming, 4.1 - Geoffrey James

      My blog: Imperial Deltronics
Re: Regex to compare (if) two strings (Uniquely - I will explain inside)
by AnomalousMonk (Monsignor) on Nov 25, 2012 at 01:32 UTC

    Further to previous post: A solution using a regex per OP request. No hashes. Note that the function now takes two strings, not a string and a hash. Tested, works.

    sub scrabblicious { my ($word, # word to test for scrabble match to tray of letters $tray, # string with 'tray' of letters to select from ) = @_; return if not length $word; # special case: empty string $tray =~ s/$_//xms or return for map quotemeta, split '', $word; return 1; }

    Update: Instead of
        $tray =~ s/$_//xms or return for map quotemeta, split '', $word;
    using
        $tray =~ s/\Q$_\E//xms or return for split '', $word;
    might be slightly faster because it avoids having  map quotemeta build another intermediate array. (Tested.)

Re: Regex to compare (if) two strings (Uniquely - I will explain inside)
by kcott (Abbot) on Nov 25, 2012 at 03:00 UTC

    G'day chickenlips,

    Here's a solution using index and splice. (Obviously, you'll need to use your code to generate the random word - I've just allowed entering it from the command line for testing purposes.)

    $ perl -Mstrict -Mwarnings -E ' print q{Random word: }; RAND: while (my $randword = <>) { chomp $randword; say "Input words using only letters in: $randword"; INPUT: while (my $inword = <>) { chomp $inword; my @randchars = split q{} => $randword; my $char_count = 0; CHAR: for my $in_char (split q{}, $inword) { ++$char_count; my $pos = index join(q{} => @randchars), $in_char; if ($pos >= 0) { splice @randchars, $pos, 1; } else { say "Failed on char: $in_char (at position $char_count +)"; next INPUT; } } say "$inword OK"; } print q{Random word: }; } print "\n"; '

    Here's a sample run:

    Random word: qqwe Input words using only letters in: qqwe ew ew OK ewq ewq OK ewqq ewqq OK qewq qewq OK qqewq Failed on char: q (at position 5) qqqwe Failed on char: q (at position 3) Random word: aaaabcde Input words using only letters in: aaaabcde qwe Failed on char: q (at position 1) asd Failed on char: s (at position 2) abcdef Failed on char: f (at position 6) abcde abcde OK aaaab aaaab OK aaaaab Failed on char: a (at position 5) Random word: ^D

    -- Ken

      Label not found for "next INPUT" Why I am getting this error when I make mistake not to put a word that can not be created from the provided letters

        Can you show what you did to get this error? I can't replicate your problem.

        Echoing ++frozenwithjoy's comments, you'll need to show under what circumstances this isn't working for you. Please provide (within <code>...</code> tags) exact input, output and any error or warning messages - details for doing this can be found in: How do I post a question effectively?

        -- Ken

Re: Regex to compare (if) two strings (Uniquely - I will explain inside)
by AnomalousMonk (Monsignor) on Nov 25, 2012 at 11:53 UTC

    In a similar vein to this, another regex approach. I hesitate to offer it because I'm not sure the increased complexity pays off. More effort is spent in building the thing, but despite being significantly larger, the final regex may run more quickly versus the repeated compilation and invocation of the shorter  s/// of the previous link. However, it may take operation on rather long strings for any advantage to become manifest. I have done no benchmarking, but at least it's tested and works. The dreams of regexen produce monsters.

    sub scrabblicious { my ($word, # word to test for proper match to tray of letters $tray, # string with 'tray' of letters to select from ) = @_; return unless # handles word empty string (my $rx = join '', sort split '', $word) =~ s{ (.) \1* } { $+[0] - $-[0] > 1 ? qq/(?= (?: .*? \Q$1\E){@{[ $+[0] - $-[0] ]}})/ : qq/(?= .*? \Q$1\E)/ }xmseg; return $tray =~ m{ \A $rx }xms; }

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://1005402]
Approved by moritz
Front-paged by Tommy
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others rifling through the Monastery: (7)
As of 2014-08-02 02:12 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Who would be the most fun to work for?















    Results (53 votes), past polls