Ferramentas de Usuário

Ferramentas de Site


dev_geral:pascal:pronto-a-usar:aposta_euromilhoes

Apostas no Euromilhões

Versão 1 - utilização de Arrays

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 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.

Enjoy :-D

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.

Versão 2 - utilização exclusiva de Sets (conjuntos)

Nesta versão apenas utilizo Sets para realizar as apostas. É uma versão muito melhor em relação à anterior, mesmo em termos de estruturação.

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.

Por thoga31.

dev_geral/pascal/pronto-a-usar/aposta_euromilhoes.txt · Última modificação em: 2018/05/14 21:37 (edição externa)