Решение задач на языке "Паскаль"

Программа № 1

Program mod2;

uses crt;

const N=10;

var i, a : integer;

F, chet : file of integer;

Begin

  clrscr;

  assign(F,'D:\Mania\dz\chisla.txt');

  assign(Chet,'D:\Mania\dz\chetniye.txt');

  rewrite(F);

  rewrite(chet);

  randomize;

  For i:=1 to N do

   begin

     a:=random(100);

     write(F,a);

     If a mod 2 =0 then

     write(chet,a);

   end;

   close(F);

   close(Chet);

   reset(F);

   reset(Chet);

   writeln('Vse chisla: ');

   While not eof(F) do

    begin

      read(f,a);

      Write(a,' ');

   end;

   Writeln;

   Writeln('Chetniye: ');

   While not eof(Chet) do

     begin

       read(chet,a);

       write(a,' ');

     end;

   readln;

  end.

 

     begin                             

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 

Программа 2

program project1;

const

n=10;

 type

  s=^stack;

  stack=record

  sElement: integer;

  next: s;

 end;

var

sTop : s=nil;

a, i : integer;

procedure Push(chislo : integer);

  var p : s;

 begin

  new(p);

  p^.sElement:=chislo;

  p^.next:=sTop;

  sTop:=p;

end;

function Pop :integer;

 var p : s;

Begin

   p := sTop;

   Pop:=p^.sElement;

   sTop:=p^.next;

   dispose(p);

 end;

function StackIsEmpty : boolean;

  begin

    StackIsEmpty := sTop=nil;

  end;

Begin

randomize;

Writeln('Chisla v steke: ');

 

For i:=1 to n do

  begin

    a:=random(20);

    write(a,'  ');

    Push(a);

  end;

Writeln;

Writeln('V obratnom poryadke: ');

 

While not StackIsEmpty do

write(Pop,'  ');

readln;

end.                                     

 

 

 

 

 

 

 

 

Программа 3

type

 

  tdatatype=integer;

  pelem=^elem;

  elem=record

         Data:tdataType;

         Next:pelem;

         end;

   var

  headlist: PElem;

   a: integer;

    procedure Create(var headlist: Pelem);

    var

       Current:Pelem;

       a: integer;

               begin

                New(headlist);  { выделить память для первой записи }

                writeln('input elem');

                read(a);

                headlist^.Data:=a;

                Current:= headlist;   { сделать первую запись

                                                  текущей }

                while a<>0 do

                begin

                  New(Current^.Next);       { выделить память для

                                                  следующей записи }

                  Read(a);

                  Current^.Data:=a;

                  Current:= Current^.Next; { сделать следующую

                                                   запись текущей }

                end;

                Current^.Next := nil;    { после последней считанной

                                                записи следующей нет }

 

             end;

 

{function FindCheckByAmount(AnAmount: Real): PCheck;

             var Check: PCheck;

             begin

               TempCheck := ListOfChecks;  { указывает на первую запись }

               while (Check^.Amount <> AnAmount) and

                                     (Check^.Next <> nil) do

                  Check := Check^.Next;

               if Check^.Amount = AnAmount then

                  FindCheckByAmount := Check    { возвращает указатель на

                                                  найденную запись }

               else FindCheckByAmount := nil;   { или nil, если таких

                                                  записей нет }

             end;}

Procedure Lists(p:pelem); // процедура вывода списка на экран, p – указатель на начало

begin

while p<>Nil do

begin  writeln(p^.Data,'  '); p:=p^.next; end;

    writeln;

end;

 

procedure DisposeChecks(headlist: Pelem);

             var Temp,Current: PElem;

             begin

               Current := headlist;        { указывает на первую

                                                      запись }

               while Current <> nil do

               begin

                 Temp := Current^.Next;  { сохранить указатель Next }

                 Dispose(Current);   { освобождение текущей записи }

                 Current := Temp;    { сделать сохраненную запись

                                            текущей }

               end;

             end;

 

   begin

    { nextnode:=currentnode^.next;

     writeln(currentnode^.data);}

    Create(headlist);

    Lists(headlist);

    DisposeChecks(headlist);

    readln(a);

 

  end.

 

 

 

 

 

 

 

Программа 4

program FIFO;

const n=10;

 

type

  pQueue=^Queue;

  Queue=record

    value: integer;

    next : pQueue;

  end;

  var

  a, i : integer;

  pQBegin : pQueue=nil;

  pQEnd :  pQueue=nil;

  chisla : file of integer;

procedure EnQueue(Element : integer);

 begin

    If pQBegin=nil then

    Begin

      new(pQEnd);

      pQBegin:=pQEnd;

      pQEnd^.value:=Element;

      pQEnd^.next:=nil;

    end

    else

     begin

       new(pQEnd^.next);

       pQEnd:=pQEnd^.next;

       pQEnd^.value:=Element;

       pQEnd^.next:=nil;

     end;

 end;

Function DeQueue: integer;

 var p :pQueue;

   begin

      p:=pQBegin;

      DeQueue:=p^.value;

      pQBegin:=p^.next;

      dispose(p);

      end;

Function QueueIsEmpty : boolean;

  begin

   QueueIsEmpty:=pQBegin=nil;

  end;

Begin

  assign(chisla,'chisla.txt');

  randomize;

  rewrite(chisla);

  For i:=1 to n do

    begin

      a:=random(100)-50;

      Write(chisla, a);

    end;

  close(chisla);

  reset(chisla);

  Writeln('Vse chisla');

  While not Eof(chisla) do

   begin

    read(chisla,a);

    Write(a,' ');

   end;

  close(chisla);

  reset(chisla);

  Writeln;

  Writeln('polozhitelniye i 0 :');

  While not Eof(chisla) do

   begin

     read(chisla,a);

     If a>=0 then

     Write(a,' ')

     Else EnQueue(a);

  end;

  close(chisla);

  Writeln;

  Writeln('otricatelniye: ');

  While not QueueIsEmpty do

   Begin

     a:=DeQueue;

     Write(a,' ');

   end;

  readln;

  end.

 

 

 

 

 

Программа 5

program project1;

const

n=10;

type

  s=^stack;

  stack=record

  sElement: integer;

  next: s;

end;

var

sTop : s=nil;

a, i : integer;

procedure Push(chislo : integer);

  var p : s;

begin

  new(p);

  p^.sElement:=chislo;

  p^.next:=sTop;

  sTop:=p;

end;

function Pop :integer;

var p : s;

Begin

   p := sTop;

   Pop:=p^.sElement;

   sTop:=p^.next;

   dispose(p);

end;

function StackIsEmpty : boolean;

  begin

    StackIsEmpty := sTop=nil;

  end;

Begin

randomize;

Writeln('Chisla v steke: ');

 

For i:=1 to n do

  begin

    a:=random(20);

    write(a,'  ');

    Push(a);

  end;

Writeln;

Writeln('V obratnom poryadke: ');

 

While not StackIsEmpty do

write(Pop,'  ');

readln;

end.