Наши проекты:
Журнал · Discuz!ML · Wiki · DRKB · Помощь проекту |
||
ПРАВИЛА | FAQ | Помощь | Поиск | Участники | Календарь | Избранное | RSS |
[3.21.231.245] |
|
Сообщ.
#1
,
|
|
|
Здравствуйте! Не работает сортировка списка ни одним способом. Пробовал и вставками и пузырьком. Когда делаю вставками, вылезает exitcode 216 при начале обмена. В общем вот код:
type el=^opisanie; opisanie= record model: string[20]; ves: integer; tip_corp: string[20]; diag_d: string[10]; dif: string[10]; f_mem: string[5]; cam: string[10]; ovpam: integer; next,prev: el; end; var SE: opisanie; s: file of opisanie; n,x,r,i: integer; kolsymb: integer; search1, search2: string[15]; h,p,p1,first: el; tmp: string; procedure sort2; {собственно 1 вариант} var i,j: integer; begin for i:=1 to (n-1) do begin p:=h; for j:=1 to (n-1) do begin p1:=p^.next; if p^.model > p1^.model then begin tmp:=p^.model; p^.model:=p1^.model; p1^.model:=tmp; end; p:=p1; end; end; p:=h; for i:=1 to n do begin writeln(p^.model); p:=p^.next; end; end; function sortvib (var first: el):el; {2 вариант} var l,p:el; tmp: string; begin l:=first; while l^.next <> nil do begin p:=l^.next; while p<>nil do begin if l^.model>p^.model then begin tmp:=l^.model; l^.model:=p^.model; p^.model:=tmp; end; p:=p^.next; end; l:=l^.next; end; end; procedure sortvs (var first: el); {3 вариант} var i,j: el; t: string; begin i:= first; while i<>nil do begin t:=i^.model; j:=i^.prev; while (j<>nil) and (t<j^.model) do begin j^.next^.model:=j^.model; j:=j^.prev; end; if j=nil then first^.model:=t else j^.next^.model:=t; i:=i^.next; end; end; procedure sort1 (first: el); {4 вариант} var sn,nd: el; tmp: string; begin getmem(sn, sizeof(opisanie)); nd:=first; while nd<nil do {>} begin sn:=nd^.next; while sn<>nil do begin if sn^.model < nd^.model then begin tmp:=sn^.model; sn^.model:=nd^.model; nd^.model:=tmp; end; sn:=sn^.next; end; nd:=nd^.next; end; end; begin sortvs (first); {последним этот пробовал} end; Уже больше двух недель вожусь с этим. Надо уже курсач защищать, а у меня эта сортировка неработает. PS. Поиском прользовался, подобное находил, от туда кстати тоже есть способ. Просьба ответить как можно быстрее.. Прикреплённый файлSony2.rar (1,57 Кбайт, скачиваний: 272) Добавлено Забыл совсем пользуюсь FreePascal. |
Сообщ.
#2
,
|
|
|
Собственно, сразу же следует вопрос: а где хоть как-то инициализируется First? Он же у тебя неинициализирован, как ты хочешь, чтоб список сортировался? Списка-то фактически и нет...
|
Сообщ.
#3
,
|
|
|
В том-то и дело, что я незнаю как его сортировать. Процедуру sort1 я взял в одной работе, там работает. Хотя переписал все учитывая, не помогло.
|
Сообщ.
#4
,
|
|
|
Еще раз: ЧТО сортировать? Чтоб что-то сортировать, надо сначала это что-то СОЗДАТЬ. Где создается список по-твоему?
|
Сообщ.
#5
,
|
|
|
вот здесь:
|
Сообщ.
#6
,
|
|
|
if n=1 then begin clrscr; new (p); writeln ('Введите описание телефона'); writeln; writeln ('модель: '); readln (p^.model); for i:=1 to length(SE.model) do SE.model[i]:=upcase(SE.model[i]); writeln ('вес: '); readln (p^.ves); writeln ('тип корпуса: '); readln (p^.tip_corp); writeln ('диагональ дисплея: '); readln (p^.dif); writeln ('разрешение: '); readln (p^.diag_d); writeln ('встроенная память: '); readln (p^.ovpam); writeln ('поддержка флеш-карт: '); readln (p^.f_mem); writeln ('камера: '); readln (p^.cam); p^.next:=nil; assign (s, 'D:\fp\test.txt'); reset (s); seek (s, filesize (s)); write (s, p^); close (s); writeln ('Данные записаны.'); readln; end; Добавлено сортировать надо по полю model, по алфавиту. Добавлено разобрался, кажется... У меня нет добавления в список елементов. Я правильно понимаю? |
Сообщ.
#7
,
|
|
|
Цитата MrSmmiT @ Наконец то Да, ты правильно понимаешь. У меня нет добавления в список елементов. Я правильно понимаю? |
Сообщ.
#8
,
|
|
|
можно сделать так?
procedure ad (var spis1: el; zhach1: string); var tmp: el; begin if spis1=nil then begin new(spis1); tmp:= spis1; end else begin tmp:= spis1; while tmp^.next <> nil do new(tmp^.next); tmp:=tmp^.next; end; tmp^.next:=nil; tmp^.model:=zhach1; end; Только как сделать, чтобы добавлялись все поля (model, ves, tip_corp и т.д.)? Добавлено в лекции у меня написано так: procedure Create_New_Elem(var p: el); begin New (p); Writeln ('введите значение первого информационного поля: '); Readln ( p^.inf1 ); Writeln ('введите значение второго информационного поля: '); Readln ( p^.inf2 ); p^.next := nil; {все поля элемента должны быть инициализированы} end; Добавлено Разьве оно не совпадает с моим Цитата begin clrscr; new (p); writeln ('Введите описание телефона'); writeln; writeln ('модель: '); readln (p^.model); for i:=1 to length(SE.model) do SE.model[i]:=upcase(SE.model[i]); writeln ('вес: '); readln (p^.ves); writeln ('тип корпуса: '); readln (p^.tip_corp); writeln ('диагональ дисплея: '); readln (p^.dif); writeln ('разрешение: '); readln (p^.diag_d); writeln ('встроенная память: '); readln (p^.ovpam); writeln ('поддержка флеш-карт: '); readln (p^.f_mem); writeln ('камера: '); readln (p^.cam); p^.next:=nil; assign (s, 'D:\fp\test.txt'); reset (s); seek (s, filesize (s)); write (s, p^); close (s); writeln ('Данные записаны.'); readln; end; Добавлено Хотя скорее всего так что-то не так. Потому что в другой работе елементы не создавались. |
Сообщ.
#9
,
|
|
|
Вроде бы сделал запись елементов.
procedure ad (var first: el); var p: el; model, tip_corp, diag_d, dif, f_mem, cam: string[20]; ves, ovpam: integer; begin if first=nil then writeln ('Введите описание телефона'); writeln; writeln ('модель: '); readln (model); writeln ('вес: '); readln (ves); writeln ('тип корпуса: '); readln (tip_corp); writeln ('диагональ дисплея: '); readln (diag_d); writeln ('разрешение: '); readln (dif); writeln ('встроенная память: '); readln (ovpam); writeln ('поддержка флеш-карт: '); readln (f_mem); writeln ('камера: '); readln (cam); begin new(p); p^.next:=nil; p^.model:=model; p^.ves:=ves; p^.tip_corp:=tip_corp; p^.diag_d:=diag_d; p^.dif:=dif; p^.ovpam:=ovpam; p^.f_mem:=f_mem; p^.cam:=cam; { read(model); \ read(ves); | read(tip_corp); | read(diag_d); | непонимаю зачем это, оно вроде выше есть,но и без него работает (вроде) read(dif); | read(ovpam); | read(f_mem); | read(cam);} / end; writeln; end; только теперь незнаю как записать елемент в файл. |
Сообщ.
#10
,
|
|
|
Вроде бы сделал запись елементов.
procedure ad (var first: el); var p: el; model, tip_corp, diag_d, dif, f_mem, cam: string[20]; ves, ovpam: integer; begin if first=nil then writeln ('Введите описание телефона'); writeln; writeln ('модель: '); readln (model); writeln ('вес: '); readln (ves); writeln ('тип корпуса: '); readln (tip_corp); writeln ('диагональ дисплея: '); readln (diag_d); writeln ('разрешение: '); readln (dif); writeln ('встроенная память: '); readln (ovpam); writeln ('поддержка флеш-карт: '); readln (f_mem); writeln ('камера: '); readln (cam); begin new(p); p^.next:=nil; p^.model:=model; p^.ves:=ves; p^.tip_corp:=tip_corp; p^.diag_d:=diag_d; p^.dif:=dif; p^.ovpam:=ovpam; p^.f_mem:=f_mem; p^.cam:=cam; { read(model); \ read(ves); | read(tip_corp); | read(diag_d); | непонимаю зачем это, оно вроде выше есть. если убрать скобки, read(dif); | то после записи всех ел-ов пустые строки и если что-то ввести, то exicode 216. read(ovpam); | read(f_mem); | read(cam);} / end; writeln; end; только теперь незнаю как записать елемент в файл. После процедуры пишу: assign (s, 'D:\fp\test.txt'); reset (s); seek (s, filesize (s)); write (s, p^); close (s); writeln ('Данные записаны.'); readln; но ругается на p^ в строке write (s, p^); |
Сообщ.
#11
,
|
|
|
MrSmmiT, смотри:
type el=^titem; opisanie= record model: string[20]; ves: integer; tip_corp: string[20]; diag_d: string[10]; dif: string[10]; f_mem: string[5]; cam: string[10]; ovpam: integer; end; // тысячу раз говорил - повторяю еще раз: Мухи отдельно, котлеты - отдельно. // Какое отношение имеют поля prev/next к телефону? Никакого, это доп. информация. // Вот и храни эту доп. информацию там, где она нужна - это элемент списка!!! // На кой ее пихать в файл? Все равно там будет записан мусор, при следующем запуске // все адреса, которые были записаны раньше, поменяются, и твои prev/next будут // указывать "в космос". titem = record data : opisanie; next,prev: el; end; // ... procedure GetPhone(var Op : opisanie); begin with Op do begin writeln ('Введите описание телефона'); writeln; writeln ('модель: '); readln (model); writeln ('вес: '); readln (ves); writeln ('тип корпуса: '); readln (tip_corp); writeln ('диагональ дисплея: '); readln (diag_d); writeln ('разрешение: '); readln (dif); writeln ('встроенная память: '); readln (ovpam); writeln ('поддержка флеш-карт: '); readln (f_mem); writeln ('камера: '); readln (cam); end; end; // Добавляем данные очередного элемента к списку procedure Add(var first, last : el; const Op : opisanie); var p : el; begin new(p); p^.data := Op; p^.next := nil; p^.prev := last; if first = nil then first := p else last^.next := p; last := p; end; |
Сообщ.
#12
,
|
|
|
Спасибо! Заработало!
Только при сравнении элемнтов пишет: Operator is not overloaded: "opisanie" < "opisanie". procedure sortvs (var first: el); var i,j: el; t: opisanie; begin i:= first; while i<>nil do begin t:=i^.data; j:=i^.prev; while (j<>nil) and (t<j^.data) do begin j^.next^.data:=j^.data; j:=j^.prev; end; if j=nil then first^.data:=t else j^.next^.data:=t; i:=i^.next; end; end; |
Сообщ.
#13
,
|
|
|
Цитата MrSmmiT @ Естественно. Ты не можешь сравнивать сразу всю запись с другой записью. Надо ж отсортировать по значению какого-то поля? Вот эти поля и сравнивай между собой. Только при сравнении элемнтов пишет: Operator is not overloaded: "opisanie" < "opisanie". |
Сообщ.
#14
,
|
|
|
Цитата volvo877 @ Вот эти поля и сравнивай между собой. то есть? Добавлено можно пример? если не сложно. |
Сообщ.
#15
,
|
|
|
Ну, если тебе надо упорядочить список по названию модели - то так:
// ... while (j<>nil) and (t.model<j^.data.model) do // ... |
Сообщ.
#16
,
|
|
|
А как сделать, чтобы записанные ранее элементы брались из файла. Т.е. ввели элеменыты списка, они записались в файл, закрыли программу. Потом открыли и отсортировали то что записано в файле. Проще говоря, как взять элементы для списка из файла для сортировки.
Уже все кроме этого работает: Program Sony; Uses heaptrc, lineinfo, crt; type el=^titem; opisanie= record model: string[20]; ves: integer; tip_corp: string[20]; diag_d: string[10]; dif: string[10]; f_mem: string[5]; cam: string[10]; ovpam: integer; end; titem=record data: opisanie; next, prev: el; end; var SE: opisanie; s: file of opisanie; n,x,r,i: integer; kolsymb: integer; search1, search2: string[15]; p,p1,first,last: el; procedure getphone (var SE: opisanie); var i: integer; begin with SE do begin writeln ('Введите описание телефона'); writeln; writeln ('модель: '); readln (model); for i:=1 to length (SE.model) do SE.model[i]:=upcase(SE.model[i]); writeln ('вес: '); readln (ves); writeln ('тип корпуса: '); readln (tip_corp); writeln ('диагональ дисплея: '); readln (diag_d); writeln ('разрешение: '); readln (dif); writeln ('встроенная память: '); readln (ovpam); writeln ('поддержка флеш-карт: '); readln (f_mem); writeln ('камера: '); readln (cam); end; end; procedure ad (var first, last: el; const SE: opisanie); var p: el; begin new(p); p^.data:=SE; p^.next:=nil; p^.prev:=last; if first=nil then first:=p else last^.next:=p; last:=p end; procedure sortvs (var first: el); var i,j: el; t: opisanie; begin i:= first; while i<>nil do begin t:=i^.data; j:=i^.prev; while (j<>nil) and (t.model<j^.data.model) do begin j^.next^.data:=j^.data; j:=j^.prev; end; if j=nil then first^.data:=t else j^.next^.data:=t; i:=i^.next; end; end; procedure view (first: el); var nd: el; l: string; begin nd:=first; if nd=nil then writeln ('‘ЇЁб®Є Їгбв') else begin while nd<>nil do begin write(nd^.:15); nd:=nd^.next; end; end; end; {procedure sort1 (first: el); var sn,nd: el; tmp: string; begin getmem(sn, sizeof(opisanie)); nd:=first; while nd<>nil do begin sn:=nd^.next; while sn<>nil do begin if sn^.data < nd^.data then begin tmp:=sn^.data; sn^.data:=nd^.data; nd^.data:=tmp; end; sn:=sn^.next; end; nd:=nd^.next; end; end;} begin repeat clrscr; writeln (' МЕНЮ'); writeln; writeln ('1 - добавить информацию о телефоне'); writeln ('2 - просмотр списка телефонов'); writeln ('3 - поиск'); writeln ('4 - сортировка по алфавиту'); writeln ('5 - выход'); readln (n); if n=1 then begin getphone (SE); ad (first, last, SE); assign (s, 'D:\fp\test.txt'); reset (s); seek (s, filesize (s)); write (s, SE); close (s); writeln ('„ лҐ б®еа Ґл ў д ©«'); readln; end; if n=2 then begin assign (s, 'D:\fp\test.txt'); reset (s); writeln (' модель вес тип корпуса разрешение диагональ память флеш-карта камера '); while not eof (s) do with SE do begin read (s, SE); writeln (model:12,'', ves:7,'', tip_corp:11,'', dif:15,'', diag_d:11, ovpam:11,'', f_mem:10,'', cam:12); end; readln; close (s); end; if n=3 then begin clrscr; writeln ('Введите модель телефона'); readln (search1); kolsymb:= length (search1); assign (s, 'D:\\fp\test.txt'); reset (s); while not eof (s) do begin read (s, SE); search2:= copy(SE.model,1,kolsymb); if (upcase(search1)=upcase(search2)) then begin writeln ('модель - ', SE.model); writeln ('вес - ', SE.ves, '':1, 'гр.'); writeln ('тип корпуса - ', SE.tip_corp); writeln ('диагональ дисплея - ', SE.diag_d, '':1, 'inch'); writeln ('поддержка флеш-карт', SE.f_mem); writeln ('камера - ', SE.cam, '':1, 'Mpix'); writeln ('встроенная память - ', SE.ovpam, '':1, 'Mb') end; end; close (s); readln; end; if n=4 then begin sortvs (first); end; if n=5 then view (first); until n>5; end. Добавлено volvo877Очень прошу поскорее ответить! |
Сообщ.
#17
,
|
|
|
begin // основная программа first := nil; last := nil; // Тут можно добавить проверку существования файла, и загружать из него данные // только если файл существует, чтоб при первом вызове не было сбоя assign (s, 'D:\fp\test.txt'); // Этого достаточно, не надо делать Assign каждый раз, остальные Assign-ы можешь убрать reset (s); while not eof (s) do begin read (s, SE); ad (first, last, SE) end; close (s); repeat clrscr; // далее - по тексту P.S. Почему ты делаешь просмотр списка телефонов из файла - непонятно. Печатай прямо список: writeln (' модель вес тип корпуса разрешение диагональ память флеш-карта камера '); p := first; while p <> nil do begin with p^.data do writeln (model:12,'', ves:7,'', tip_corp:11,'', dif:15,'', diag_d:11, ovpam:11,'', f_mem:10,'', cam:12); p := p^.next; end; |
Сообщ.
#18
,
|
|
|
Сообщ.
#19
,
|
|
|
Кажется понял почему так. Я открываю файл, беру оттуда записи, сортирую это все. И записывается оно туда же, не стирая того, что уже есть в файле. Если это так, то как это можно исправить?
|
Сообщ.
#20
,
|
|
|
Цитата MrSmmiT @ Ты знаешь, я не телепат. Я в твоем коде вообще не вижу записи в файл после сортировки, и сказать, как исправить - не могу. Теоретически - перед записью в файл отсортированных данных достаточно содержимое файла удалить:Я открываю файл, беру оттуда записи, сортирую это все. И записывается оно туда же, не стирая того, что уже есть в файле. reset(s); truncate(s); // и только теперь записывать данные |
Сообщ.
#21
,
|
|
|
Процедура сортировки осталась та же,
begin first:=nil; last:=nil; repeat clrscr; writeln (' МЕНЮ'); readln (n); \\ и так далее до if n=4 then begin assign (s, 'D:\fp\test.txt'); reset (s); while not eof (s) do begin read (s, SE); sortvs (first); write (s, SE); end; close (s); end; Добавлено Попробовал с truncate(s); получается тоже самое... все записи заменились одной. Видимо не в этом дело. Хотя новой строки не добавилось. Вот на всякий случай еще процедура сортировки: procedure sortvs (var first: el); var i,j,k: el; t: opisanie; begin i:= first; while i<>nil do begin t:=i^.data; j:=i^.prev; while (j<>nil) and (t.model<j^.data.model) do begin j^.next^.data:=j^.data; j:=j^.prev; end; if j=nil then first^.data:=t else j^.next^.data:=t; i:=i^.next; end; end; Добавлено еще заметил, что после добавления от 3 до н записей в файл. Сортировка работает не так: остается только первая запись, и она написана 2 раза. |
Сообщ.
#22
,
|
|
|
Запись списка в файл:
begin getphone (SE); ad (first, last, SE); assign (s, 'D:\fp\test.txt'); reset (s); seek (s, filesize (s)); getmem (p, sizeof(titem)); write (s, p^.data); close (s); writeln ('Данные сохранены в файл'); readln; после этой "записи", при просмотре содержимого файла пишется не модель, вес и т.д., а чушь какая-то. Помогите пожалуйста! |
Сообщ.
#23
,
|
|
|
Цитата MrSmmiT @ после этой "записи", при просмотре содержимого файла пишется не модель, вес и т.д., а чушь какая-то. С этим разобрался. Теперь только непонятно почему после добавления последнего элемента, перезаписываются все предыдущие на вводимый. И нельзя просмотреть содержимое файла, пока не добавишь новый элемент. Ответте пожалуйста быстрее, мне в понедельник уже сдавать надо... |