1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
Двухсвязные цикличные списки, Надо удалять каждый k-ый элемент из списка пока
Привет. Только сейчас начал изучать динамичиские структуры, и вот задача: Дан двухсвязный список их N игроков. Начиная с игрока m, каждый k-ый игрок должен быть удален из игры.
Вот что у меня получилось:
КОД(Показать/Скрыть)
Program P7; Uses Crt; type List=^Celula; Celula=record Info:String; Prec, Urm:Lista; end; var P,V:List; N,m,k:byte; procedure Create; var R:List; i:byte; begin writeln('List: '); P:=nil; V:=nil; for i:=1 to N do begin new®; readln(R^.info); R^.Prec:=nil; R^.Urm:=nil; if P=nil then begin P:=R; V:=R; end //If else begin V^.Urm:=R; R^.Prec:=V; V:=R; end //Else end; //For R^.Urm:=P; //тут я не уверен если правильно сделал что-бы список был циклинчным P^.Prec:=V; P:=V; end; //Create procedure Destroy(R:List); begin if (P^.Urm=P) and (R=P) then //процедуру взял с форума begin writeln('Leave: ',P^.Info); dispose(P); P:=nil; exit; end; writeln('Leave ',R^.info); R^.Prec^.Urm:=R^.Urm; R^.Urm^.Prec:=R^.Prec; if R=P then P:=P^.Urm; dispose®; R:=nil; //пишет invalid pointer operation end; procedure Start; var i:integer; R:list; begin i:=0; R:=P; while R<>nil do begin i:=i+1; R:=R^.Urm; if i=m then break; //Находим m-ый элемент end; i:=k; while R<>nil do if i=k then begin Destroy®; i:=0; end else begin i:=i+1; R^.R.Urm; end; Begin write('Player Number: '); readln(N); write('Position '); readln(m); write('Ration '); readln(k); Create; Start; readln; end.
Значит, смотри, как решается твоя задача с использованием циклических списков (поищи по форуму со словом казнь, найдешь и другие решения).
Вот программа:(Показать/Скрыть)
Program P7; Uses Crt; type List = ^Celula; Celula = record Info : String; prev, next : List; end;
var N, m, k : byte;
procedure Create (var root : List); var s : string; q, adding : List; begin { В любом случае надо выделять память и получать данные, так что сделаем это один раз, вместо дублирования кода } write ('info = '); readln (s);
new (adding); adding^.info := s;
if root = nil then { Добавляем самый первый элемент в "кольцо" } begin { Тут все просто: он ссылается обоими связями сам на себя. Ну, и установим Root, чтоб знать, где у кольца символическое "начало" } adding^.prev := adding; adding^.next := adding; root := adding; end else { Нет, уже не первое значение. В "кольце" уже были элементы } begin { В таком случае поступаем следующим образом: добавляем элемент перед "началом": то есть, так, чтобы новый элемент полем next указывал на Root... Не надо спрашивать почему, подумай сам, если ты будешь печатать список, я не уверен, что постоянно меняющееся "начало" тебе понравится. А так добавляться элементы будут в "конец". }
q := root^.prev; { Вот Q и есть тот элемент, ПОСЛЕ которого надо добавить новый }
{ Добавляем. Чтобы понять, что происходит - чертишь на листе бумаги два элемента, и устанавливаешь между ними связи, как делает нижеприведенный код. А потом точно там же, на бумаге, делаешь добавление еще одного элемента, и смотришь, как он становится на нужное место, перед Root-ом } adding^.next := q^.next; adding^.prev := q; adding^.next^.prev := adding; q^.next := adding; end; end;
{ Это - для отладки, и чтоб убедиться, что Create работает правильно } procedure ShowList (root : List); var q : list; begin if root <> nil then begin q := root; repeat writeln (q^.info); q := q^.next; until (q = root) end else writeln('Empty ring'); end;
{ Это еще одна проблема, которая у тебя была. Удаление элемента, на который указывает node. Хочешь спросить, зачем сюда передается еще и Root? Очень просто: я не стал описывать переменную для обозначения "начала" в самом верху, чтобы снизить вероятность появления побочных эффектов. А при удалении жлемента надо быть внимательным, ведь может удаляться и сам Root, тогда надо сделать кое-что, чтоб программа продолжала работать правильно. } procedure Delete (var root, node : List); var T : List; begin writeln ('Leaving : ', node^.info); if node^.next = node then { Итак, вариант №1 - удаляем единственный оставшийся элемент } begin { Тут как раз проще всего: раз он последний - то после его удаления Root должен сброситься в nil, что будет сигнализировать о пустом "кольце" } root := nil; dispose (node); end else { Случай второй: после удаления в кольце еще останутся элементы } begin { Для начала - проверим, не наступил ли тот особый случай, о котором я говорил выше: не удаляем ли мы Root. Если да, то надо Root-ом назначить какой-то другой элемент. Я выбрал следующий, т.е., тот, на который указывает Root^.next } if node = root then begin root := root^.next; end;
{ Теперь просто удаляем элемент node. Заметь, что перед удалением делается node := node^.next. Это не просто так. После того, как очередной игрок вышел из круга, отсчет начинается со следующего. Вот поэтому и next... Если б надо было считать с предыдущего - можно было бы сделать node := node^.prev } node^.prev^.next := node^.next; node^.next^.prev := node^.prev; T := node; node := node^.next; dispose (T); end; end;
{ Собственно, сама рабочая процедура } procedure Start (root : List); var i:integer; R:list; begin { Root не портим, работаем с доп. переменной. Сначала переходим к M-му стоящему в круге. Для этого пропускаем M-1 человек } R := Root; for i := 1 to m - 1 do R := R^.next;
{ А теперь, пока круг не опустеет - удаляем из него каждого K-го } while Root <> nil do begin
for i := 1 to k do begin R := R^.next; end; Delete (Root, R); end; end;
var i : integer; root : List;
Begin write('Player Number: '); readln(N); write('Position '); readln(m); write('Ration '); readln(k); for i := 1 to n do begin Create (Root); end; ShowList (Root);
Start (Root); readln; end.
В комментариях все сказано. Только одно замечание: в процедуре Start идет цикл от 1 до K. Это значит, что при отсчете не считается тот человек, с которого отсчет начинается. Если надо, чтоб и он учитывался, то... Ну, сам подумай, что надо сделать
Update Кстати, есть еще кое-что, что можно сделать. К примеру, если у тебя K > N, то зачем тебе делать целый круг (а может и не один, смотря насколько K больше чем N), перед тем, как ты доберешься до игрока, которого надо удалить? Подумай, что можно сделать, чтоб не крутить циклы впустую...
Update Кстати, есть еще кое-что, что можно сделать. К примеру, если у тебя K > N, то зачем тебе делать целый круг (а может и не один, смотря насколько K больше чем N), перед тем, как ты доберешься до игрока, которого надо удалить? Подумай, что можно сделать, чтоб не крутить циклы впустую...
Что именно из установки указателей непонятно? Попробуй нарисовать такую же схему, как у меня, для "кольца", в котором уже есть 2 элемента, и ты добавляешь третий, и покажи, что получилось.