Dze je subor www.TrSek.com/pas/terc.pas

{ TERC.PAS                  Copyright (c) TrSek alias Zdeno Sekerak }
{ Akymi kombinaciami zasahov sa da dosiahnut definovany pocet bodov }
{ Urcite vsetky vektory P ( P[1] .. P[M] ) poctov zasahov do        }
{ medzikruzia. Vytvorte program, ktorì vypise vsetky mozne riesenia }
{ a ich pocet (0, 1, 2, ).                                         }
{                                                                   }
{ Zadanie:                                                          }
{  - Pocet medzikruzi v terci M                                     }
{  - Bodove hodnoty jednotlivych medzikruzi B[1] .. B[M]            }
{  - Celkovy pocet vystrelov V                                      }
{  - Celkovy pocet nastrielanych bodov v terci Z                    }
{                                                                   }
{ Datum:14.11.2004                             http://www.trsek.com }

program terc;
uses crt,dos;
const MAX_M=20;         { maximalny pocet vystrelov }

var m:integer;          { pocet medzikruzi }
    v:integer;          { pocet vystrelov  }
    z:integer;          { celkovy pocet nastrielanych bodov }
    i:integer;          { pomocna premenna }
    poc:integer;        { pocet rieseni }

    { tieto 2 polia su zaroven globalnymi polami }
    { do pola vv si odovzdavaju jednotlive funkcie vygenerovane hodnoty }
    b:array [1..MAX_M] of integer;      { hodnoty medzikruzi }
    vv:array [1..MAX_M] of integer;     { vektor riesenia }

{ skolonovanie slova riesenie, slovencina moja }
function Sklon(poc:integer):string;
begin
case poc of
  1: Sklon:='riesenie';
  2: Sklon:='riesenia';
  3: Sklon:='riesenia';
  4: Sklon:='riesenia';
else
     Sklon:='rieseni';
end;
end;

{ funkcia zisti celkovy pocet vystrelov }
function PocetVystr(m:integer):integer;
var poc:integer;
begin
  poc:=0;

  for i:=1 to m do
    poc:=poc+ vv[i];

  PocetVystr:=poc;
end;

{ najtazsia cast programu }
{ bude generovat jednotlive kombinacie zasahov }
{ POSTUP: }
{ -najdem od zadu posledne cislo vo vektore, ktore nema nulu }
{ -od tohoto cisla odpocitam 1                               }
{ -pole za tymto cislom dopocitam do poctu vystrelov v       }
{ -ak vsetky maju nulu koncim                                }
function DalsiVektor(m,v:integer):boolean;
var i:integer;
begin
  vv[m]:=0;

  { najprv najdem od zadu posledne ktore nema nulu }
  i:=m-1;
  while((i>1) and (vv[i]=0)) do
    i:=i-1;

  { je koniec? }
  if((i=1) and (vv[i]=0))then
   begin
     DalsiVektor:=false;
   end
  else
   begin
    { od tohoto cisla odpocitam 1 }
    vv[i]:=vv[i]-1;

    { dopocitam cislo }
    vv[i+1]:=v-PocetVystr(m-1);
    DalsiVektor:=true;
   end;
end;

{ funkcia zisti kolko ma vektor bodov }
function PocetBodov(m:integer):integer;
var i:integer;
    vys:integer;
begin
  vys:=0;

  for i:=1 to m do
    vys:=vys+ vv[i]*b[i];

  PocetBodov:=vys;
end;

{ vypise pozadovany vektor }
procedure VypisVektor(m:integer);
var i:integer;
begin
  Write('(');

  for i:=1 to m do
  begin
    if (i=m) then
      Write(vv[i],')')
    else
      Write(vv[i],',');
  end;
  WriteLn;
end;

BEGIN
  { uvod }
  ClrScr;
  WriteLn('Program na zistenie kombinacii zasahov pre dosiahnutie poctu bodov.');
  WriteLn;

  { zistenie pociatocnych hodnot }
  Write('Zadaj pocet medzikruzi v terci (max=', MAX_M, '):');
  ReadLn(m);

  for i:=1 to m do begin
    Write('Zadaj hodnotu medzikruzia B[',i,']=');
    ReadLn(b[i]);
  end;

  WriteLn;
  Write('Zadaj celkovy pocet vystrelov:');
  ReadLn(v);

  Write('Zadaj pozadovany pocet nastrielanych bodov:');
  ReadLn(z);
  {m:=4; b[1]:=2; b[2]:=5; b[3]:=7; b[4]:=8; v:=5; z:=27;}

  { nastavim default hodnoty - znulujem }
  for i:=1 to MAX_M do vv[i]:=0;
  vv[1]:=v;           { pocet vystrelov dam do prveho pola }
  poc:=0;

  { zacneme riesit ulohu }
  WriteLn;

  while( DalsiVektor(m,v)) do
  begin
    { kontrola vektora - pocet bodov OK }
    if( PocetBodov(m)=z )then
      begin
        inc(poc);
        Write('Riesenie ',poc:2,': ');
        VypisVektor(m);
      end;
  end;

  { zhodnoti kolko nasiel rieseni }
  if( poc=0 )then
    WriteLn('Pre zadane hodnoty neexistuje ziadne riesenie.')
  else
    WriteLn('Celkovo ', poc, ' ', Sklon(poc));

END.

Copyrigth by Zdeno Sekerak 2007, http://www.trsek.com