[Snippet] Apostas no EuroMilhões

[thoga31]

Este é um pequeno programa que pede ao utilizador para introduzir a sua aposta no EuroMilhoes e depois verifica que acertou a chave gerada aleatoriamente ou não...

Decidi fazer isto na sequência de um tópico muito recente e que me fez pensar: "Com esta brincadeira posso abordar muitas ferramentas do Pascal!"

E assim foi. Uma lista de coisas que utilizei, algumas das quais muitos acham ainda que o Pascal não suporta:

• Arrays contantes;
  
• Arrays de arrays;
  
• Inicialização de variáveis na sua declaração, incluindo de Records;
  
• Declaração do tipo Array no próprio procedimento/função;
  
• O ciclo for in;
  
• O método break.
  

O mais interessante, a meu ver, é a técnica de programação que utilizei. Quem pensa num programa do EuroMilhões não costuma pensar na criação dos métodos que eu, por exemplo, criei. E ainda poderia ter estruturado isto melhor. Ainda o faço amanhã 😛

Enjoy!

program euromilhoes;

type TCaso = array[1..2] of integer;

const MAXNUMERO  = 5;
     MAXESTRELA = 2;
     PREMIOS = 12;
     CASOS : array[1..PREMIOS] of TCaso = ((5,2), (5,1), (5,0), (4,2), (4,1), (4,0), (3,2), (2,2), (3,1), (3,0), (1,2), (2,1));

type TNums = array[1..MAXNUMERO] of integer;
    TEstr = array[1..MAXESTRELA] of integer;
    TEuro = record
       estrelas : TEstr;
       numeros  : TNums;
    end;
    TLim = set of byte;

var aposta : TEuro = (estrelas:(0,0); numeros:(0,0,0,0,0));
   sorteio : TEuro = (estrelas:(0,0); numeros:(0,0,0,0,0));
   certas : record
      estrelas, numeros : integer;
   end = (estrelas:0; numeros:0);
   i : integer;
   ganhou : boolean = false;


function InArray(value : integer; arr : array of integer) : boolean;
(* Verifica se "value" é um dos elementos de "arr" *)
var elem : integer;
begin
   InArray := false;
   for elem in arr do
       if value = elem then begin
           InArray := true;
           break;
       end;
end;

function CountArray(value : integer; arr : array of integer) : integer;
(* Conta o nº de "value"'s que "arr" contém *)
var elem : integer;
   cnt : integer = 0;
begin
   for elem in arr do
       if value = elem then
           inc(cnt);
   CountArray := cnt;
end;

procedure readint(const msg : string; var v : integer; const lim : TLim; nottoinclude : array of integer);
(* Faz uma leitura controlada de uma variável "v" Integer *)
begin
   repeat
       write(msg);
       readln(v);
   until (v in lim) and not(InArray(v, nottoinclude));
end;

function Int2Str(num : integer) : string;
(* Converte um Integer numa String *)
begin
   Str(num, Int2Str);
end;


begin  (* Bloco principal *)
   // Aposta do utilizador
   writeln('APOSTA:');
   for i:=1 to MAXNUMERO do
       readint('   Introduza o ' + Int2Str(i) + 'o numero: ', aposta.numeros[i], [1..50], aposta.numeros);
   for i:=1 to MAXESTRELA do
       readint('   Introduza a ' + Int2Str(i) + 'a estrela: ', aposta.estrelas[i], [1..9], aposta.estrelas);

   // Sorteio
   writeln; writeln('SORTEIO:');
   write('   Numeros: ');
   randomize;
   for i:=1 to MAXNUMERO do begin
       repeat
           sorteio.numeros[i] := random(50) + 1;
       until CountArray(sorteio.numeros[i], sorteio.numeros) = 1;
       if InArray(sorteio.numeros[i], aposta.numeros) then inc(certas.numeros);
       write(sorteio.numeros[i], '  ');
   end;
   writeln; write('   Estrelas: ');
   randomize;
   for i:=1 to MAXESTRELA do begin
       repeat
           sorteio.estrelas[i] := random(9) + 1;
       until CountArray(sorteio.estrelas[i], sorteio.estrelas) = 1;
       if InArray(sorteio.estrelas[i], aposta.estrelas) then inc(certas.estrelas);
       write(sorteio.estrelas[i], '  ');
   end;

   // Resumo
   writeln; writeln; writeln('RESUMO: ');
   writeln('   Acertou em ', certas.numeros, ' dos 5 numeros.');
   writeln('   Acertou em ', certas.estrelas, ' das 2 estrelas.');

   // Prémios
   writeln; writeln('PREMIO:');
   for i:=1 to PREMIOS do
       if (casos[i][1] = certas.numeros) and (casos[i][2] = certas.estrelas) then begin
           write('   Ganhou o ', i, 'o premio!');
           ganhou := true;
           break;
       end;
   if not ganhou then write('Nao ganhou nenhum premio...');

   readln;
end.

[thoga31]

Proposta com uso exclusivo de Sets e melhor estruturado... Utilizei umas brincadeiras interessantes 😛

program euromilhoes2;
uses strutils;

type TSetOfByte = set of byte;
    TCaso = array[1..2] of integer;
    TEuro = record
       estrelas, numeros : TSetOfByte;
    end;
    TResultado = record
       estrelas, numeros : byte;
    end;

const NUMEROS  = 5;
     ESTRELAS = 2;
     MAXNUMS = 50;
     MAXESTR = 9;
     SETNUMS = [1..MAXNUMS];
     SETESTR = [1..MAXESTR];

var aposta  : TEuro = (estrelas:[]; numeros:[]);
   sorteio : TEuro = (estrelas:[]; numeros:[]);
   certas : TResultado = (estrelas:0; numeros:0);
   premio : byte = 0;


function Int2Str(num : integer) : string;
begin
   Str(num, Int2Str);
end;


procedure LerAposta(var s : TSetOfByte; const times : byte; const lim : TSetOfByte; const msg : string);
var i, ap : byte;
begin
   for i := 1 to times do begin
       repeat
           write(AnsiReplaceText(msg, '{ITER}', Int2Str(i)));
           readln(ap);
       until not(ap in s) and (ap in lim);
       s := s + [ap];
   end;
end;


procedure GerarChave(var s : TEuro; const verbose : boolean; const sep : string);

   procedure GC(var sob : TSetOfByte; const times, lim : byte);
   var i, aleat : byte;
   begin
       randomize;
       for i := 1 to times do begin
           repeat
               aleat := random(lim) + 1;
           until not(aleat in sob);
           sob := sob + [aleat];
           if verbose then write(aleat, sep);
       end;
   end;

begin
   GC(s.numeros, NUMEROS, MAXNUMS);
   if verbose then writeln;
   GC(s.estrelas, ESTRELAS, MAXESTR);
   if verbose then writeln;
end;


function Comparar(sFrom, sTo : TSetOfByte) : byte;
var elem : byte;
begin
   Comparar := 0;
   for elem in sFrom do
       if elem in sTo then
           inc(Comparar);
end;


function ObterPremio(res : TResultado) : byte;
const PREMIOS = 12;
     CASOS : array[1..PREMIOS] of TCaso = ((5,2), (5,1), (5,0), (4,2), (4,1), (4,0), (3,2), (2,2), (3,1), (3,0), (1,2), (2,1));
var i : byte;
begin
   ObterPremio := 0;
   for i:=1 to PREMIOS do
       if (CASOS[i][1] = res.numeros) and (CASOS[i][2] = res.estrelas) then begin
           ObterPremio := i;
           break;
       end;
end;


begin
   writeln('FACA A SUA APOSTA:');
   LerAposta(aposta.numeros, NUMEROS, SETNUMS, '   Introduza o {ITER}o numero: ');
   LerAposta(aposta.estrelas, ESTRELAS, SETESTR, '   Introduza a {ITER}a estrela: ');

   writeln; writeln('SORTEIO DA CHAVE: ');
   GerarChave(sorteio, TRUE, '  ');

   writeln; writeln('COMPARACAO:');
   certas.numeros := Comparar(sorteio.numeros, aposta.numeros);
   certas.estrelas := Comparar(sorteio.estrelas, aposta.estrelas);
   writeln('   Acertou em ', certas.numeros, ' dos ', NUMEROS, ' numeros.');
   writeln('   Acertou em ', certas.estrelas, ' das ', ESTRELAS, ' estrelas.');

   writeln; writeln('PREMIO ATRIBUIDO:');
   premio := ObterPremio(certas);
   if not boolean(premio) then
       writeln('   Nao ganhou nenhum premio...')
   else
       writeln('   Ganhou o ', premio, 'o premio!');

   readln;
end.

[StraightEdge]

Tentei compilar ambos para ver como ficava e deu erro. Será do compilador que uso (PZim)?

[thoga31]

Tentei compilar ambos para ver como ficava e deu erro. Será do compilador que uso (PZim)?

Sim. O PZim é uma miséria pegada que está a matar ainda mais a reputação do Pascal pelo Brasil e arredores.

Usa antes o Free Pascal Compiler (FPC) em conjunto com o Notepad++. Vê aqui como o podes fazer.