4 Блок-схема алгоритма
4.1 Блок-схема процедуры вывода(vivod)
4.2 Блок-схема процедуры обработки данных с помощью одномерного массива
5 Листинг программы
program kyrs;
uses crt;
var f:text; q:byte; f2:file of integer;
procedure MAS(var f:text);
var i,k,c,m,min,j,n,nom,p,l:integer;
a,b:array[1..250] of integer;
procedure vivod(t:string; k:integer);
begin
writeln(t);
for i:=1 to k do
write(a[i],' ');
end;
begin
reset(f);
i:=0; {создание массива}
while not seekeof(f) do
begin inc(i);
read(f,a[i]);
end;
k:=i;
vivod('исходный массив',k);
c:=0;
for i:=1 to k do {создание вспомогательного массива}
if a[i]>0 then begin
inc(c);
b[c]:=i;
end;
writeln;
i:=1;
repeat
if a[b[i]]>a[b[i+1]] then {сортировка положительных элементов}
begin
m:=a[b[i]];
a[b[i]]:=a[b[i+1]];
a[b[i+1]]:=m;
if i>1 then dec(i)
end
else inc(i);
until i>=c ;
vivod('сортированный массив',k);
writeln;
writeln('введите положительное число');
readln(p);
l:=0;
for i:=1 to k do
if p<=a[i] then begin {вставка нового элемента}
l:=i;
break;
end ;
for i:=k+1 downto l+1 do a[i]:=a[i-1];
a[l]:=p;
k:=k+1;
vivod('массив с новым элементом',k);
readln; close(f);
end;
procedure TYP_FILE(var f:text);
var a,i,j,k,l,m,n,c,d:integer;
priz:boolean;
b:array[1..250] of integer;
PROCEDURE vivod(t:string);
begin
writeln;
writeln(t);
reset(f2);
while not eof (f2) do
begin read(f2,a);
write(a,' ');
end;
end;
begin
reset(f);
rewrite(f2);
i:=0;
while not seekeof(f) do {создание типизированного файла}
begin
read(f,a);
write(f2,a);
end;
close(f2);
vivod('исходный массив');
i:=0;
n:=filesize(f2)-1; {сортировка положительных элементов}
for m:=0 to n do
begin seek(f2,m);
read(f2,a);
if a>0 then begin
inc(i);
b[i]:=m;
end;
c:=i;
i:=1;
repeat
seek(f2,b[i]);
read(f2,a);
seek(f2,b[i+1]);
read(f2,d);
if a>d then {сортировка положительных элементов}
begin
seek(f2,b[i]);
write(f2,d);
seek(f2,b[i+1]);
write(f2,a) ;
if i>1 then dec(i)
end
else inc(i);
until i>=c ;
writeln;
vivod('сортированный массив');
writeln;
writeln('введите положительный элемент') ;
readln(m);
reset(f2);
priz:=false; {вставка нового элемента}
for j:=filesize(f2)-1 downto 0 do
begin
seek(f2,j);
read(f2,a);
if a>0 then begin k:=0;
if m>a then begin
seek(f2,filesize(f2));
write(f2,m); priz:=true;
end
else for i:=j-1 downto 0 do
begin
seek(f2,i);read(f2,a);
if a>0 then begin
if a<m then break end
else inc(k);
end;
break; end;
end;
if priz=false then
begin
for j:=filesize(f2)-1 downto i do
begin
seek(f2,j);
read(f2,a);
write(f2,a);
end;
if i=0 then
seek(f2,i)
else seek(f2,i+1);
write(f2,m);
end;
seek(f2,0);
vivod('массив с новым элементом');readln; close(f); close(f2);
end;
Procedure SPIS(var f:text);
type uk=^sp;
sp=record
x:integer;
adr:uk;
end;
var p1,p2,first,first1,p3:uk; buf,c,i,m:integer;
b:array[1..150]of uk;
priz:boolean;
PROCEDURE VIV (T:STRING) ;
BEGIN
WRITELN(T);
p1:=first;
while p1<>nil do
begin
write(p1^.x,' ');
p1:=p1^.adr;
end;
writeln;
end;
begin
first:=nil;
reset(f);
while not eof(f) do
begin
New(p1);
read(f,p1^.x);
if first =nil then first:=p1
else p2^.adr:=p1;
p2:=p1;
end;
p2^.adr:=nil;
VIV ('исходный список' );
i:=0;
p1:=first;
while p1<>nil do begin
if p1^.x>0 then begin
inc(i);
b[i]:=p1;
end;
p1:=p1^.adr;
end;
c:=i;
i:=1;
repeat
if b[i]^.x>b[i+1]^.x then {сортировка положительных элементов}
begin
m:=b[i]^.x;
b[i]^.x:=b[i+1]^.x;
b[i+1]^.x:=m;
if i>1 then dec(i)
end
else inc(i);
until i>=c ;
VIV('сортированный список');
writeln('введите положительный элемент');
new(p3);
read(p3^.x);
p3^.adr:=nil;
p1:=first;
if p1^.x>p3^.x then begin
p3^.adr:=first;
first:=p3;
end
else begin
while p1^.adr<>nil do
begin
if p1^.adr^.x>0 then
if p1^.adr^.x<p3^.x then p1:=p1^.adr
else begin
p3^.adr:=p1^.adr;
p1^.adr:=p3;
break;
end
else p1:=p1^.adr;
end;
if p1^.adr=nil then p1^.adr:=p3; end;
VIV('список с новым элементом');
close(f);
readln;
end;
BEGIN
clrscr;
assign(f,'f.txt');
assign(f2,'f2.int');
repeat
clrscr;
writeln('1-массив');
writeln('2-типизированный файл');
writeln('3-линейные динамические списки');
writeln('4-выход') ;
readln(q);
Case q of
1:MAS(f);
2:TYP_FILE(f);
3:SPIS(f);
4:exit;
end;
until false;
readkey;
END.