Задача 6

program pr6;

{6. Написать функцию, которая вычисляет среднее арифметическое элементов непустого списка.}

type

function Average(listp: pItem): real;

var

cnt: integer = 0;

sum: integer = 0;

begin

while listp <> nil do begin

inc(cnt);

inc(sum, listp^.data);

listp:= listp^.next;

end;

Average:= (sum / cnt);

end;

end.

В2

program Project1;

{Написать функцию, которая вычисляет среднее

арифметическое элементов непустого списка.}

{$APPTYPE CONSOLE}

uses

SysUtils;

function srar(a:array of integer; n:integer):real;

var i:integer;

x:real;

begin

x:=0;

for i:=0 to n-1 do

x:=x+a[i];

result:=x/n;

end;

var

a:array[1..100] of integer;

i,n:integer;

begin

{ TODO -oUser -cConsole Main : Insert code here }

readln(n);

for i:=1 to n do

begin

write('a[',i,']=');

readln(a[i]);

end;

writeln('result=',srar(a,n):0:4);

readln;

end.

ЗАДАЧА 7

ЗАДАЧА 8

ЗАДАЧА 9

ЗАДАЧА 10

ЗАДАЧА 11

ЗАДАЧА 12

Program progras;

{Описать процедуру или функцию, которая определяет, входит ли список А1 в список А2.}

Uses

Crt;

Type

EXS = ^ S;

S = Record

Data : integer;

Next : EXS;

End;

Var

u, x, m1, m2 : EXS;

i, Kol : integer;

Procedure Poisk(Var x1, x2 : EXS);

Var

m3, m4 : EXS;

Begin

Kol := 0;

m3 := m1;

m4 := m2;

while m4 <> Nil do

Begin

if m4^.Data = m3^.Data

then

Begin

m3 := m3^.Next;

m4 := m4^.Next;

if m3 = Nil

then

Begin

Kol := Kol+1;

m3 := m1;

End;

End

else

Begin

m3 := m1;

m4 := m4^.Next;

End;

End;

End;

Procedure Init (Var u : EXS);

Var

y : EXS;

Digit : integer;

Begin

Writeln('Введите список. Конец ввода – 0');

u := Nil;

Read(Digit);

while Digit <> 0 do

Begin

New(y);

y^.Next := Nil;

y^.Data := Digit;

if u = Nil

then

u := y

else

x^.Next := y;

x := y;

Read(Digit);

End;

Writeln;

End;

Procedure Print(X : EXS);

Begin

while X <> Nil do

Begin

Write(X^.Data : 5);

X := X^.Next;

End;

Readln;

Writeln;

End;

Begin

ClrScr;

Init(m1);

Init(m2);

Writeln('***Список 1***');

Print(m1);

Writeln('***Список 2***');

Print(m2);

Poisk(m1, m2);

Writeln('Список 1 встречается в списке 2 ', Kol, ' раз(а)');

Readln;

End.

ЗАДАЧА 13

ЗАДАЧА 14

ЗАДАЧА 15

ЗАДАЧА 16

Program progras;

uses crt;

{Описать процедуру, которая объединяет два упорядоченных по не убыванию списка А1 и А2 в один упорядоченный по не убыванию список.}

type pType = ^chislo;

chislo = record

ch: integer;

next: pType;

end;

var a,b,res: pType;

procedure sozdati(var first: pType);

var n,i: integer;

tmp: pType;

begin

write('Skoliko chisel v spiske? '); readln(n);

new(first);

tmp:=first;

write('Vvedite uporiadochennyi spisok iz ',n,' chisel: ');

read(first^.ch);

for i:=2 to n do

begin

new(tmp^.next);

tmp:=tmp^.next;

read(tmp^.ch);

end;

tmp^.next:=nil;

end;

procedure sliti;

var nr1,nr2,nr3: pType;

begin

nr1:=a; nr2:=b;

new(res); nr3:=res;

if nr1^.ch < nr2^.ch then

begin

nr3^.ch:=nr1^.ch;

nr1:=nr1^.next;

end

else

begin

nr3^.ch:=nr2^.ch;

nr2:=nr2^.next;

end;

while not( (nr1 = nil) or (nr2 = nil) ) do

if nr1^.ch < nr2^.ch then

begin

new(nr3^.next);

nr3:=nr3^.next;

nr3^.ch:=nr1^.ch;

nr1:=nr1^.next;

end

else

begin

new(nr3^.next);

nr3:=nr3^.next;

nr3^.ch:=nr2^.ch;

nr2:=nr2^.next;

end;

while nr1 <> nil do

begin

new(nr3^.next);

nr3:=nr3^.next;

nr3^.ch:=nr1^.ch;

nr1:=nr1^.next;

end;

while nr2 <> nil do

begin

new(nr3^.next);

nr3:=nr3^.next;

nr3^.ch:=nr2^.ch;

nr2:=nr2^.next;

end;

nr3^.next:=nil;

end;

procedure vyvesti(tmp: pType);

begin

while tmp <> nil do

begin

write(tmp^.ch:4);

tmp:=tmp^.next;

end;

writeln;

end;

begin clrscr;

writeln('Spisok nr. 1');

sozdati(a);

writeln;

writeln('Spisok nr. 2');

sozdati(b);

writeln;

sliti;

write('Spisok nr. 1: '); vyvesti(a);

write('Spisok nr. 2: '); vyvesti(b);

write('Spisok nr. 3: '); vyvesti(res);

readkey; end.