0-1 problém batohu – Pascal – Fórum – Programujte.com

Naprogramujte 0-1 batoh. Definícia. 0-1 problém batohu.
Nech je daných n prirodzených čísel cj, a prir. číslo K. Existuje S ⊂ {1,...,n} taká, že
Σ cj = K ?
jεS

 

program problem; 

uses crt; 

var cj:array [1..100] of integer; 



    k, sucet,n,i:integer; 







begin 

clrscr; 

randomize; 

sucet:=0; 

writeln('zadaj prirodzene cislo k:'); 

readln(k); 

writeln('zadaj pocet prvkov:'); 

readln(n); 

writeln('zadaj prvky pola:'); 

for i:=1 to n do 

begin 

cj[i]:=random(100); 

write(cj[i],' '); 

writeln; 

end; 



for i:=1 to n do 

sucet:=sucet+cj[i]; 

writeln('sucet je:', sucet); 



if (k>=sucet) then 

writeln('existuje podmnozina') 

else writeln('neexistuje podmnozina'); 

readln; 

end. 

Mas zle to, ze ti to vubec nic nedela. Treba zacni vyhozenim toho randomu. Potom by bylo dobre napsat ten algoritmus a vlozit ho tam. Pak se muzem bavit o tom co je zle.

Naprogramujte 0-1 batoh. Definícia. 0-1 problém batohu. Opravil som to. Prosim Vas ak bude nieco zle tak mi opravte.

 

program Batoh; 

uses crt; 

type predmet = record 

       vaha : integer; 

       vbatohu : boolean; 

     end; 

var s, vaha, soucet : integer; 

    n, j : byte; 

    predmety : array[1..20] of predmet; 



function Iterace(level, maxlevel, hranice : byte) : boolean; 

 var i : byte; 

     check : boolean; 

 begin 

   check := false; 

   if (level <= maxlevel) and (hranice <= 20) then 

     begin 

       i := hranice; 

       while (check = false) and (i<=20) do 

         begin 

           soucet := soucet + predmety[i].vaha; 

           predmety[i].vbatohu := true; 

           if (soucet = s) then 

              check := true 

           else if (soucet < s) and (level < maxlevel) then 

              check := Iterace(level+1, maxlevel, i+1); 

           if (check = false) then 

             begin 

               soucet := soucet - predmety[i].vaha; 

               predmety[i].vbatohu := false; 

               i := i + 1; 

             end; 

         end; 

     end; 

   Iterace := check; 

 end; 



begin 

readln(s); 

read(n); 

for j:=1 to n do 

  begin 

    read(vaha); 

    predmety[j].vaha := vaha; 

    predmety[j].vbatohu := false; 

  end; 

soucet := 0; 



j := 1; 

while (j <= 20) and (Iterace(1,j,1) = false) do 

 j := j + 1; 

if (j=21) then 

   write('NELZE') 

else 

   begin 

     for j:=1 to n do 

        if (predmety[j].vbatohu = true) then 

           write(predmety[j].vaha, ' '); 

   end; 

readkey; 

end.