Hangman: quiz of the week #17 (Allgemeines zu Perl)

[thread]6296[/thread]

Hangman: quiz of the week #17

Leser: 1

Crian

2004-05-28 22:26

User since
2003-08-04
5866 Artikel
ModeratorIn

Ich beteilige mich bei "Quiz of the week", diese Woche war folgende Aufgabe zu lösen:

Quiz of the Week #17

The given problem was:

The Game of Hangman

The goal of the game is to guess a word with a certain (limited)
number of guesses. If we fail the "man" gets "hanged," if we succeed
he is set free. (We're not going to discuss the lesson's of life or
justice this game teaches to the 8 year olds who play it regularly).

The game starts out with one person (not the player) choosing a
"mystery" word at random and telling the player how many letters the
mystery word contains. The player then guesses letters, one at a time,
and the mystery word's letters are filled in until a) the entire word
is filled in, or b) the maximum number of guesses are reached and the
the player loses (man is hanged).

Write a perl program which lets the user play hangman. The program
should take the following arguments:

1) the dictionary file to use
2) the maximum number of guesses to give the player.

The program must then chose a mystery word from the dictionary file
and print out as many underscores ("_") as there are letters in the
mystery word. The program will then read letters from the user one at
a time. After each guess the program must print the word with properly
guessed letters filled in. If the word has been guessed (all the
letters making up the word have been guessed) then the program must
print "LIFE!" and exit. If the word is not guessed before the maximum
number of guesses is reached then the program must print "DEATH!" and
exit.

Example interaction:

Code: (dl )

        % ./hangman /usr/share/dict 5
                _
        m
                m
        a
                ma_
        n
                LIFE!
        $ ./hangman /usr/share/dict 3
                _
        m
                m__
        d
                DEATH!
        %

NOTES
------

1) The dictionary file will contain one word per line and use only
7-bit ASCII characters. It may contain randomly generated
words. The dictionary will contain only words longer than 1
character. The size of the dictionary may be very large. See

http://perl.plover.com/qotw/words/

for sample word lists.

2) The dictionary file used for the test (or the program for
generating it) will be made available along with the write-up.

3) If a letter appears more than once in the mystery word, all
occurrences of that letter must be filled in. So, if the word is
'bokonon' and the player guesses 'o' the output must be '_o_o_o_'.

It was remarked from someone, that these rules are not the original
game rules (because normaly you get only a bad point for wrong
guesses or right guesses you have already asked.

s--Pevna-;s.([a-z]).chr((ord($1)-84)%26+97).gee; s^([A-Z])^chr((ord($1)-52)%26+65)^gee;print;

use strict; use warnings; Link zu meiner Perlseite

Crian

2004-05-28 22:26

User since
2003-08-04
5866 Artikel
ModeratorIn

Mein Text/Lösung dazu:

So my program fits boths rule sets. The default behaviour is exactly
like the discribed above, with the option -o the original rule set is
used.

With option -h the program gives a help output and exits. But it have
to be the first parameter to work.

With the option -v the program prints additional informations about
the number of guesses, if they count for every guess or only wrong
guesses and the already tried guesses (divided in hits and fails
with a slash). It also prints the right solution after DEATH! with
the option -v set.

The options -o and -v can be mixed in these ways:

Code: (dl )

  -o -v
  -v -o
  -ov
  -vo

My solution to QOTW #17:

Code: (dl )

    print
("$0 [-h] [-o] [-v] dictfile tries\n\t-o allows original game rules\n\t-v shows helpful in",
"fos\n")&&exit if $ARGV[0 ]eq'-h'or 2>@ARGV;$ n=$v=1,shift if $ARGV[ 0]eq'-vo'or$ ARGV [0]eq
'-ov';$v=1,shift if$ARGV[0]eq'-v';$n= 1,shift if$ARGV [0]eq'-o';$v=1,shift if$ ARGV[0]eq'-v'
    ;open           I,$                                     ARGV
    [0]or         die                                       'n'.
    'o '.       'd'.                                        'i'.
    'ct'.     'i'.                                          'o'.
    'na'.   'r'.                                            'y'.
    " '".$ARGV                                              [0].
    "' fo".                                              "u".'nd '
    .'('.                                              "$!)";@w=<I>;
    chomp                                             ($w=$w[int rand
    @w]);                                              $t=$ARGV[01];
    while                                               (07){%S=();
    %T=()                                                  ;if
    (join                                                   (''
    ,grep                                             {!$S{$_}++}sort
    split                                        (//,$w))eq join('',grep{
    ! $T{                                       $_}++}sort(split //,$g))){
    print                                     "\tLIFE!\n";exit;}last if! $t;
    print                                     "\t",(map{(index($g,$_)>=0)?$_
    :'_'}                                     split(//,$w)),($v?" ($t ".($n?
    'wro'                                     .'ng ':'').'guesses left [gue'
    .'ss'                                     .'ed:'.$g.'/'.$f.'])':''),"\n"
    ;$i =                                    substr<STDIN>,0,1;--$t if!$n;if(
    index                                   ($w,$i)>=0){--$t if$n&&index($g,$i
    )>=0;                                        $g.=$i;}else{--$t if $n;
    $ f.=                                           $i;}}print "\tDEA"
    ,"TH"                                           ,"!\n";print"the "
    ,"So"                                           ,"lution was $w\n"
    if$v;                                           #  Copyright  2004
    #by C                                           hristian Duehl. Al
    #l ri                                           ghts reserved. Thi
    #s pr                                           ogram is free soft
    #ware                                         . You can    redistrib
    #ute#                                       it and/or m    odify it un
    #der#
    #the#
    #same
    #term
    #s as
#perl itself.

Example run:

Code: (dl )

$ perl qotw17.pl example_words 5
        _
m
        m
a
        ma_
n
        LIFE!

$ perl qotw17.pl example_words 3
        _
m
        m_ (3 wrong guesses left [guessed:/])
c
         (2 wrong guesses left [guessed:m/c])
d
        m__ (1 wrong guesses left [guessed:m/cd])
a
        ma_ (1 wrong guesses left [guessed:ma/cd])
n
        LIFE!

Leider wird der Code sogar hier blöd umgebrochen ... eigentlich ist der Balken oben nur drei Zeilen dick.

Am besten ihr kopiert es Euch in einen Editor und setzt die Zeilen wieder zusammen...

*seufz*

Schade, dass man keine Dateien mehr an die Beiträge anhängen kann.\n\n

s--Pevna-;s.([a-z]).chr((ord($1)-84)%26+97).gee; s^([A-Z])^chr((ord($1)-52)%26+65)^gee;print;

use strict; use warnings; Link zu meiner Perlseite

Strat

2004-05-28 22:40

User since
2003-08-04
5246 Artikel
ModeratorIn

fuer obfus dieser art wird auch gerne $_ irgendwas zugewiesen, aus $_ dann alle whitespaces herausgefiltert und via eval ausgefuehrt. da muss man halt aufpassen, dass man die wichtigen whitespaces durch irgendwas ersetzt (z.B. + bietet sich haeufig an)

perl -le "s::*erlco'unaty.'.dk':e,y;*kn:ai;penmic;;print"
http://www.fabiani.net/

esskar

2004-05-28 23:17

User since
2003-08-04
7321 Artikel
ModeratorIn

user image

cool

Crian

2004-05-29 01:34

User since
2003-08-04
5866 Artikel
ModeratorIn

danke :)

richtig obuscated ist es ja gar nicht (perltidy macht was recht gut verstehbares daraus, bei obfu folgt da ja noch ein weiterer Schritt: Handarbeit ;-). Das könnte ich mal für eine nächste Version machen.

Dafür nehm ich dann auch gern noch weitere Tipps entgegen =)

s--Pevna-;s.([a-z]).chr((ord($1)-84)%26+97).gee; s^([A-Z])^chr((ord($1)-52)%26+65)^gee;print;

use strict; use warnings; Link zu meiner Perlseite

Ronnie

2004-05-29 12:48

User since
2003-08-14
2022 Artikel
BenutzerIn
[default_avatar]

crian++

sri

2004-05-30 01:29

User since
2004-01-29
828 Artikel
BenutzerIn

http://mojolicio.us/

View all threads created 2004-05-28 22:26.