Сортировка слиянием в файлах

@romanroman · Регистрация: 24.04.2013

Студворк — интернет-сервис помощи студентам

Не записывает обратно в конечный файл после разбиение одного файла на два других , в чем может быть ошибка?

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
program jf;
 
 
          Var a1,a2,s,i,j,kol,tmp: integer;
          name: string; var f: text;
              f1,f2: text;
              b: boolean;
          Begin
             kol:=0;
 
             Assign(f,'f.txt');
             Reset(f);
             While not EOF(f) do
               begin
                 read(f,a1);
                 inc(kol);
               End;
             Close(f);
 
             Assign(f1,'f1.txt'); {имя 1-го вспомогательного файла}
             Assign(f2,'f2.txt'); {имя 2-го вспомогательного файла}
 
             s:=1;
             While (s<kol) do
               begin
 
                 Reset(f); Rewrite(f1); Rewrite(f2);
                 For i:=1 to kol div 2 do
                   begin
                     Read(f,a1);
                     Write(f1,a1,' ');
                   End;
                 If (kol div 2) mod s<>0 then
                   begin
                     tmp:=kol div 2;
                     While tmp mod s<>0 do
                       begin
                         Read(f,a1);
                         Write(f1,a1,' ');
                         inc(tmp);
                       End;
                   End;
                 While not EOF(f) do
                   begin
                     Read(f,a2);
                     Write(f2,a2,' ');
                   End;
                 Close(f); Close(f1); Close(f2);
 
 
                 Rewrite(f); Reset(f1); Reset(f2);
                 Read(f1,a1); 
                 Read(f2,a2);
                 While (not EOF(f1)) and (not EOF(f2)) do
                   begin
                     i:=0; j:=0;
                     b:=true;
                     While (b) and (not EOF(f1)) and (not EOF(f2)) do
                       begin
                         If (a1<a2) then
                           begin
                             Write(f,a1,' ');
                             Read(f1,a1);
                             inc(i);
                           End
                         else
                           begin
                             Write(f,a2,' ');
                             Read(f2,a2);
                             inc(j);
                           End;
                         If (i=s) or (j=s) then b:=false;
                       End;
                     If not b then
                       begin
                         While (i<s) and (not EOF(f1)) do
                           begin
                             Write(f,a1,' ');
                             Read(f1,a1);
                             inc(i);
                           End;
                         While (j<s) and (not EOF(f2)) do
                           begin
                             Write(f,a2,' ');
                             Read(f2,a2);
                             inc(j);
                           End;
                       End;
                   End;
                 While not EOF(f1) do
                   begin
                     tmp:=a1;
                     Read(f1,a1);
                     If not EOF(f1) then
                       Write(f,tmp,' ')
                     else
                       Write(f,tmp);
                   End;
                 While not EOF(f2) do
                   begin
                     tmp:=a2;
                     Read(f2,a2);
                     If not EOF(f2) then
                       Write(f,tmp,' ')
                     else
                       Write(f,tmp);
                   End;
                 Close(f); Close(f1); Close(f2);
 
                 s:=s*2;
               End;
             Erase(f1);
             Erase(f2);
          End.

Добавлено через 2 минуты
Пишет строка имела неверный формат.

@Puporev · 26.06.2013, 21:29

У меня этот код сработал без всяких ошибок. Возможно у вас исходный файл неверно записан.

@romanroman · 26.06.2013, 23:35 **[ТС]**

у меня в исходном файле 10 чисел в строке, как у вас он записан?
А вот и он.

@Puporev · 27.06.2013, 06:24

Программа нормально компилируется без ошибок, но сортирует неверно. Например этот файл уже отсортирован, а в результате выдает
0 1 3 4 5 6 7 8 9 2 10
но это уже вопрос к алгоритму.
А ошибка у вас выходит наверное потому что файл f.txt не находится в одной папке с программой.
Текстовый файл и файл программы нужно сохранить в одной папке.
Код видимо взят здесь (сортировка простым слиянием)
https://www.cyberforum.ru/redi... QwJTI1QkM=
Там та же ошибка в алгоритме.
А вот ниже, где написано

Сортировка естественным слиянием

код работает правильно.

@romanroman · 27.06.2013, 09:45 **[ТС]**

Вы компилируете на PascalAbc или PascalAbc.net?

@Puporev · 27.06.2013, 09:47

на PascalAbc и Турбо Паскаль

@romanroman · 27.06.2013, 09:52 **[ТС]**

Может ошибка в том, что я компилирую на PascalAbc.net, если вас не затруднит, можете скинуть сам паскаль и программу?

@Puporev · 27.06.2013, 10:01

Так скачайте Паскаль АВС с офф-сайта

Добавлено через 7 минут
Вот я скопировал там код, подправил, все работает в простом АВС

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
uses crt;
          Var s1,s2,a1,a2,where,tmp: integer;
              f,f1,f2: text;
          Begin
             s1:=5; s2:=5; {Можно задать любые числа, которые запустят цикл while}
             Assign(f,'f.txt');
             Assign(f1,'{имя 1-го вспомогательного файла}');
             Assign(f2,'{имя 2-го вспомогательного файла}');
             While (s1>1) and (s2>=1) do
               begin
                 where:=1;
                 s1:=0; s2:=0;
                 Reset(f); Rewrite(f1); Rewrite(f2);
                 Read(f,a1);
                 Write(f1,a1,' ');
                 While not EOF(f) do
                   begin
                     read(f,a2);
                     If (a2<a1) then
                       begin
                         Case where of
                            1: begin
                                 where:=2;
                                 inc(s1);
                               End;
                            2: begin
                                 where:=1;
                                 inc(s2);
                               End;
                         End;
                       End;
                     Case where of
                        1: write(f1,a2,' ');
                        2: write(f2,a2,' ');
                     End;
                     a1:=a2;
                   End;
                 If where=2 then
                   inc(s2)
                 else
                   inc(s1);
                 Close(f); Close(f1); Close(f2);
 
 
                 Rewrite(f); Reset(f1); Reset(f2);
                 Read(f1,a1);
                 Read(f2,a2);
                 While (not EOF(f1)) and (not EOF(f2)) do
                   begin
                     If (a1<=a2) then
                       begin
                         Write(f,a1,' ');
                         Read(f1,a1);
                       End
                     else
                       begin
                         Write(f,a2,' ');
                         Read(f2,a2);
                       End;
                   End;
                 While not EOF(f1) do
                   begin
                     tmp:=a1;
                     Read(f1,a1);
                     If not EOF(f1) then
                        Write(f,tmp,' ')
                     else
                        Write(f,tmp);
                   End;
                 While not EOF(f2) do
                   begin
                     tmp:=a2;
                     Read(f2,a2);
                     If not EOF(f2) then
                        Write(f,tmp,' ')
                     else
                        Write(f,tmp);
                   End;
                 Close(f); Close(f1); Close(f2);
               End;
             Erase(f1);
             Erase(f2);
  write('Файл отсортирован и переписан');
  end.

@romanroman · 27.06.2013, 10:04 **[ТС]**

Вот, что пишет. Все находится в одной папке.

@Puporev · 27.06.2013, 10:09

Я с Паскаль АВС.net не работаю, в простом работает.

@romanroman · 27.06.2013, 10:15 **[ТС]**

Как я и думал, ошибка оказалась в том, что в надо в обычном паскале компилировать ее, спасибо) И еще, можете дать ссылку на него, везде abc.net

@Puporev · 27.06.2013, 10:21

Да наберите в Гугле
скачать паскаль abc
и выбирайте

@romanroman · 27.06.2013, 10:24 **[ТС]**

Все заработало в Abc, спасибо большое.

@ArtemStark · 19.01.2017, 19:04

Спасибо большое, помогли!

Новые блоги и статьи Все статьи Все блоги /
Как я обхитрил таблицу Word Alexander-7 21.03.2026 Когда мигает курсор у внешнего края таблицы, и нам надо перейти на новую строку, а при нажатии Enter создается новый ряд таблицы с ячейками, то мы вместо нервных нажатий Энтеров мы пишем любые буквы. . .	Krabik - рыболовный бот для WoW 3.3.5a AmbA 21.03.2026 без регистрации и смс. Это не торговля, приложение не содержит рекламы. Выполняет свою непосредственную задачу - автоматизацию рыбалки в WoW - и ничего более. Однако если админы будут против -. . .	Программный отбор значений справочника Maks 21.03.2026 Установка программного отбора значений справочника "Сотрудники" из модуля формы документа. В качестве фильтра для отбора служит предопределенное значение перечислений. Процедура. . .	Переходник USB-CAN-GPIO Eddy_Em 20.03.2026 Достаточно давно на работе возникла необходимость в переходнике CAN-USB с гальваноразвязкой, оный и был разработан. Однако, все меня терзала совесть, что аж 48-ногий МК используется так тупо: просто. . .
Оттенки серого Argus19 18.03.2026 Оттенки серого Нашёл в интернете 3 прекрасных модуля: Модуль класса открытия диалога открытия/ сохранения файла на Win32 API; Модуль класса быстрого перекодирования цветного изображения в оттенки. . .	SDL3 для Desktop (MinGW): Рисуем цветные прямоугольники с помощью рисовальщика SDL3 на Си и C++ 8Observer8 17.03.2026 Содержание блога Финальные проекты на Си и на C++: finish-rectangles-sdl3-c. zip finish-rectangles-sdl3-cpp. zip	Символические и жёсткие ссылки в Linux. algri14 15.03.2026 Существует два типа ссылок — символические и жёсткие. Ссылка в Linux — это запись в каталоге, которая может указывать либо на inode «файла-ИСТОЧНИКА», тогда это будет «жёсткая ссылка» (hard link),. . .	[Owen Logic] Поддержание уровня воды в резервуаре количеством включённых насосов: моделирование и выбор регулятора ФедосеевПавел 14.03.2026 Поддержание уровня воды в резервуаре количеством включённых насосов: моделирование и выбор регулятора ВВЕДЕНИЕ Выполняя задание на управление насосной группой заполнения резервуара,. . .

@Puporev Почетный модератор 64315 / 47611 / 32743 Регистрация: 18.05.2008 Сообщений: 115,167
	26.06.2013, 21:29
	У меня этот код сработал без всяких ошибок. Возможно у вас исходный файл неверно записан. 0

@romanroman 0 / 0 / 2 Регистрация: 24.04.2013 Сообщений: 135
	27.06.2013, 09:45 [ТС]
	Вы компилируете на PascalAbc или PascalAbc.net? 0

@Puporev Почетный модератор 64315 / 47611 / 32743 Регистрация: 18.05.2008 Сообщений: 115,167
	27.06.2013, 09:47
	на PascalAbc и Турбо Паскаль 0

@romanroman 0 / 0 / 2 Регистрация: 24.04.2013 Сообщений: 135
	27.06.2013, 09:52 [ТС]
	Может ошибка в том, что я компилирую на PascalAbc.net, если вас не затруднит, можете скинуть сам паскаль и программу? 0

@Puporev Почетный модератор 64315 / 47611 / 32743 Регистрация: 18.05.2008 Сообщений: 115,167
	27.06.2013, 10:09
	Я с Паскаль АВС.net не работаю, в простом работает. 0

@romanroman 0 / 0 / 2 Регистрация: 24.04.2013 Сообщений: 135
	27.06.2013, 10:15 [ТС]
	Как я и думал, ошибка оказалась в том, что в надо в обычном паскале компилировать ее, спасибо) И еще, можете дать ссылку на него, везде abc.net 0

@Puporev Почетный модератор 64315 / 47611 / 32743 Регистрация: 18.05.2008 Сообщений: 115,167
	27.06.2013, 10:21
	Да наберите в Гугле скачать паскаль abc и выбирайте 0

@romanroman 0 / 0 / 2 Регистрация: 24.04.2013 Сообщений: 135
	27.06.2013, 10:24 [ТС]
	Все заработало в Abc, спасибо большое. 0

@ArtemStark 0 / 0 / 1 Регистрация: 04.12.2016 Сообщений: 6
	19.01.2017, 19:04
	Спасибо большое, помогли! 0