Структура записи: -ФИО(40 знаков) -Адрес: -Улица(20 знаков) -Номер дома -Квартира -Номер телефона(10 знаков) -Баланс
Задание:Найти телефонную сеть(первые 3 цифры номера),имеющую наибольшее число абонентов.
Помогите пожалуйста с решением.Заранее спасибо.
мисс_граффити
17.09.2010 14:38
Zigfried, с чем конкретно проблема? что пробовал, что не получается?
Zigfried
17.09.2010 15:19
я не знаю как из текстового файла сделать список из записей
volvo
17.09.2010 16:22
Для этого надо как минимум знать, что из себя представляет тот текстовый файл, с которым ты хочешь работать. Если там данные о каждой записи хранятся в строку, с каким-либо (определенным заранее) разделителем между полями - то вот так: Заполнение полей записи из файла читать данные в переменную типа "запись", а уж как эти записи объединить в список - тут на форуме было не десятки, а сотни раз. Точно так же, как и список целых, если что... Разницы, что именно хранится в списке, просто нет. Процедуры добавления элементов к списку совершенно одинаковые для любого типа данных.
Если же информация записана в txt-файл в другом виде - говори, в каком именно.
Zigfried
17.09.2010 16:50
ну если не обговаривается это у меня в условии то наверно в строке)
volvo
17.09.2010 17:23
Я догадки предпочитаю оставлять женщинам с картами Таро или с кофейной гущей. Если у тебя не сказано - это значит только то, что у тебя не сказано, и требует уточнения.
Цитата
наверно в строке
В таком случае, наверно тебе подойдет метод ссылку на который я тебе дал.
Zigfried
1.10.2010 13:24
Уточнил у преподавателя данные записаны в строку через пробел
Lapp
1.10.2010 13:33
Цитата(Zigfried @ 1.10.2010 10:24)
Уточнил у преподавателя данные записаны в строку через пробел
Zigfried, ты просто приведи, как пример, фрагмент файла - и все станет всем ясно..
Код
Иванов Петр Сидорович Ленина 25 321 1234567890 15.44 Смит Мэри Джоновна Вашингтона 1234 1 2345678901 123.45 ...
Так?
Zigfried
1.10.2010 14:52
да
volvo
1.10.2010 15:11
Цитата
да
В таком случае, в чем проблема использовать вышеприведенный метод? Или ты, извини, хочешь получить готовый код, сам поменять двоеточие на пробел (и добавить функцию strReal, которая как близнец похожа на strInt) - не в состоянии? Объясни, ПРОБЛЕМА в чем? В нежелании делать что-то самостоятельно? В нежелании пользоваться готовыми наработками? В чем?
P.S. Зачем нам весь этот хлам, все старые сообщения? Давайте удалим все это к едрене фене, и будем всё заново решать с чистого листа? Это как рацпредложение к админам.
Lapp
1.10.2010 15:30
смотри, вот тебе ТВОЯ примерная структура записи, вкупе с элементом списка..
type tPage = record FIO: string[30]; Ul: string[20]; Dom,Kv: integer; Tel: string[10]; Bal: single end; tElem = record Page: tPage; Next: ^tElem end;
var First,Last: ^tElem;
Читай файл построчно в цикле до EoF(f) и раскладывай по полям записи (как в той ссылке). При этом не забывай выделять память под каждый новый элемент. Попробуй это реализовать и покажи, что получается.
Zigfried
1.10.2010 15:31
ok
Zigfried
4.10.2010 13:54
type tPage = record FIO: string[30]; Ul: string[20]; Dom,Kv: integer; Tel: string[10]; Bal:single end; tlist=^tElem; tElem = record Page: tPage; Next:tlist end; var Spis:tlist; z:tPage; x:text;
procedure list_init(var m:tlist); begin new(m); m^.next:=nil end;
procedure list_read(var z:tPage); begin readln(x,z.FIO); readln(x,z.Ul); readln(x,z.Dom); readln(x,z.Kv); readln(x,z.Tel); readln(x,z.Bal); if not eof(x) then readln(x) end;
function sort(z1,z2:tPage):boolean; begin sort:=((z1.FIO<z2.FIO) or (z1.FIO=z2.FIO)) end;
procedure list_add(var m:tlist; z:tPage); var p,q:tlist; begin q:=m; while (q^.next<>nil) and sort(q^.next^.Page,z) do q:=q^.next; new(p); p^.Page:=z; p^.next:=q^.next; q^.next:=p end;
procedure list_create(var x:text;var m:tlist); begin assign(x,'input.txt'); reset(x); list_init(m); while not eof(x) do begin list_read(z); list_add(m,z) end end; procedure list_print(m:tlist); begin if m=nil then writeln('konec spiska') else begin writeln(m^.Page.FIO); writeln(m^.Page.Ul); writeln(m^.Page.Dom); writeln(m^.Page.Kv); writeln(m^.Page.Tel); writeln(m^.Page.Bal); writeln; list_print(m^.next) end end; begin list_create(x,spis); Writeln('spisok:'); list_print(spis^.next) end.
Вот что получилось(начальный этап). Выдаёт ошибку.
мисс_граффити
4.10.2010 22:06
Цитата(Zigfried @ 4.10.2010 10:54)
Вот что получилось(начальный этап). Выдаёт ошибку.
Какую и на каких данных? Лучше прикрепи свой текстовый файлик с данными. Компилируется вроде нормально.
Zigfried
14.11.2010 17:02
а сортировка в данной задаче правильно выполнена не подскажите?
Zigfried
14.11.2010 17:39
и пожалуйста помогите с процедурой нахождения телефонной сети с наибольшим числом абонентов
Zigfried
25.11.2010 13:55
program lyalikov21; {Найти телефонную сеть(первые 3 цифры номера),имеющую наибольшее число абонентов} {$APPTYPE CONSOLE} uses SysUtils; type tPage = record FIO: string[30]; Ul: string[20]; Dom,Kv: integer; Tel: string[10]; Bal:single end; tlist=^tElem; tElem = record Page: tPage; Next:tlist end; var Spis:tlist; z:tPage; x:text;
procedure list_init(var m:tlist); {Инициализация списка с заглавным звеном} begin new(m); m^.next:=nil end;
procedure list_read(var z:tPage); {чтение из файла записи} begin readln(x,z.FIO); readln(x,z.Ul); readln(x,z.Dom); readln(x,z.Kv); readln(x,z.Tel); readln(x,z.Bal); if not eof(x) then readln(x) end;
function more(z1,z2:tPage):boolean; {Сортировка записи по имени каталога и телефону} var t:boolean; begin if z1.Tel<z2.Tel then t:=true else if z1.Tel=z2.Tel then if z1.FIO<z2.FIO then t:=true else if z1.FIO=z2.FIO then t:=true else t:=false else t:=false; more:=t end; procedure list_add(var m:tlist; z:tPage); {Добавление записи в список, c учетом сортировки} var p,q:tlist; begin q:=m; while (q^.next<>nil) and more(q^.next^.Page,z) do q:=q^.next; new(p); p^.Page:=z; p^.next:=q^.next; q^.next:=p end;
procedure list_create(var x:text;var m:tlist); {Формирование списка из файла} begin assign(x,'input.txt'); reset(x); list_init(m); while not eof(x) do begin list_read(z); list_add(m,z) end end; procedure list_print(m:tlist); {Печать списка} begin if m=nil then writeln('konec spiska') else begin writeln(m^.Page.FIO); writeln(m^.Page.Ul); writeln(m^.Page.Dom); writeln(m^.Page.Kv); writeln(m^.Page.Tel); writeln(m^.Page.Bal:3:2); writeln; list_print(m^.next) end end; procedure poisk(m:tlist); var q:tlist; max,k,i:integer; maxop:string[3]; begin q:=m; max:=0; while q<>nil do begin k:=1; while q^.Next^.Page.Tel=q^.Page.Tel do begin k:=k+1; q:=q^.Next end; if k>max then begin max:=k; for i:=1 to 3 do maxop[i]:=q^.page.tel[i] end; q:=q^.Next end; dispose(q); for i:=1 to 3 do writeln('max operator',maxop[i]); writeln('vstrechaetsya', max,'raz'); readln; readln end; begin { TODO -oUser -cConsole Main : Insert code here } list_create(x,spis); Writeln('spisok:'); list_print(spis^.next); poisk(spis); readln; readln end.
Пожалуйста подскажите где ошибка в этой задаче?
TarasBer
25.11.2010 14:30
Перед копированием текста из дельфы выбирай русскую раскладку. Иначе винда не поймёт, какая там кодировка. Поправь сообщение.
мисс_граффити
25.11.2010 14:51
ну для начала - неплохо бы добавить проверку, что файл (из которого ты пытаешься загрузить данные) действительно существует. прикрепи файл, на котором проверяешь...
volvo
25.11.2010 16:33
1) у тебя список из памяти не удаляется - это достаточная ошибка? 2) в процедуре создания списка (чтения из файла, в смысле) лучше сделать цикл не до eof, а до seekeof:
while not seekeof(x) do begin list_read(z); list_add(m,z) end:
, иначе пустые строки в конце будут мешать читать файл, будешь получать ошибки. А функция SeekEof их просто "не видит", поэтому здесь будет лучше использовать именно ее. 3) прочитали список - вывели его. Что ты творишь при поиске?
while q<>nil do begin k:=1; while q^.Next^.Page.Tel=q^.Page.Tel do // <--- Вот здесь !!! begin k:=k+1; q:=q^.Next end;
if k>max then begin max:=k; for i:=1 to 3 do maxop[i]:=q^.page.tel[i] end;
q:=q^.Next // <--- И здесь тоже !!! end;
А если в какой-то момент в первом цикле Q^.next = nil, а ты дальше обращаешься к Q^.Next^.Page? Вылет... А ниже по тексту? Как вообще можно изменять значение указателя, не убедившись, что он валидный? В твоем случае - он должен быть хотя бы не NIL...
Исправляй, дальше посмотрим...
Zigfried
26.11.2010 23:52
Вот вроде исправил,а всеравно вылетает:
program lyalikov21; {Найти телефонную сеть(первые 3 цифры номера),имеющую наибольшее число абонентов} {$APPTYPE CONSOLE} uses SysUtils; type tPage = record FIO: string[30]; Ul: string[20]; Dom,Kv: integer; Tel: string[10]; Bal:single end; tlist=^tElem; tElem = record Page: tPage; Next:tlist end; var Spis:tlist; z:tPage; x:text;
procedure list_init(var m:tlist); {Инициализация списка с заглавным звеном} begin new(m); m^.next:=nil end;
procedure list_read(var z:tPage); {чтение из файла записи} begin readln(x,z.FIO); readln(x,z.Ul); readln(x,z.Dom); readln(x,z.Kv); readln(x,z.Tel); readln(x,z.Bal); if not eof(x) then readln(x) end;
function more(z1,z2:tPage):boolean; {Сортировка записи по имени каталога и телефону} var t:boolean; begin if z1.Tel<z2.Tel then t:=true else if z1.Tel=z2.Tel then if z1.FIO<z2.FIO then t:=true else if z1.FIO=z2.FIO then t:=true else t:=false else t:=false; more:=t end; procedure list_add(var m:tlist; z:tPage); {Добавление записи в список, c учетом сортировки} var p,q:tlist; begin q:=m; while (q^.next<>nil) and more(q^.next^.Page,z) do q:=q^.next; new(p); p^.Page:=z; p^.next:=q^.next; q^.next:=p end;
procedure list_create(var x:text;var m:tlist); {Формирование списка из файла} begin assign(x,'input.txt'); reset(x); list_init(m); while not seekeof(x) do begin list_read(z); list_add(m,z) end end; procedure list_print(m:tlist); {Печать списка} begin if m=nil then writeln('konec spiska') else begin writeln(m^.Page.FIO); writeln(m^.Page.Ul); writeln(m^.Page.Dom); writeln(m^.Page.Kv); writeln(m^.Page.Tel); writeln(m^.Page.Bal:3:2); writeln; list_print(m^.next) end end; procedure poisk(m:tlist); var q:tlist; max,k,i:integer; maxop:string[3]; begin q:=m; max:=0; while q<>nil do begin k:=1; while (q^.Next^.Page.Tel=q^.Page.Tel) and (q^.Next<>nil) do begin k:=k+1; q:=q^.Next end; if k>max then begin max:=k; for i:=1 to 3 do maxop[i]:=q^.page.tel[i] end; q:=q^.Next end; dispose(q); for i:=1 to 3 do writeln('max operator',maxop[i]); writeln('vstrechaetsa',max,'raz'); readln; readln end; procedure del(var m:tlist); {Удаление списка} var p:tlist; begin while m<>nil do begin p:=m; m:=m^.next; dispose(p) end end;
begin { TODO -oUser -cConsole Main : Insert code here } list_create(x,spis); Writeln('spisok:'); list_print(spis^.next); poisk(spis); close(x); del(spis); readln; readln end.
При вылете успел сфотать что выдаёт: Exception EAccessViolation in module lyalikov21.exe at 00008CE2. Access violation at address 00408CE2 in module 'lyalikov21.exe'. Read of address 0000003C.
volvo
27.11.2010 0:28
Что-то ты перемудрил в процедуре Poisk. Смотри:
procedure poisk(m: TList); var q: TList; maxOp: string[3]; k, max: integer; begin q := m^.next; // первый элемент - пропускаем, он заглавный... max := 0; while q <> nil do // а теперь идем по списку... begin k := 1; // считать начинаем с 1, одно-то вхождение все равно есть.
// Здесь внимательно: сначала проверим, существует ли q, потом - // существует ли q^.next, и только потом сравниваем текущий и следующий // элементы списка... while (q <> nil) and (q^.next <> nil) and (copy(q^.page.tel, 1, 3) = copy(q^.next^.page.tel, 1, 3)) do // сравнить первые 3 символа begin inc(k); q := q^.next; end;
if k > max then // тут у тебя все было правильно, только заполни maxop без цикла begin max := k; maxop := copy(q^.page.tel, 1, 3); end;
// а вот это - ключевой момент: продвигаемся дальше - только если k = 1, // то есть, только если внутри предыдущего цикла не было увеличения q... if k = 1 then q := q^.next; end;
Вот это только что прогнал на FPC - не вылетает. Учти, я гонял только до закрытия файла, дальше - тебе еще список удалять надо, ты этого так и не сделал... И не надо q^ удалять в Poisk-е. Ты ж место под него ТАМ не выделял, зачем удаляешь?
Zigfried
27.11.2010 0:40
Спасибо большое,исправил,работает)
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.