2 (*_________________________________________________________*)
\r
3 (* For a given sequence of integers A1, ...,An *)
\r
4 (* find a subsequence k1,k2,... ki such that *)
\r
5 (* SUM( 0<i<n+1 : Aki) = v *)
\r
6 (* (Take A(i) such that SUM(i:Ai)<250 and A(i)<100.) *)
\r
7 (*_________________________________________________________*)
\r
11 var level : integer;
\r
14 pref iiuwGRAPH block;
\r
16 unit dolej : procedure(kolor,ile:integer);
\r
20 for i := Level-1 downto Level-ile
\r
24 for j :=1 to 300 do j:=j od;
\r
29 unit odlej : procedure(ile: integer);
\r
33 for i := Level to Level+ile do
\r
36 for j := 1 to 300 do j:=j od;
\r
41 unit sac_a_dos : procedure(A:arrayof integer,v: integer);
\r
44 unit p : procedure(s,k : integer);
\r
52 if s+A(k)=v then raise trouve fi;
\r
54 for i := k+1 to upper(A) do call p(s,i) od;
\r
57 last_will : call MyWrite(k);
\r
58 call affich(inXpos,inYpos,", ");
\r
61 when trouve : call affich(10,300,"press any key");
\r
63 call affich(10,300,"RESULT:: ");
\r
69 for i := lower(A) to upper(A) do call p(0,i) od;
\r
70 call affich(10,315,"There is no such sequence !!! ");
\r
72 last_will : call affich(10,325,"END of EXECUTION");
\r
75 unit affich : procedure(x,y:integer,s:string);
\r
76 var TAB : arrayof char,i:integer;
\r
81 for i := lower(TAB) to upper(TAB) do
\r
83 call HASCII(ord(TAB(i)));
\r
87 unit inchar : function : integer;
\r
92 if i<>0 then exit fi;
\r
97 unit MyRead : function : integer;
\r
103 if OrdN=13 then exit fi;
\r
104 if (ordN<58 and ordN>47)
\r
108 result := result*10+ (OrdN - 48)
\r
110 if ordN=8 then result := result div 10;
\r
111 call move(inXpos-8,inYpos);call hascii(0);
\r
117 unit MyWrite : procedure( Number : integer );
\r
118 var i, j, n : integer,
\r
119 Chiffres:arrayof integer;
\r
121 array Chiffres dim(1:10);
\r
123 if Number=0 then n:=1; Chiffres(1):=0
\r
128 i := Number div 10;
\r
129 Chiffres(n) := Number - i*10;
\r
132 for i := n downto 1
\r
135 call Hascii(Chiffres(i)+48);
\r
140 unit dzban : procedure(x,y,z,v:integer);
\r
145 call move(y+6+j,x);
\r
146 call draw(y+6+j,x-v);
\r
148 call draw(z+j,x-v);
\r
150 for j :=y to z+10 do
\r
155 call move(y-5,x+10+j);
\r
156 call draw(z+15,x+10+j)
\r
160 var A : arrayof integer,
\r
164 call aFFich(150,15,"KNAPSACK PROBLEM");
\r
165 call affich(10,40,"Given a sequence A[1],...,A[n] of integers");
\r
166 call affich(10,55,"find a subsequence i1,...,ij of the indices ");
\r
167 call affich(10,70,"such that A[i1] +...+ A[ij] = v ");
\r
168 call affich(10,110,"n = ");
\r
170 call affich(10,130,"Elements of A :: ");
\r
176 call affich(inXpos,inYpos,", ")
\r
178 call affich(10,165,"v = ");
\r
181 call dzban( level,350,600,v);
\r
183 call sac_a_dos(A,v);
\r
196 (*_________________________________________________________*)
\r
197 (* Donnee un sequence des nombres entier a1, ... an . *)
\r
198 (* Trouver un sequence k1,k2,... ki tel que *)
\r
199 (* SOMME( 0<i<n+1 : aki) = v *)
\r
200 (* (wersja bez rysowania) *)
\r
201 (*_________________________________________________________*)
\r
203 unit sac_a_dos : procedure(A:arrayof integer,v: integer);
\r
206 unit p : procedure(s,k : integer);
\r
209 if s+ A(k)>v then return fi;
\r
210 if s+A(k)=v then raise trouve fi;
\r
212 for i := k+1 to upper(A) do call p(s,i) od;
\r
213 last_will : writeln(k);
\r
216 when trouve : writeln("RESULTAT :: ");
\r
221 for i := lower(A) to upper(A) do call p(0,i) od;
\r
222 writeln("il n'y a pas sequence i1,..ik tel que le somme est v ");
\r
224 last_will : writeln("Fin du sequence");
\r
227 var A: arrayof integer, v,i,n : integer;
\r
233 for i := 1 to n do read(A(i)) od;
\r
236 call sac_a_dos(A,v);
\r
237 writeln("et fin d'execution.");
\r
241 Dla danych 1 2 3 4 5 6 7 8 9 10, v=12
\r
242 Wynik : sequence : 6 3 2 1 ( w takiej wlasnie kolejnosci !)
\r
244 et fin d'execution.
\r
246 (* jezeli uzyje wind zamiast terminate to nawet gdy znajde rozwiazanie *)
\r
247 (* instrukcja for jest w tej procedurze kontynuowana az do konca, a potem *)
\r
248 (* wydrukuje sie " il n'ya pas sequence ...." *)
\r
249 (* czyli wind "zwija" obiekty az do tego w ktorym jest odpowiedni handler *)
\r
250 (* ale nie usuwa tego ostatniego (w przeciwienstwie do terminate) *)
\r
251 (* ten tekst jest drukowany w obu przypadkach i wind i terminate *)
\r
256 signal f(inout x,y : integer),g;
\r
257 unit ppass : procedure( inout x,y : integer);
\r
262 var x,y,z,s : integer;
\r
271 when f : if y=0 then raise g fi;
\r
280 write("to sie nie wydrukuje , bo wind zwija ten obiert bloku!");
\r
282 writeln("s= :" ,s);
\r