Jump to content
  • Revista PROGRAMAR: Já está disponível a edição #60 da revista programar. Faz já o download aqui!

thoga31

[Snippet] Apostas no EuroMilhões

Recommended Posts

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ã :P

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.

  • Vote 1

Knowledge is free!

Share this post


Link to post
Share on other sites
thoga31

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

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.


Knowledge is free!

Share this post


Link to post
Share on other sites
StraightEdge

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

Share this post


Link to post
Share on other sites
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.


Knowledge is free!

Share this post


Link to post
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now

×

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.