Muistoja vuodelta 1986, jolloin suoritin Pascalin peruskurssin labratyönä pasianssin simuloinnin. Löysin haalistuneen ja repaleisen ohjelmalistauksen. Jätin tästä versiosta kommentit pois ja poistin koodia, kun alkuperäisessä versiossa oli mahdollista syöttää kortit, nyt ne arvotaan, samasta syystä myös lisäsin koodia.
https://petke.info/paha.exe (Windows)
Pasianssin asetelma:
Pakasta poimitaan ässät ja asetetaan peruskorteiksi riviin kuvapuoli ylöspäin. Peruskorttien alapuolelle asetetaan kahdeksan korttia apuriviin kuvapuolet ylöspäin. Näiden korttien oikealle puolelle asetetaan kahdeksan korttia piilopinoon kuvapuoli alaspäin. Loput korteista jäävät käsipakaksi.
Pelin tavoite:
Pyrittävä rakentamaan peruspakkoihin ylöspäin maata noudattaen.
Pelin kulku:
Apurivistä nostetaan kortteja peruspakkoihin aina kun se on mahdollista.
Jos piilopinossa on kortteja jäljellä, täytetään sieltä apuriviin syntyneet tyhjät kohdat. Jos siirtoja ei voi tehdä, katsotaan käykä näkyvän käsipakan päälimmäisin kortti peruspakkaan. Jos näkyvän käsipakan kortti käy peruspakkaan saa sen ala paljastuvaa korttia yrittää.
Apuriviin syntyviä aukkoja ei saa täyttää käsipakan korteilla (vaikka piilopino olisi loppunut).
Käsipakan saa käydä läpi enintään viisi kertaa.
Simuloinnin tuotoksena sain arvion, että pasianssin läpimeno todennäköisyys on noin 20 prosenttia.
program pahaakkapasiassi;
CONST maxlapikaynti=5;
maxarvo=15;
TYPE arvot=1..maxarvo;
maat=1..4;
korttiosoitin=^kortti;
kortti=RECORD
maa: maat;
arvo: arvot;
seur: korttiosoitin;
END;
maachr=PACKED ARRAY[1..6] OF CHAR;
VAR pakka,
kasipakka,
nakyvakasipakka,
piilopino,
kayttamattomat: korttiosoitin;
peruspakka: ARRAY[1..4] OF korttiosoitin;
apurivi: ARRAY[1..8] OF korttiosoitin;
maatchr: ARRAY[1..4] OF maachr;
lapikayntikerta: 1..maxlapikaynti;
pelataan: BOOLEAN;
maxlkm: INTEGER;
vastaus: char;
pasiansseja,
lapimenoja,
pros: Double;
FUNCTION ontyhja(osoitin: korttiosoitin): BOOLEAN;
BEGIN
ontyhja:=(osoitin=NIL);
END;
PROCEDURE siirrakortti(VAR otto,laitto: korttiosoitin);
VAR apu: korttiosoitin;
BEGIN
IF NOT ontyhja(otto) THEN
BEGIN
apu:=otto;
otto:=otto^.seur;
apu^.seur:=laitto;
laitto:=apu;
END;
END;
FUNCTION kayperuspakkaan(card: korttiosoitin):BOOLEAN;
BEGIN
IF ontyhja(card) THEN kayperuspakkaan:=FALSE
ELSE kayperuspakkaan:=card^.arvo=peruspakka[card^.maa]^.arvo+1;
END;
PROCEDURE tulostakortit;
VAR i: Integer;
BEGIN;
WRITE('Peruspakat:');
FOR i:=1 TO 4 DO
BEGIN
WRITELN(i);
WITH peruspakka[i]^ DO
BEGIN
WRITE(maatchr[2]:4,maa:4);
WRITE(maatchr[maa]:7, arvo:3,' ');
END;
END;
WRITE('Nakyvakasipakka:');
IF NOT ontyhja(nakyvakasipakka) THEN
WITH nakyvakasipakka^ DO
WRITELN(maatchr[maa]:7,arvo:3,' ')
ELSE
WRITELN('');
WRITELN('Apurivi:');
FOR i:=1 TO 8 DO
IF NOT ontyhja(apurivi[i]) THEN
WITH apurivi[i]^ DO
WRITE(maatchr[maa]:7, arvo:3,' ');
END;
FUNCTION rivistakay(VAR rivi: Integer): BOOLEAN;
VAR r: Integer;
kay: BOOLEAN;
BEGIN
r:=0;
REPEAT
r:=r+1;
UNTIL kayperuspakkaan(apurivi[r]) OR (r>=8);
IF kayperuspakkaan(apurivi[r]) THEN rivi:=r;
rivistakay:=kayperuspakkaan(apurivi[r]);
END;
PROCEDURE kasitteleapurivia;
VAR i: Integer;
BEGIN
WHILE rivistakay(i) DO
BEGIN
WITH apurivi[i]^DO
BEGIN
IF vastaus='t' THEN WRITE('Nostetaan apurivista', maatchr[maa]:7,arvo:3,' peruspakkaan.');
siirrakortti(apurivi[i], peruspakka[maa]);
END;
IF NOT ontyhja(piilopino) THEN
WITH piilopino^ DO
BEGIN
IF vastaus='t' THEN WRITELN('...ja piilopinosta', maatchr[maa]:7, arvo:4,' tilalle.');
siirrakortti(piilopino,apurivi[i]);
END;
IF vastaus='t' THEN tulostakortit;
END;
END;
FUNCTION lapimeni: BOOLEAN;
VAR paknro,
valmiit: Integer;
BEGIN
valmiit:=0;
FOR paknro:=1 TO 4 DO
IF peruspakka[paknro]^.arvo=maxarvo THEN
valmiit:=valmiit+1;
lapimeni:=(valmiit=4);
END;
FUNCTION liikaaselattu:BOOLEAN;
VAR dum: Integer;
BEGIN
liikaaselattu:=(lapikayntikerta=maxlapikaynti)
AND ontyhja(kasipakka)
AND NOT kayperuspakkaan(nakyvakasipakka)
AND NOT rivistakay(dum)
AND NOT lapimeni;
END;
FUNCTION korttipiilopinossa: BOOLEAN;
VAR piilossalkm: Integer;
piilokortit: korttiosoitin;
BEGIN
piilossalkm:=0;
piilokortit:=piilopino;
WHILE NOT ontyhja(piilokortit) DO
BEGIN
IF kayperuspakkaan(piilokortit) THEN
piilossalkm:=piilossalkm+1;
piilokortit:=piilokortit^.seur;
END;
korttipiilopinossa:=(piilossalkm=4);
END;
PROCEDURE katsonakyvaakasipakkaa;
PROCEDURE nostakasipakastaperuspakkaan;
BEGIN
WHILE kayperuspakkaan(nakyvakasipakka) DO
WITH nakyvakasipakka^DO
BEGIN
IF vastaus='t' THEN WRITELN('Nostetaan kasipakasta',maatchr[maa]:7, arvo:3,' peruspakkaan');
siirrakortti(nakyvakasipakka, peruspakka[maa]);
IF vastaus='t' THEN tulostakortit;
END;
END;
PROCEDURE selaakasipakkaa;
BEGIN
IF NOT ontyhja(kasipakka) THEN
BEGIN
IF vastaus='t' THEN WRITELN('Selataan kasipakkaa, kasipakasta kaannettiin: ');
REPEAT
siirrakortti(kasipakka, nakyvakasipakka);
WITH nakyvakasipakka^ DO
IF vastaus='t' THEN WRITE(maatchr[maa]:7, arvo:3)
UNTIL kayperuspakkaan(nakyvakasipakka) OR ontyhja(kasipakka);
END;
END;
BEGIN
IF kayperuspakkaan(nakyvakasipakka) THEN
nostakasipakastaperuspakkaan
ELSE
IF NOT lapimeni THEN
BEGIN
selaakasipakkaa;
IF kayperuspakkaan(nakyvakasipakka) THEN
nostakasipakastaperuspakkaan
ELSE
IF NOT liikaaselattu THEN
BEGIN
lapikayntikerta:=lapikayntikerta+1;
IF vastaus='t' THEN WRITELN('Kasipakan selauksessa alkaa', lapikayntikerta,'.s','kierros.');
WHILE NOT ontyhja(nakyvakasipakka) DO
siirrakortti(nakyvakasipakka, kasipakka);
END;
END;
END;
PROCEDURE alkuasetukset;
VAR i: Integer;
BEGIN
FOR i:=1 TO 4 DO peruspakka[i]:=NIL;
FOR i:=1 TO 8 DO apurivi[i]:=NIL;
pakka:=NIL; kasipakka:=NIL; nakyvakasipakka:=NIL;
kayttamattomat:=NIL;
piilopino:=NIL;
maxlkm:=4*(maxarvo-1);
maatchr[1]:='hertta';
maatchr[2]:='ruutu';
maatchr[3]:='risti';
maatchr[4]:='pata';
pelataan:=TRUE;
pasiansseja:=0;
lapimenoja:=0;
END;
PROCEDURE uusisolmu(VAR os: korttiosoitin);
BEGIN
IF ontyhja(kayttamattomat) THEN new(os)
ELSE
BEGIN
os:=kayttamattomat;
kayttamattomat:=kayttamattomat^.seur;
os^.seur:=NIL;
END;
END;
PROCEDURE jaapakka;
VAR i:Integer;
BEGIN
FOR i:=1 TO 4 DO
BEGIN
uusisolmu(peruspakka[i]);
WITH peruspakka[i]^DO
BEGIN
arvo:=1;
maa:=i;
END;
END;
FOR i:=1 TO 8 DO
siirrakortti(pakka, apurivi[i]);
FOR i:=1 TO 8 DO
siirrakortti(pakka, piilopino);
kasipakka:=pakka;
pakka:=NIL;
END;
PROCEDURE kaannapino(VAR pino: korttiosoitin);
VAR apupino: korttiosoitin;
BEGIN
apupino:=NIL;
WHILE NOT ontyhja(pino) DO siirrakortti(pino, apupino);
pino:=apupino;
END;
PROCEDURE sekoitapakka;
VAR m: maat;
a: arvot;
vaihtoapu,
arpo,
ind,
luku: Integer;
arpopakka: ARRAY[1..100] OF Integer;
card: korttiosoitin;
BEGIN
Randomize;
FOR ind:=1 TO maxlkm DO arpopakka[ind]:=ind;
FOR ind:=1 TO maxlkm DO
BEGIN
arpo:=RANDOM(maxlkm)+1;
vaihtoapu:=arpopakka[ind];
arpopakka[ind]:=arpopakka[arpo];
arpopakka[arpo]:=vaihtoapu;
END;
IF vastaus='t' THEN WRITELN('Arpomasi pakka paalimmaisesta kortista lahtien:');
FOR ind:=1 TO maxlkm DO
BEGIN
luku:=arpopakka[ind];
m:=(luku-1) DIV (maxarvo-1)+1;
a:=luku-(maxarvo-1)*(m-1)+1;
IF vastaus='t' THEN WRITELN(ind:3,':',maatchr[m]:8, a:3);
uusisolmu(card);
card^.maa:=m;
card^.arvo:=a;
card^.seur:=NIL;
siirrakortti(card, pakka);
END;
kaannapino(pakka);
IF vastaus='t' THEN WRITELN('Jaan kortit poytaan niin aloitetaan peli');
END;
PROCEDURE luesyottoaineistoa;
BEGIN //LUESYOTTOAINEISTOA
WRITELN('Syota "t", jos haluat tulostaa pasianssipelin vaiheet.');
WRITE('Syota "s", jos haluat vain simuloida tilastollista tutkimusta varten ');
WRITELN(' ilman tulostusta. (pysayta ajo silloin painamalla CNTRL-C)');
WRITELN('Syota "l" jos haluat kokonaan lopettaa simuloinnin');
READLN(vastaus);
IF vastaus='l' THEN pelataan:=FALSE;
END;
PROCEDURE keraakortit;
VAR i: Integer;
BEGIN
FOR i:=1 TO 4 DO
WHILE NOT ontyhja(peruspakka[i]) DO
siirrakortti(peruspakka[i], kayttamattomat);
FOR i:=1 TO 8 DO
siirrakortti(apurivi[i], kayttamattomat);
WHILE NOT ontyhja(kasipakka) DO
siirrakortti(kasipakka, kayttamattomat);
WHILE NOT ontyhja(nakyvakasipakka) DO
siirrakortti(nakyvakasipakka, kayttamattomat);
WHILE NOT ontyhja(piilopino) DO
siirrakortti(piilopino, kayttamattomat);
END;
BEGIN
alkuasetukset;
luesyottoaineistoa;
WHILE pelataan DO
BEGIN
sekoitapakka;
jaapakka;
lapikayntikerta:=1;
IF vastaus='t' THEN tulostakortit;
REPEAT
kasitteleapurivia;
katsonakyvaakasipakkaa;
UNTIL (liikaaselattu OR lapimeni OR korttipiilopinossa);
pasiansseja:=pasiansseja+1;
pros:=100*lapimenoja/pasiansseja;
WRITELN(pros);
IF liikaaselattu THEN
BEGIN
if vastaus='t' THEN WRITELN('Kasipakkaa on selattu liikaa. Pasianssi ei mennyt lapi.');
END
ELSE IF lapimeni THEN
BEGIN
IF vastaus='t' THEN WRITELN('Pasianssi meni lapi! :)');
lapimenoja:=lapimenoja+1;
END
ELSE BEGIN
IF vastaus='t' THEN WRITELN('Ei kannata jatkaa. Kaikki seuraavaksi peruspakkaan kayvat kortit ovat piilopinossa.');
END;
keraakortit;
IF vastaus<>'s' THEN luesyottoaineistoa;
END;
END.Aihe on jo aika vanha, joten et voi enää vastata siihen.