Kirjautuminen

Haku

Tehtävät

Keskustelu: Koodit: Pascal: Voita kone numeropelissä ja ansaitse 10 euroa!!

PetriKeckman [26.06.2022 17:24:46]

#

Voi luoja kun oon koodaillut! Tupakkia ja kahvia kului. Numeropelissä on nyt tekoäly!

Tuolla .exe tiedosto: https://petke.info/numeropeli2.exe

Windows ei tietenkään tykkää ajaa .exe tiedostoja viirusten pelossa, mutta esimerkiksi Windows 10 saatte sen toimimaan painamalla "More info" ja "Run anyway".

En paljasta Free Pascal koodia, vielä. Myöhemmin kyllä. Saatte testailla ohjelman tekoälyä. Lupaan 10 euroa sille, joka voittaa "koneen"! Ohjelma paljastaa koodin, millä saatte sen rahan, jos voitatte. Tilinumeronne ja koodin voitte sitten lähettää sähköpostilla petrikeckman@gmail.com Joku hakkeri voisi löytää koodin ohjelmaa hakkeroimalla, mutta luotan rehellisyyteenne. Tosin kuvakaappaus lopputilanteesta todisteeksi olisi ok.

En osannut, enkä jaksanut Free Pascalilla alkaa väsäämään mitään graafista käyttöliittymää. Peli toimii MS-DOS Command Promptissa. Ei tarvitse käynnistää sieltä, vaan ohjelma avaa Promptin kun klikkaatte sen kuvaketta Windowssissa.

Voittaminen ei missään nimessä ole mahdotonta! Pelaajalla on aloittajan etu ja 9x9 ruudukko on melko pieni. Toisin kuitenkin kuin tässä https://petke.info/numeropeli/ Javascript pelissä, pelaaja ei pääse ihan puhtaalta pöydältä aloittamaan, vaan tähtilaatan paikka ollaan aluksi arvottu.

Itse en raskaan koodaamistyön jälkeen jaksa niin ohjelman tekoälyä testata. Ja varmasti pelissä voi olla bugeja. Onko virheetöntä ohjelmaa olemassakaan? Nyt syön ja meen nukkumaan.

Muistakaa!: Painatte siis sitä _rivinumeroa_, mistä numeron valitsette. Itse väsyneenä aloin painelemaan välillä sitä numeroa, minkä halusin valita. Aluksi peli miettii melko kauan, koska pelipuu rakenteesta tulee iso. Pelin edetessä miettimisaika vähenee.

Hauskaa peli-iloa! (jos nyt tappioista voi iloita?)

PetriKeckman [26.06.2022 20:44:04]

#

PetriKeckmaan kirjoitti:

En paljasta Free Pascal koodia, vielä.

Tokihan mä voin jo ohjelman Pascal koodin julkaista: deletoin siitä sen koodin, millä ansaitsisitte sen 10 euroa. Siis edelleen tarjous on voimassa. Voihan joku taitava innostua jopa ohjelmoimaan oman versionsa ja pistää pelaamaan sen mun ohjelmaa vastaan. Huono tuntipalkka kyllä olisi...

Mun ohjelma rakentaa pelipuuta yhdeksän tasoa eteenpäin. Jos joku laittaa ohjelmansa miettimään pelitilannetta pidemmälle, niin ehkä voittaisi sen 10 egee.

Varmasti löytyy PALJON tyylikkäämpi ratkaisu kuin mulla. Esimerkiksi rekursion käyttö pelipuun käsittelyssä lyhentäisi koodia huomattavasti ja tekisi siitä selkeämpää. Itse en vaan oikein rekursiota hallitse :( Siksi tää koodilistaus on pitkä kuin nälkävuosi, mutta ehkä siitä joku voi jotain käsitystä saada, kuinka ohjelma "miettii" siirtoja eteenpäin.

Ja niin, tietysti: nyt kun koodin paljastan, niin voisihan joku käyttää sitä hyväkseen ja pistää oman versionsa pelaamaan mun ohjelmaa vastaan ja miettimään siirtoja pidemmälle. Silloin joutuu tietysti manuaalisesti syöttämään tämän ohjelman arpoman alkutilanteen.

Koodi on alunperin tehty Amigan Pascalilla. Se ohjelma oli hieman erilainen. Tähän ohjelmaan on jäänyt vähän jotain turhaa sotkua. En jaksanut siivota koodia: pääasia mulle taas, että se toimii.

Program Numeropeli;
uses Crt;

CONST
    tyhja=-32768;
    tahti=32767;
    maxind=9;

TYPE indtype = 1..maxind;
     solmuos = ^solmu;
     solmu   = RECORD
                  arvo:Integer;
                  ind :Indtype;
                  oikveli:solmuos;
               END;
     puu     = ^puutaso;
     puutaso = RECORD
                  ylataso:puu;
                  siirrot:solmuos;
                  parasarvo:INTEGER;
               END;
VAR
    quit        : BOOLEAN;
VAR
    kayttamattomat:     puu;    {Solmuja ei tuhota ja luoda yhtenään, vaan laitetaan ja}
                                {otetaan kayttamattomat listaan}
    kayttamattsolmut:   solmuos;
    koneenlaatat,
    pelaajanlaatat,
    taso,
    maxtaso,
    koneyht,pelayht :	Integer;
    koneenvuoro,
    pelipaattyi,
    konesarakkeittain:   BOOLEAN;
    tahtirivi,
    tahtisara,
    edtahtirivi,
    edtahtisara     :   indtype;
    alkutilanne     :   ARRAY [1..maxind,1..maxind] OF INTEGER;
    pelilauta       :   ARRAY [1..maxind,1..maxind] OF INTEGER;
    odotus          :   char;
    ind				:	Integer;
    oletus			: 	BOOLEAN;
FUNCTION TASOPARILLINEN:BOOLEAN;
BEGIN
  TASOPARILLINEN:=(taso MOD 2=0)
END;
FUNCTION SARAKESIIRTO:BOOLEAN;
BEGIN
  IF TASOPARILLINEN THEN SARAKESIIRTO:=konesarakkeittain
                    ELSE SARAKESIIRTO:=NOT(konesarakkeittain)
END;
PROCEDURE MUUTALAUTATILANNE(siirto:indtype);
BEGIN
     pelilauta[tahtirivi,tahtisara]:=tyhja;
     IF SARAKESIIRTO THEN
        BEGIN
            pelilauta[siirto,tahtisara]:=tahti;
            tahtirivi:=siirto;
        END ELSE
            BEGIN
                pelilauta[tahtirivi,siirto]:=tahti;
                tahtisara:=siirto;
            END;
END;

PROCEDURE KONESIIRTAA;
VAR alkuind:indtype;
    pelipuu,
    uusitaso:puu;
    pojat:solmuos;
    parasind:indtype;
PROCEDURE PERULAUTATILANNE(siirto:indtype);
BEGIN
     pelilauta[tahtirivi,tahtisara]:=alkutilanne[tahtirivi,tahtisara];
     IF SARAKESIIRTO
        THEN
           BEGIN
                pelilauta[siirto,tahtisara]:=tahti;
                tahtirivi:=siirto;
           END
        ELSE
           BEGIN
                pelilauta[tahtirivi,siirto]:=tahti;
                tahtisara:=siirto;
           END;
END;
PROCEDURE TUHOATASOSOLMU(VAR os:puu);
BEGIN
  os^.ylataso:=kayttamattomat;
  kayttamattomat:=os;
END;
PROCEDURE UUSITASOSOLMU(VAR os:puu);
BEGIN
  IF kayttamattomat=NIL THEN NEW(os)
  ELSE BEGIN
         os:=kayttamattomat;
         kayttamattomat:=kayttamattomat^.ylataso;
         os^.ylataso:=NIL;
       END;
END;
PROCEDURE UUSISOLMU(VAR os:solmuos);
BEGIN
  IF kayttamattsolmut=NIL THEN NEW(os)
  ELSE
    BEGIN
      os:=kayttamattsolmut;
      kayttamattsolmut:=kayttamattsolmut^.oikveli;
      os^.oikveli:=NIL;
    END;
END;
PROCEDURE TUHOASOLMU(VAR os:solmuos);
BEGIN
  os^.oikveli:=kayttamattsolmut;
  kayttamattsolmut:=os;
END;
PROCEDURE RAKENNASEURAAVATASO;
VAR  solmu,vika:solmuos;
            ind:indtype;
     laattaarvo:INTEGER;
BEGIN
  pojat:=NIL;
  taso:=taso+1;
  FOR ind:=1 TO maxind DO
    BEGIN
      IF SARAKESIIRTO THEN laattaarvo:=pelilauta[ind,tahtisara]
       ELSE laattaarvo:=pelilauta[tahtirivi,ind];
      IF laattaarvo<>tyhja THEN
         IF laattaarvo<>tahti THEN
            BEGIN
              UUSISOLMU(solmu);
              IF TASOPARILLINEN THEN
                 solmu^.arvo:=pelipuu^.siirrot^.arvo+laattaarvo
               ELSE solmu^.arvo:=pelipuu^.siirrot^.arvo-laattaarvo;
              solmu^.ind:=ind;
              IF pojat=NIL THEN  { Vasta ensimmäinen solmu jonoon }
                BEGIN
                  pojat:=solmu;
                  vika:=pojat;
                END
             ELSE
                BEGIN
                  vika^.oikveli:=solmu;
                  solmu^.oikveli:=NIL;
                  vika:=solmu;
                END;
            END;
       END;
       IF pojat=NIL THEN  { Ei päästy enää jatkamaan eli päädyttiin  }
          BEGIN           { lehtisolmuun, jonka arvo kerrotaan kymme- }
             taso:=taso-1;{ nellä.                                    }
             pelipuu^.siirrot^.arvo:=pelipuu^.siirrot^.arvo*10;
          END
        ELSE
          BEGIN
            UUSITASOSOLMU(uusitaso);
            uusitaso^.ylataso:=pelipuu;
            uusitaso^.siirrot:=pojat;
            IF TASOPARILLINEN THEN uusitaso^.parasarvo:=-MAXINT
                              ELSE uusitaso^.parasarvo:=MAXINT;
            MUUTALAUTATILANNE(uusitaso^.siirrot^.ind);
            pelipuu:=uusitaso;
          END;
END;
PROCEDURE PURAPUUTA;
PROCEDURE POISTASOLMU;
VAR apusolmu:solmuos;
    arvo:Integer;
BEGIN
  arvo:=pelipuu^.siirrot^.arvo;
  IF TASOPARILLINEN THEN
     BEGIN IF arvo>pelipuu^.parasarvo THEN
          BEGIN
            pelipuu^.parasarvo:=arvo;
            IF taso=2 THEN parasind:=pelipuu^.siirrot^.ind;
          END;
     END
  ELSE
     IF arvo<pelipuu^.parasarvo THEN pelipuu^.parasarvo:=arvo;
  apusolmu:=pelipuu^.siirrot;
  pelipuu^.siirrot:=pelipuu^.siirrot^.oikveli;
  TUHOASOLMU(apusolmu);
END;
PROCEDURE NOUSETASOLTAYLOS;
VAR apu:puu;
BEGIN
  IF taso>1 THEN
  BEGIN
    pelipuu^.ylataso^.siirrot^.arvo:=pelipuu^.parasarvo;
    apu:=pelipuu;
    pelipuu:=pelipuu^.ylataso;
    TUHOATASOSOLMU(apu);
    taso:=taso-1;
    POISTASOLMU; { Poistetaan myos isasolmu }
    IF taso>1 THEN IF taso=2 THEN PERULAUTATILANNE(alkuind)
              ELSE PERULAUTATILANNE(pelipuu^.ylataso^.ylataso^.siirrot^.ind);
  END;
END;
BEGIN { purapuuta }
 IF taso=maxtaso THEN
                   BEGIN
                     WHILE pelipuu^.siirrot<>NIL DO POISTASOLMU;
                     PERULAUTATILANNE(pelipuu^.ylataso^.ylataso^.siirrot^.ind);
                     NOUSETASOLTAYLOS;
                     IF pelipuu^.siirrot<>NIL THEN
                          MUUTALAUTATILANNE(pelipuu^.siirrot^.ind);
                     pojat:=pelipuu^.siirrot;
                   END
 ELSE
   BEGIN
     IF pelipuu^.siirrot=NIL THEN
        WHILE (pelipuu^.siirrot=NIL)AND(taso>1) DO NOUSETASOLTAYLOS
     ELSE BEGIN
            POISTASOLMU;
            IF taso=2 THEN PERULAUTATILANNE(alkuind)
            ELSE PERULAUTATILANNE(pelipuu^.ylataso^.ylataso^.siirrot^.ind);
          END;
     pojat:=pelipuu^.siirrot;
     IF taso<>1 THEN IF pojat<>NIL
                        THEN MUUTALAUTATILANNE(pelipuu^.siirrot^.ind);
   END;
END;
BEGIN { konesiirtaa }
	write('Odota. Mietin.');
     taso:=1;
     IF konesarakkeittain THEN alkuind:=tahtirivi
                          ELSE alkuind:=tahtisara;
     UUSITASOSOLMU(pelipuu);
     UUSISOLMU(pojat);
     pojat^.arvo:=koneenlaatat-pelaajanlaatat;
     IF konesarakkeittain THEN pojat^.ind:=tahtisara
                          ELSE pojat^.ind:=tahtirivi;
     pelipuu^.siirrot:=pojat;
     pelipuu^.parasarvo:=MAXINT;
     RAKENNASEURAAVATASO;
     IF pojat<>NIL THEN
        BEGIN

          IF pojat^.oikveli=NIL THEN parasind:=pojat^.ind
          ELSE
            WHILE taso>1 DO
                BEGIN
                  WHILE (pojat<>NIL)AND(taso<maxtaso) DO
                     RAKENNASEURAAVATASO;
                  PURAPUUTA;
                END;  {poistatähti}
	          pelilauta[edtahtirivi,edtahtisara]:=tyhja;

	          TUHOATASOSOLMU(pelipuu);
	          taso:=0;

	          MUUTALAUTATILANNE(parasind);

	          pelilauta[tahtirivi,tahtisara]:=tahti;
	          koneenlaatat:=koneenlaatat+alkutilanne[tahtirivi,tahtisara];
	          koneenvuoro:=FALSE;
	          tahtisara:= parasind;
        END ELSE BEGIN
            pelipaattyi:=TRUE;
            koneyht:=koneyht-alkutilanne[tahtirivi,tahtisara];{bugin korjaus}
        END;


     koneyht:=koneyht+alkutilanne[tahtirivi,tahtisara];
END;

FUNCTION laattakelpaa(ri,sa:indtype):BOOLEAN;
BEGIN
    laattakelpaa:=(konesarakkeittain AND (ri=tahtirivi)) OR (NOT(konesarakkeittain) AND (sa=tahtisara));
END;
PROCEDURE PIIRRA;
Var r,s:Integer;
BEGIN
	ClrScr;
	WRITELN('Ota numero joltain riviltä, siltä sarakkeelta millä #### laatta on.');
  	WRITELN('Paina numeronäppäimiä 1-9 valitaksesi rivin. Kone valitsee sitten numeron joltain');
  	WRITELN('sarakkeelta.');
	WRITE(' ':7);
	FOR s:=1 TO maxind DO BEGIN
		write(s:6);
	END;
	WRITELN();
	WRITE(' ':7);
	FOR s:=1 TO maxind DO BEGIN
		write('______');
	END;
	WRITELN();
  	FOR r:=1 TO maxind DO BEGIN
  		WRITE (r:5,'!':2);
      	FOR s:=1 TO maxind DO
          	BEGIN
	          	CASE pelilauta[r,s] of
	          		tahti: BEGIN
	          			WRITE('####':6);
	          			END;
	          		tyhja:  WRITE (' ':6);
	          	ELSE
	          		WRITE(pelilauta[r,s]:6);
	            END;
          	END;
           WRITELN();WRITELN('!':7);
    END;
    WRITELN('Koneen pisteet: ', koneyht, ' Pelaajan pisteet: ',pelayht);
END;

PROCEDURE PELIVALMISTELUT;
VAR ri,sa:indtype;
PROCEDURE ASETAALKUTILANNE;
VAR ri,sa:Integer;
BEGIN
  FOR ri:=1 TO maxind DO
      FOR sa:=1 TO maxind DO
          BEGIN
            alkutilanne[ri,sa]:=pelilauta[ri,sa];
            IF alkutilanne[ri,sa]=tahti THEN BEGIN tahtirivi:=ri;
                                               tahtisara:=sa;
                                             END;
          END;
END;
PROCEDURE ASETAPELITILANNE;
VAR ri,sa:Integer;
BEGIN
  FOR ri:=1 TO maxind DO
      FOR sa:=1 TO maxind DO
          BEGIN
            pelilauta[ri,sa]:=alkutilanne[ri,sa];
            IF pelilauta[ri,sa]=tahti THEN BEGIN tahtirivi:=ri;
                                               tahtisara:=sa;
                                             END;
          END;
END;

PROCEDURE ARVOLAATATJAPAIKAT;
VAR r,s :indtype;
    ran :Integer;
BEGIN
	Randomize;
  FOR r:=1 TO maxind DO
    FOR s:=1 TO maxind DO
      BEGIN
        ran:=Random(30)-15;
        pelilauta[r,s]:=ran;
        alkutilanne[r,s]:=ran;
      END;
  tahtirivi:=Random(8)+1;
  tahtisara:=Random(8)+1;
  pelilauta[tahtirivi,tahtisara]:=tahti;
  alkutilanne[tahtirivi,tahtisara]:=tahti;
END;

BEGIN { pelivalmistelut }
  pelipaattyi:=FALSE;
  FOR ri:=1 TO maxind DO FOR sa:=1 TO maxind DO pelilauta[ri,sa]:=tyhja;
  koneenlaatat:=0;
  pelaajanlaatat:=0;
  ARVOLAATATJAPAIKAT;
  koneyht:=0;
  pelayht:=0;
END;
PROCEDURE LUENAPPAINPAINALLUS;
VAR laatta :INTEGER;
	ch    : char;
	nappainok: BOOLEAN;
	ri,sa:Indtype;
PROCEDURE TARKISTAVIELA;
BEGIN
    laatta:=pelilauta[ri,sa];
    CASE laatta OF
        tahti : writeln('Et voi valita tähteä!');
        tyhja : writeln('Et voi valita tyhjää kohtaa!');
        ELSE
            BEGIN
                pelaajanlaatat:=pelaajanlaatat+pelilauta[ri,sa];
                pelilauta[tahtirivi,tahtisara]:=tyhja;
                edtahtirivi:=tahtirivi;
                edtahtisara:=tahtisara;
                tahtirivi:=ri;
                {tahtisara:=sa;}
                pelilauta[ri,sa]:=tahti;
                koneenvuoro:=TRUE;


				nappainok:=TRUE;
                pelayht:=pelayht+laatta;
            END;
    END;

END;

BEGIN   { LUENAPPAINPAINALLUS }
	sa:=tahtisara;
	nappainok:=FALSE;
	REPEAT
		ch:=ReadKey;
		CASE (ch) of
			#49 : ri:=1;
			#50 : ri:=2;
			#51 : ri:=3;
			#52 : ri:=4;
			#53 : ri:=5;
			#54 : ri:=6;
			#55 : ri:=7;
			#56 : ri:=8;
			#57 : ri:=9;
			#27 : quit:=true;
		ELSE
			WRITELN('Paina numeronäppäimiä 1 - 9.');
		END;
		TARKISTAVIELA;
	UNTIL nappainok;
END;
PROCEDURE ASETAALKUTILANNE;
VAR ri,sa:Integer;
BEGIN
  FOR ri:=1 TO maxind DO
      FOR sa:=1 TO maxind DO
          BEGIN
            alkutilanne[ri,sa]:=pelilauta[ri,sa];
            IF alkutilanne[ri,sa]=tahti THEN BEGIN tahtirivi:=ri;
                                               tahtisara:=sa;
                                             END;
          END;
END;
PROCEDURE ALKUVALMISTELUT;
VAR ri,sa:Integer;
BEGIN
  koneenvuoro:=FALSE;      pelipaattyi:=FALSE;    konesarakkeittain:=FALSE;
  maxtaso:=10;
  kayttamattomat:=NIL;    kayttamattsolmut:=NIL;
  edtahtirivi:=tahtirivi; edtahtisara:=tahtisara;

  FOR ri:=1 TO maxind DO FOR sa:=1 TO maxind DO
      BEGIN alkutilanne[ri,sa]:=tyhja; pelilauta[ri,sa]:=tyhja; END;
END;
BEGIN {pääohjelma}
    ALKUVALMISTELUT;
    REPEAT
        PELIVALMISTELUT;
        PIIRRA;
        REPEAT
            IF koneenvuoro THEN BEGIN
            	KONESIIRTAA;
	            {tutkitaan onko koneen siirron jälkeen enää mahdollista valita}
	            oletus:= true; {oletetaan, että peli päättyy}
	            ind:=1;
				REPEAT
					BEGIN
						IF ((pelilauta[ind,tahtisara] >= -15) AND (pelilauta[ind,tahtisara] <= 15)) THEN BEGIN
							oletus:=FALSE;
							WRITELN (oletus);
							WRITE (pelilauta[ind,tahtisara], '  ');
						END;
						ind:=ind+1;
					END;
				UNTIL (ind > maxind) OR (oletus = FALSE);
				IF oletus=TRUE THEN pelipaattyi:=TRUE;
            END;
            piirra;
            IF (NOT koneenvuoro) THEN BEGIN
                IF NOT pelipaattyi THEN BEGIN
                	LUENAPPAINPAINALLUS;
                END;
            END;
          UNTIL pelipaattyi OR quit;

         IF pelipaattyi THEN BEGIN
            IF (pelaajanlaatat>koneenlaatat) THEN BEGIN
            	WRITELN('Onneksi olkoon! Voitit!!');
            END;
            IF (pelaajanlaatat=koneenlaatat) THEN BEGIN
            	WRITELN('Wau! Tasapeli. Se ei kuitenkaan riitä 10 euron saamiseen :(');
            END;
            IF (pelaajanlaatat<koneenlaatat) THEN BEGIN
            	writeln('Hah hah. Hävisit taas!');
            END;
            WRITELN('Paina jotain näppäintä aloittaaksesi uuden pelin');
            odotus:=ReadKey;
         END;

    UNTIL quit;
END.

Metabolix [26.06.2022 23:18:15]

#

Onpa kiva, että joku koodaa perinteisellä Pascalilla.

Linuxin käyttäjille tiedoksi, että ohjelma toimii wineconsole-komennolla mutta ei pelkällä wine-komennolla.

Huijasin ja tein tekoälyn, joka laskee 10 siirtoa. Tein JavaScriptilla, ja siitä tuli ihan hävyttömän hidas tuohon ohjelmaan verrattuna, mutta voitin kuitenkin. Ohjelmasi ilmeisesti aavisti huijauksen, koska ohjelman mukaan voitin vain 5 euroa.

Peli on vaikeampi kuin voisi kuvitella: hakusyvyyden lisäys antaa nopeasti parempia tuloksia ja näköjään hyödyt voivat tulla ilmi yllättävän monen vuoron jälkeen.

PetriKeckman [26.06.2022 23:38:44]

#

Oot kyllä taitava! Kadehdin. Siis kun osasit Javascriptilla ohjelmoida ja nopeasti. Itselläni ei ole hajuakaan kuinka Javascriptillä ohjelmoitaisiin dynaamisia muuttujia, joita pelipuun rakentamiseen tarvitaan. Joo, tuo 5 euroa oli "bugi", mikä jäi ohjelmaan :)

Pascal oli aikoinaan opetuskieli kun opiskelin HY:ssa tietojenkäsittelyoppia - en ole valmistunut :( Opinnot jäivät kesken. En itsekään ole pitkään aikaan Pascalilla ohjelmoinnut, mutta kiva oli verestää muistoja.

Ja peli on tosiaan vaikea. Ohjelma pyrkii tietysti ajamaan pelaajan "nurkkaan", missä se ei pysty valitsemaan kuin pieniä lukuja ja onnistuu siinä hyvin.

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Tietoa sivustosta