craciun.pas

This ar the basic programs that i did in highschool. From very simple to medium programs. From array

 {Craciun Cosmin biletul 10}
 program craciun;
 type matrice=array[1..50,1..50] of byte;
      stiva=array[1..99] of integer;
 var a:matrice;
     st:stiva;
     l,k,m,n:integer;
     as,ev:boolean;
     f:text;
     i,j,x,y:integer;

procedure citire;
begin
assign (f,'ciclu.txt');
reset(f);
readln (f,n,m);
for i:= 1 to n do
for j:=1 to n do
             a[i,j]:=0;
  for k:= 1 to m do begin
  readln(f,x,y);
  a[x,y]:=1;
  a[y,x]:=1;
  end;
  close(f);
end;

 procedure init(var st:stiva;k:integer);
 begin
 st[k]:=0;
 end;

procedure succesor(var as:boolean;var st:stiva;k:integer);
          begin
          if st[k]<n then
             begin
                  inc(st[k]);
                  as:=true;
             end
          else as:=false;
          end;

procedure valid(var ev:boolean; k:integer);
          var i:integer;
          begin
          ev:=true;
          if (k>1) and (a[st[k],st[k-1]]=0) then ev:=false;
          for i:=1 to k-1 do
              if st[i]=st[k] then ev:=false;
          end;

function solutie(k:integer):boolean;
         begin
         solutie:=(k>=4);
         end;
procedure tipar (k:integer);
var i:integer;
begin
 for i:= 1 to k do
  write (st[i],' ');
  writeln;
  end;


  begin
citire;
init(st,k);
l:=0;
k:=1;
     while k>0 do begin
           repeat
                 succesor(st,k,as);
                 if as then valid(st,k,ev);
           until (not as) or (as and ev);
           if as then
              if solutie(k) then begin
              w:=[];
              ok:=true;
               for i:= 1 to k do w:=w+[st[i]];
                for i:= 1 to l do
                 if b[i]=w then ok:=false;
                if ok then begin tipar(k);
                                l:=l+1;
                                b[l]:=w;
                                inc(k);
                              end;
                      end
              else begin

                      k:=k+1;
                      init(st,k);
                      end
                      else k:=k-1;
                      end;
     readln;
end.