plaman.pas

来自「This ar the basic programs that i did in」· PAS 代码 · 共 78 行

program dracu;
type pnod=^nod;
     nod=record
     inf:integer;
     urm,pred:pnod;
     end;
var ultim,prim:pnod;
procedure creare(var prim,ultim:pnod);
          var n,i:integer;
              q:pnod;
begin
new(prim);prim^.pred:=nil;
q:=prim;
write('n=');
readln(n);
          for i:=1 to n do
              begin
              new(q^.urm);
              q^.urm^.pred:=q;
              q:=q^.urm;
              write('Dati informatie');
              readln(q^.inf);
              end;
new(ultim);
q^.urm:=ultim;
ultim^.urm:=ultim;
ultim^.pred:=q;
ultim^.urm:=nil;
end;
function divizor(x:integer):integer;
         var d,i:integer;
begin
if x =1 then divizor:=1
        else begin
             d:=2;
             for i:=2 to trunc(x/2) do
             if x mod i =0 then inc(d);
             divizor:=d;
             end;
end;
procedure inserare(prim,ultim:pnod);
          var p,t,q:pnod;
          begin
          p:=prim^.urm;
          while p<>ultim do
                begin
                t:=p^.urm;
                new(q);
                p^.urm:=q;
                q^.pred:=p;
                q^.urm:=t;
                t^.pred:=q;
                q^.inf:=divizor(p^.inf);
                p:=q^.urm;
                end;
          end;
procedure stergere(prim,ultim:pnod);
          var q,t:pnod;
begin
new(prim);
q:=prim^.urm;
t:=q^.urm;
while q <> ultim do
      begin
      if q^.inf< 10 then begin
                         prim^.urm:=t;
                         t^.pred:=prim;
                         end;
      q:=q^.urm;
      end;
end;
BEGIN
creare(ultim,prim);
inserare(prim,ultim);
stergere(prim,ultim);
writeln;
END.