Задачи к главе 54.
Добавлено: 15.03.2013 11:58:13Доброго времени суток.Показываю свои решения задач А,В,Г. При написании учёл ваши замечания,пытаюсь исправляться.
Задачи А и В я объединил и немного изменил условие,удалять можно любой не только первый,хотя про удаление только в следующей главе говориться.
А вот с задачей Г пришлось не много по мучиться.
Ваша подсказка мне не понравилась(создание двух списков), я решил сделать по-своему.Идея решения заключалась в следующем:
нужно найти элемент в списке с минимальным номером,если он не в голове списка,то ставим его в начало,теперь снова ищем минимальный,но поиск начинаем со второго элемента,затем вставляем его после первого,поиск продолжаем уже с третьего и вставляем найденный после второго и.т.д.
Вот что в итоге получилось:
Теперь беда с задачей Д.(умный винчестер),никак не пойму как здесь происходит чтение дорожек и движение к ним,может объясните?
Задачи А и В я объединил и немного изменил условие,удалять можно любой не только первый,хотя про удаление только в следующей главе говориться.
- Код: Выделить всё
type
prec=^rec;
rec=record
mnum:integer;
mfam:string;
mnext:prec;
end;
var
list:prec;
f:text;
procedure AddToList;
var
p:prec;
begin
list:=nil;
while not eof(f) do begin
new(p);
read(f,p^.mnum);
readln(f,p^.mfam);
p^.mnext:=list;
list:=p;
end;
end;
function CountMembers:byte;
var
p:prec;
i:byte;
begin
p:=list; i:=0;
while assigned(p) do begin
inc(i);
p:=p^.mnext;
end;
CountMembers:=i;
end;
procedure PrintList;
var
p:prec;
begin
p:=list;
while assigned(p) do begin
writeln(p^.mnum,p^.mfam);
p:=p^.mnext;
end;
writeln;
end;
procedure DeleteMember(an:byte);
var
i:byte;
p,q:prec;
begin
i:=1; p:=list;
while i<an-1 do begin
p:=p^.mnext;
inc(i);
end;
q:=p;
p:=p^.mnext;
if an=1 then begin
list:=p;
dispose(q);
end
else begin
q^.mnext:=p^.mnext;
dispose(p);
end;
end;
var
count,n:byte;
begin
assign(f,'C:\Files for Program Pascal\Policebase2.txt');
reset(f);
AddToList;
close(f);
PrintList;
count:=CountMembers;
writeln('Кол-во элементов в списке : ',count);
writeln('Какой элемент удалить?');
repeat
readln(n);
if (n>0) and (n<=count) then
break
else
writeln('Не корректный ввод.Попробуйте ещё раз!');
until false;
writeln;
DeleteMember(n);
PrintList;
readln;
end.
А вот с задачей Г пришлось не много по мучиться.
Ваша подсказка мне не понравилась(создание двух списков), я решил сделать по-своему.Идея решения заключалась в следующем:
нужно найти элемент в списке с минимальным номером,если он не в голове списка,то ставим его в начало,теперь снова ищем минимальный,но поиск начинаем со второго элемента,затем вставляем его после первого,поиск продолжаем уже с третьего и вставляем найденный после второго и.т.д.
Вот что в итоге получилось:
- Код: Выделить всё
type
prec=^trec;
trec=record
mnum:integer;
mfam:string;
mnext:prec;
end;
var
list:prec;
f:text;
procedure AddToList;
var
p:prec;
begin
while not eof(f) do begin
new(p);
read(f,p^.mnum);
readln(f,p^.mfam);
p^.mnext:=list;
list:=p;
end;
end;
{---поиск элемента с минимальным номером---}
procedure FindMin(var ap,aq,amn:prec);
var
p:prec;
begin
p:=aq;
while assigned(p^.mnext) do begin
if p^.mnext^.mnum<amn^.mnum then begin
amn:=p^.mnext; // ищем элемент с минимальным номером
ap:=p; // запоминаем элемент перед минимальным
end;
p:=p^.mnext;
end;
end;
{---сортировка списка---}
procedure SortList;
var
p,q,r,mn:prec;
{p-предыдущий минимального; q-начальная позиция поиска
минимального элемента; r-вставляем минимальный элемент
после него; mn:минимальный элемент}
begin
p:=list; q:=list; r:=list;
while assigned(q) do begin
mn:=q;
FindMin(p,q,mn); // ищем минимальный элемент
if mn^.mnum<list^.mnum then begin
{если минимальный меньше того что в голове
списка,то ставим его в начало списка}
p^.mnext:=mn^.mnext;
mn^.mnext:=list;
list:=mn;
q:=list^.mnext;
r:=list;
end
else begin
if p^.mnext<>mn then begin
{если предыдущий элемент не ссылается на
найденный минимальный}
if p=list then q:=q^.mnext
{если первый найденный минимальный элемент
находится в голове списка,то и указатель на
предыдущий элемент тоже будет указывать на
голову,следовательно двигаемся по списку дальше }
else begin
{ничего не переставляем,двигаемся дальше по списку}
q:=q^.mnext;
r:=r^.mnext;
end;
end
else begin
{иначе связываем элементы и продвигаемся
дальше по списку}
p^.mnext:=mn^.mnext;
mn^.mnext:=r^.mnext;
r^.mnext:=mn;
r:=r^.mnext;
q:=r^.mnext;
end;
end;
end;
end;
procedure PrintList;
var
p:prec;
begin
p:=list;
while assigned(p) do begin
writeln(p^.mnum,p^.mfam);
p:=p^.mnext;
end;
writeln;
end;
begin
assign(f,'C:\Files for Program Pascal\Policebase2.txt');
reset(f);
list:=nil;
AddToList;
PrintList;
SortList;
PrintList;
readln;
end.
Теперь беда с задачей Д.(умный винчестер),никак не пойму как здесь происходит чтение дорожек и движение к ним,может объясните?
А опытный программист пишет просто, поскольку три простые процедуры лучше одной сложной. Моя подсказка насчёт удаления первого элемента и вставки его в другой список подразумевала то, что процедуру удаления первого элемента написать легко, а вторая уже готова. А завести две головы – не проблема.
.А то я понять не мог зачем он нужен 
Получилось?