examples/apply/sacados.log

   1 program test;\r
   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
   8  \r
   9 const  left = 360 ,\r
  10       right = 600 ;\r
  11 var   level : integer;\r
  12  \r
  13 begin\r
  14    pref iiuwGRAPH block;\r
  15  \r
  16    unit dolej : procedure(kolor,ile:integer);\r
  17    var i,j:integer;\r
  18    begin\r
  19       call color(kolor);\r
  20       for i := Level-1 downto Level-ile\r
  21       do\r
  22          call move(left,i);\r
  23          call draw(right,i);\r
  24          for j :=1 to 300 do j:=j od;\r
  25       od;\r
  26       level := level-ile;\r
  27    end dolej;\r
  28  \r
  29    unit odlej : procedure(ile: integer);\r
  30    var i,j : integer;\r
  31    begin\r
  32              call color(0);\r
  33              for i := Level to Level+ile do\r
  34                    call move(left,i);\r
  35                    call draw(right,i);\r
  36                    for j := 1 to 300 do j:=j od;\r
  37               od;\r
  38               level := level+ile\r
  39    end odlej;\r
  40  \r
  41    unit sac_a_dos :  procedure(A:arrayof integer,v: integer);\r
  42    signal trouve;\r
  43    var i : integer;\r
  44       unit p : procedure(s,k : integer);\r
  45       var i : integer;\r
  46       begin\r
  47          call dolej(k,A(k));\r
  48          if s+ A(k)>v then\r
  49               call odlej(A(k));\r
  50               return\r
  51          fi;\r
  52          if s+A(k)=v then raise trouve fi;\r
  53          s := s+A(k);\r
  54          for i := k+1 to upper(A) do call p(s,i) od;\r
  55          call odlej(A(k));\r
  56  \r
  57          last_will : call MyWrite(k);\r
  58                      call affich(inXpos,inYpos,", ");\r
  59       end p;\r
  60       handlers\r
  61         when trouve : call affich(10,300,"press any key");\r
  62                       i := inchar;\r
  63         call affich(10,300,"RESULT::                   ");\r
  64         call move(80,300);\r
  65         terminate;\r
  66       end handlers;\r
  67  \r
  68    begin\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
  71  \r
  72         last_will : call affich(10,325,"END of EXECUTION");\r
  73    end sac_a_dos;\r
  74  \r
  75    unit affich : procedure(x,y:integer,s:string);\r
  76    var TAB : arrayof char,i:integer;\r
  77    begin\r
  78       call color(14);\r
  79       TAB:= unpack(s);\r
  80       call move(x,y);\r
  81       for i := lower(TAB) to upper(TAB) do\r
  82             call HASCII(0);\r
  83             call HASCII(ord(TAB(i)));\r
  84       od;\r
  85    end affich;\r
  86  \r
  87    unit inchar : function : integer;\r
  88    var i  : integer;\r
  89    begin\r
  90       do\r
  91          i := inkey;\r
  92          if i<>0 then exit fi;\r
  93       od;\r
  94       result :=i;\r
  95    end inchar;\r
  96  \r
  97    unit MyRead :  function : integer;\r
  98    var   OrdN : integer;\r
  99    begin\r
 100       result := 0;\r
 101       do\r
 102          OrdN:=inchar;\r
 103          if OrdN=13 then exit fi;\r
 104          if (ordN<58 and ordN>47)\r
 105          then\r
 106                call hascii(0);\r
 107                call hascii(OrdN);\r
 108                result := result*10+ (OrdN - 48)\r
 109           else\r
 110                if ordN=8 then result := result div 10;\r
 111                   call move(inXpos-8,inYpos);call hascii(0);\r
 112                fi;\r
 113           fi;\r
 114       od;\r
 115    end MyRead;\r
 116  \r
 117    unit MyWrite : procedure( Number : integer );\r
 118    var   i, j, n : integer,\r
 119          Chiffres:arrayof integer;\r
 120    begin\r
 121        array Chiffres dim(1:10);\r
 122        n:=0;\r
 123        if Number=0 then n:=1; Chiffres(1):=0\r
 124        else\r
 125           while Number>0\r
 126           do\r
 127              n := n+1;\r
 128              i := Number div 10;\r
 129              Chiffres(n) := Number - i*10;\r
 130              Number := i;\r
 131           od;\r
 132           for i := n downto 1\r
 133           do\r
 134               call HASCII(0);\r
 135               call Hascii(Chiffres(i)+48);\r
 136           od;\r
 137        fi;\r
 138    end MyWrite;\r
 139  \r
 140    unit dzban : procedure(x,y,z,v:integer);\r
 141    var j : integer;\r
 142    begin\r
 143        call color(14);\r
 144        for j :=1 to 3 do\r
 145            call move(y+6+j,x);\r
 146            call draw(y+6+j,x-v);\r
 147            call move(z+j,x);\r
 148            call draw(z+j,x-v);\r
 149        od;\r
 150        for j :=y to z+10 do\r
 151               call move(j,x);\r
 152               call draw(j,x+10)\r
 153        od;\r
 154        for j :=1 to 3 do\r
 155            call move(y-5,x+10+j);\r
 156            call draw(z+15,x+10+j)\r
 157        od;\r
 158    end dzban;\r
 159  \r
 160    var         A : arrayof integer,\r
 161          v,i,j,n : integer;\r
 162 begin\r
 163     call GRON(0);\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
 169     n := MyRead;\r
 170     call affich(10,130,"Elements of A :: ");\r
 171     array A dim (1:n);\r
 172     call move(10,145);\r
 173     for i := 1 to n do\r
 174           call color(i);\r
 175           A(i):= MyRead;\r
 176           call affich(inXpos,inYpos,", ")\r
 177     od;\r
 178     call affich(10,165,"v = ");\r
 179     v := MyRead;\r
 180     level := 300;\r
 181     call dzban( level,350,600,v);\r
 182  \r
 183     call sac_a_dos(A,v);\r
 184     v := inchar;\r
 185     call GROFF;\r
 186   end;\r
 187  \r
 188 end test;\r
 189  \r
 190  \r
 191  \r
 192  \r
 193  \r
 194  \r
 195 program test;\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
 202  \r
 203   unit sac_a_dos : procedure(A:arrayof integer,v: integer);\r
 204   signal trouve;\r
 205   var i : integer;\r
 206       unit p : procedure(s,k : integer);\r
 207       var i : integer;\r
 208       begin\r
 209          if s+ A(k)>v then return fi;\r
 210          if s+A(k)=v then raise trouve fi;\r
 211          s := s+A(k);\r
 212          for i := k+1 to upper(A) do call p(s,i) od;\r
 213          last_will : writeln(k);\r
 214       end p;\r
 215       handlers\r
 216         when trouve : writeln("RESULTAT :: ");\r
 217         terminate;\r
 218       end handlers;\r
 219  \r
 220 begin\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
 223  \r
 224    last_will : writeln("Fin du sequence");\r
 225 end sac_a_dos;\r
 226  \r
 227 var A: arrayof integer, v,i,n : integer;\r
 228  \r
 229 begin\r
 230     write(" n= ");\r
 231     readln(n);\r
 232     array A dim (1:n);\r
 233     for i := 1 to n do  read(A(i)) od;\r
 234     write("v = ");\r
 235     readln(v);\r
 236     call sac_a_dos(A,v);\r
 237     writeln("et fin d'execution.");\r
 238  \r
 239 end test;\r
 240  \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
 243         Fin de sequence\r
 244 et fin d'execution.\r
 245  \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
 252  \r
 253  \r
 254  \r
 255 program TTT;\r
 256 signal f(inout x,y : integer),g;\r
 257 unit ppass : procedure( inout x,y : integer);\r
 258      begin\r
 259          raise f(x,y);\r
 260          call ppass(x,y);\r
 261 end ppass;\r
 262 var x,y,z,s : integer;\r
 263  \r
 264 handlers\r
 265    when g : s := s+s;\r
 266             wind\r
 267 end handlers;\r
 268 begin\r
 269      block;\r
 270          handlers\r
 271               when f : if y=0 then raise g fi;\r
 272                         s := s+x;\r
 273                         y := y-1;\r
 274                         return;\r
 275          end handlers;\r
 276      begin\r
 277           readln(x,y);\r
 278           z := y;\r
 279           call ppass(x,z);\r
 280           write("to sie nie wydrukuje , bo wind zwija ten obiert bloku!");\r
 281      end;\r
 282       writeln("s= :" ,s);\r
 283 end TT\r