Читайте также:
|
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.
Вывод
При написании курсового проекта по программированию на языке Pascal, я использовала различные способы хранения данных при решении задачи. Каждый из них имеет свои достоинства и недостатки.
Дата добавления: 2015-09-02; просмотров: 139 | Нарушение авторских прав
| <== предыдущая страница | | | следующая страница ==> |
| Словесное описание алгоритма | | | Технология капитального ремонта дорожных одежд |