IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Исправление ошибок в задаче сортировки и слияния файлов, Ошибки в проге по сортировке файлов и их слиянию. Надо сделать через
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 24
Пол: Женский

Репутация: -  0  +


Доброго времени суток! Помогите исправить ошибки в задаче. Певрый раз пишу такое длинное решение. Условие такое: Создать два файла персон, содержащие записи вида "Алла Борисовна Пугачёва". Отсортировать оба файла в обратном порядке по именам. Написать программу слияния содержимого двух файлов в третий, отсортированный в том же порядке.
Общий костяк программы нам дали на уроке (т. е. список названий процедур и функции). По нему составила программу. Но у меня ошибка: переполнение стека. +Я не понимаю перехода от файла к строке (связки) и связи процедур - могла напутать. Помогите разобраться.

Код
type massive=array[1..100] of string;{Первые три процедуры: чтение, запись в файл и сортировка - входят в процедуру слияния-Сборка}
  procedure read_data(fn:string;
                      var mas:massive;
                          n:integer);
   var f:text;
    begin
     assign(f,fn);
     reset(f);
     n:=0;
     while not eof(f) do
      begin
       n:=n+1;
       read(f,mas[n]);
      end;
     close(f);
    end;
  procedure write_data(fn:string;
                       var mas:massive;
                           n:integer);
   var f:text;
       i:integer;
    begin
     assign(f,fn);
     rewrite(f);
      for i:=1 to n do
       writeln(f,mas[i]);
     close(f);
    end;
  procedure sort_data(mas:massive;
                      n:integer);
   var i,j:integer;
       exchange:string;
    begin
     for i:=1 to n-1 do
      for j:=1 to n-i do
       if mas[j]<mas[j+1] then
        begin
         exchange:=mas[j];
         mas[j]:=mas[j+1];
         mas[j+1]:=exchange;
        end;
    end;
  procedure sort(fn:string);{Процедура слияния. Сборка}
   var mas:massive;
       n:integer;
    begin
     read_data(fn,mas,n);
     sort_data(mas,n);
     write_data(fn,mas,n);
    end;
  procedure copy_files(var f,f_res:text); {При слиянии копирует оставшийся файл (первый или второй) в третий}
   var n:integer;
   begin
    n:=0;
    while not eof(f) do
     begin
      n:=n+1;
      readln(f,n);
      writeln(f_res,n);
     end;
   end;
  function test_files(var f1,f2,f_res:text):boolean; {функция проверки: пустой ли файл, если да, то копируется в третий файл с помощью функции}
   begin
    if eof(f1) then
     begin
      copy_files(f2,f_res);
      test_files:=false;
     end
               else
                if eof(f2) then
                 begin
                  copy_files(f1,f_res);
                  test_files:=false;
                 end
                           else test_files:=true;
    end;
  procedure merge_files(var f1,f2,f_res:text); {процедура слияния}
   var a,b:string;
    begin
     readln(f1,a);
     readln(f2,b);
      while not eof(f1) and not eof(f2) do
       begin
        if a>b then
         begin
          writeln(f_res,a);
          read(f1,a);
         end
        else
         begin
          writeln(f_res,b);
          read(f2,b);
         end;
       end;
     test_files(f1,f2,f_res);
  end;
  procedure merge(fn1,fn2,fn_res:string); {Сборка. Процедура слияния файлов}
   var
    f1,f2,f_res:text;
    a,b:string;
     begin
      assign(f1,fn1);
      reset(f1);
      assign(f2,fn2);
      reset(f2);
      assign(f_res,fn_res);
      rewrite(f_res);
       if test_files(f1,f2,f_res) then
        merge_files(f1,f2,f_res);
      close(f1);
      close(f2);
      close(f_res);
     end;
  
  var a,b,c:text; {основная программа}
   begin
    sort('a.txt');
    sort('b.txt');
    merge('a.txt','b.txt','c.txt');
   end.


Сообщение отредактировано: Natalia -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Natalia, ты даже не подозреваешь, откуда берется ошибка Stack Overflow smile.gif

Немного математики... Сколько будет 256*100? 25600, правда? А теперь зайди в меню Options -> Memory Sizes в Турбо Паскале, и посмотри, какой установлен размер стека по умолчанию (Stack Size)... Я думаю, как всегда - 16384... А ты пытаешься поместить столько, сколько я насчитал. Что будет?

Вот тут это происходит (ты наверняка просто забыла VAR перед описанием mas):
  procedure sort_data(mas:massive;
n:integer);


(25600 - это размер massive: 100 срок, без указания размера каждая занимает 256 байт)
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

Группа: Пользователи
Сообщений: 24
Пол: Женский

Репутация: -  0  +


Спасибо за поправку! Честно, немного путаюсь, когда использовать var... Но теперь ошибка в основной программе, где идёт связка с файлом. Я точно не знаю как это сделать + у меня какая-то некорректная работа с файлами у tp7. Поэтому не знаю - у меня ошибка в написании или уже tp7 глючит (в прошлые разы он мне создавал файл не в своей директории, а на другом диске, где стоит FreePascal)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


просто человек
******

Группа: Пользователи
Сообщений: 3 641
Пол: Женский
Реальное имя: Юлия

Репутация: -  55  +


почему ты в merge_files пишешь:
read(f1,a);
?
Хочешь считать один символ?


--------------------
Все содержимое данного сообщения (кроме цитат) является моим личным скромным мнением и на статус истины в высшей инстанции не претендует.
На вопросы по программированию, физике, математике и т.д. в аське и личке не отвечаю. Даже "один-единственный раз" в виде исключения!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Гость






Natalia, в твоей программе было несколько ошибок (в частности, при чтении из файла нужно было использовать не Read, а ReadLn)... Вот так она работает (с русским языком не тестировал, но английские строки сортирует как положено, обращай внимание на комментарии... Там где перед процедурой стоит OK, я в логике ее работы ничего не менял, если OK не стоит, значит я написал, что изменено, и зачем)

type massive=array[1..100] of string;

procedure read_data(fn:string;
var mas:massive; var n:integer);
var f:text;
begin
assign(f,fn);
reset(f);
n:=0;
while not eof(f) do begin
n:=n+1;
readln(f,mas[n]); { <--- ReadLn }
end;
close(f);
end;

{ OK }
procedure write_data(fn:string;
var mas:massive; n:integer);
var f:text;
i:integer;
begin
assign(f,fn);
rewrite(f);
for i:=1 to n do
writeln(f,mas[i]);
close(f);
end;

{ OK }
procedure sort_data(var mas:massive;
n:integer);
var
i,j:integer;
exchange:string;
begin
for i:=1 to n-1 do
for j:=1 to n-i do
if mas[j]<mas[j+1] then begin
exchange:=mas[j];
mas[j]:=mas[j+1];
mas[j+1]:=exchange;
end;
end;

{ OK }
procedure sort(fn:string);
var
mas:massive;
n:integer;
begin
read_data(fn,mas,n);
sort_data(mas,n);
write_data(fn,mas,n);
end;

procedure copy_files(last: string; var f,f_res:text);
var s: string; { <--- Здесь у тебя зачем-то читались integer-ы }
begin

{ Кроме того, я добавил в параметры еще одну строку, ниже объясню, зачем }
while not eof(f) do begin
readln(f, s);

if (last <> '') and (last > s) then begin
writeln(f_res, last); { Записываем строку last на подходящее место в файл-результат }
last := '';
end;

writeln(f_res, s);
end;

end;

function test_files(a: string; { <--- добавлена строка A как параметр }
var f1,f2,f_res:text):boolean;
begin
{ изначально результат = True, если зашли хоть в один If - будет False }
test_files:=true;

if eof(f1) then begin
copy_files(a, f2,f_res);
test_files:=false;
end;

{ <--- else удален }
if eof(f2) then begin
copy_files(a, f1,f_res);
test_files:=false;
end;

end;

{
Здесь больше всего изменений...
}
procedure merge_files(var f1,f2,f_res:text);
var
a, b:string;
do_it: boolean;

begin
readln(f1,a);
readln(f2,b);

{
Во-первых, цикл не до конца одного из файлов, а пока не изменится эта переменная...
Объясняю, почему: если оставить до конца файла, как было у тебя, то последняя строка
этого файла будет прочитана, но не будет записана в результирующий файл, ибо Eof уже True
}
do_it := true;
while do_it do begin

if a>b then begin
writeln(f_res,a);
writeln(a);
{ Для исправления описанной ранее ситуации делаем так: если Eof сигнализирует о
конце файла, то меняем переменную по которой идет цикл, чтобы на следующей
итерации цикл закончить. Кроме этого, это означает, что ВЕСЬ файл полностью
прочитан и записан в файл-результат, поэтому строку A обнуляем.

Если же Eof не показывает конец файла, то просто читаем из него след. строку }
if eof(f1) then begin
do_it := false;
a := '';
end
else readln(f1,a);
end
else begin
writeln(f_res,b);
writeln(b);

{ то же самое, что описано выше }
if eof(f2) then begin
do_it := false;
b := '';
end
else readln(f2,b);
end;

end;
{
А вот теперь ситуация такая: один из файлов прочитан полностью, а второй...
Либо в нем оставалась одна строка, и она уже прочитана в переменную A или B,
при этом конец файла уже достигнут, и Eof для этого файла вернет True (теперь
ты понимаешь, почему нельзя было оставить то, что было раньше? теряли одну строку);

либо во втором файле осталось еще несколько строк, и конец файла не достигнут.
В любом случае или строка A или строка B (только ОДНА из них !!!) содержат непустую
строку. Вот ее мы и передаем в процедуру test_files, чтобы вставить на нужное место
в результарующем файле
}
if a = '' then
test_files(b,f1,f2,f_res)
else
test_files(a,f1,f2,f_res)
end;

procedure merge(fn1,fn2,fn_res:string);
var
f1,f2,f_res:text;
a,b:string;
begin
assign(f1,fn1); reset(f1);
assign(f2,fn2); reset(f2);

assign(f_res,fn_res); rewrite(f_res);
if test_files('', f1,f2,f_res) then { <--- Здесь пустая строка добавлена, чтобы программа компилировалась }
merge_files(f1,f2,f_res);

close(f_res);
close(f2);
close(f1);
end;

var a,b,c:text;
begin
sort('a.txt');
sort('b.txt');
merge('a.txt','b.txt','c.txt');
end.


Вот и все smile.gif Вроде, ничего не упустил... Будут вопросы или обнаружишь неправильную работу - обращайся, исправим smile.gif
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Новичок
*

Группа: Пользователи
Сообщений: 24
Пол: Женский

Репутация: -  0  +


Спасибо огромное. smile.gif Разобралась немного. Объяснили как раз те вещи, в которых я плаваю. Сейчас вот переправляю, перепробую все. give_rose.gif
К сожалению у меня снова та же ошибка-не могу её понять: variable identifier expected (указывает на ошибку в файлах в основной программе...)
Утром попробую в институте - может получится)

Сообщение отредактировано: Natalia -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

Репутация: -  159  +


Цитата(Natalia @ 21.11.2006 4:52) *

К сожалению у меня снова та же ошибка-не могу её понять: variable identifier expected (указывает на ошибку в файлах в основной программе...)

При этом указывает на строку с присваиванием значения функции? Если так, то это компиляция с опцией совместимости с Delphy. Если ты на FPC, то зайди в Options - Compiler - Syntax и поставь совместимость с TP7 и убери совместимость с Delphy. После этого лучше всего перезапустить FPC.


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Гость






Цитата
Если ты на FPC, то зайди в Options - Compiler - Syntax и поставь совместимость с TP7 и убери совместимость с Delphy
Совершенно не обязательно привязываться к настройкам среды...

{$mode TP}

первой строкой программы делает то же самое, только будет работать у всех, а не только там, где это разрешено в IDE...

Кстати, по поводу ошибки:
В TP действительно будет опять ошибка: Переполнение стека... Вот тут:
procedure sort(fn:string);
var
mas:massive; { <--- !!! }
n:integer;
...

(локальные переменные создаются именно в стеке, а я тебе уже показал, почему создание massive в стеке недопустимо)... Выход - перенести описание mas чуть выше:
{ OK }
var
mas:massive; { <--- }

procedure sort(fn:string);
var
n:integer;
begin
read_data(fn,mas,n);
sort_data(mas,n);
write_data(fn,mas,n);
end;
, тогда этот массив (как глобальная переменная) будет размещен уже не в стеке, а в сегменте данных, а его размер ограничен 64К, так что место еще есть smile.gif

Программа с этими исправлениями нормально отрабатывает как в ТР, так и в FPC...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Новичок
*

Группа: Пользователи
Сообщений: 24
Пол: Женский

Репутация: -  0  +


Здравствуйте! Спасибо за разъяснения - изменила опции в fpc. Также поменяла директивы, чтоб не путать (tp7 и fpc).
У меня забавная получается ситуация: на ТР программа вроде выполнятеся, но при этом файлы В и А обнуляются, а С остаётся пустым. А если выполнять программу на FPC, то в файлах остаётся по одной строке, а в С записывается только одна строка. Ничего не понимаю! wacko.gif

Сообщение отредактировано: Natalia -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Гость






blink.gif blink.gif
Цитата
файлы В и А обнуляются
А попробуй-ка сделать вот что... Закомментируй строку
var a,b,c:text;
begin
sort('a.txt');
sort('b.txt');
{ merge('a.txt','b.txt','c.txt'); } { <--- вот так !!! }
end.
и попробуй прогнать программу... Потом зайди в файлы A и B и посмотри, отсортировались ли они, или нет... Что-то непонятное у тебя происходит...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Новичок
*

Группа: Пользователи
Сообщений: 24
Пол: Женский

Репутация: -  0  +


A и B обнулились, но с даже не был создан... ( в TP7). А в FPC осталось по строчке в файлах, а С не был создан.

Сообщение отредактировано: Natalia -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Гость






Присоединяй сюда свою программу в виде файла... Что-то ты намудрила в одной из процедур:
read_data, sort_data или write_data... С теми процедурами, которые привел я такой результат получить невозможно...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Новичок
*

Группа: Пользователи
Сообщений: 24
Пол: Женский

Репутация: -  0  +


Вот файл...


Прикрепленные файлы
Прикрепленный файл  MERGE.PAS ( 3.08 килобайт ) Кол-во скачиваний: 155
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Гость






Ну, а я что говорил:

procedure read_data(fn:string;
var mas:massive;
n:integer); { <--- Как ты думаешь, N вернется назад, в sort ? }
Мне почему-то кажется, что не вернется... Из-за этого происходит следующее: Ты читаешь все данные, только вот количества прочитанных строк не получаешь. Остается 0 (хотя могла быть и любое другое число - "мусор" - потому, что ЛОКАЛЬНЫЕ переменные компилятором не инициализируются, они создаются в стеке, и то, что там было ДО этого, так и остается. Скорее всего, в случае FPC так и произошло: в N случайно оказалась единица...)...

Дальше - пытаешься сортировать данные. Поскольку N = 0, никакой сортировки не происходит...

Еще дальше - пытаешься перезаписать данные. Опять же N = 0, цикл не выполняется, ничего не записывается, однако файлы A и B уже открыты через ReWrite, а следовательно - очищены...

Добавляй VAR...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #15


Новичок
*

Группа: Пользователи
Сообщений: 24
Пол: Женский

Репутация: -  0  +


Добрый вечер! Всё получилось! smile.gif Здорово! Спасибо! Мне почему-то казалось, что var распространяется на все переменные после себя. Мне это хороший урок и тренировка по процедурам.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 25.10.2020 3:31
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name