3 / 3 / 1
Регистрация: 07.11.2013
Сообщений: 49
1

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

24.02.2014, 19:31. Показов 4231. Ответов 39

Author24 — интернет-сервис помощи студентам
Запрограммировать получение нового текстового файла, в котором все слова во всех предложениях записаны в обратном порядке. В программе установить максимальный размер стека равным 10.

Текст большой, поэтому выложу последнее предложение, в котором слов больше 10.

"Тайник я создал пару дней назад, незаконно использовав один из компьютеров транспортного управления з кавказской железной дороги."

Я мучаюсь уже довольно долго с этой проблемой, вот пытался что-то написать, но всё равно переполнение не удается обойти.

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
uses crt;
const
  MaxStek = 10;
var
  a: array[1..MaxStek] of string;
  t, g: text;
  i, n, k, q, st: integer;
  s, m: string;
 
procedure POP;
begin
  write(g, a[q], ' ');
  a[q] := '';
  q := q - 1;
  writeln ('Из стека убрано значение. Текущее количество элементов в стеке: ',q)
end;
 
procedure PUSH(str: string);
begin
  q := q + 1;
  a[q] := str;
  writeln ('В стек помещено значение. Текущее количество элементов в стеке:',q)
end;
 
begin
  assign(g, 'g.txt');
  rewrite(g);
  assign(t, 'k.txt'); {исходный файл}
  reset(t);
 
  m:= '';
 
  while not EOF(t) do begin
    readln(t, s);
    if (Length(s)>0) and (s[Length(s)]<>' ') then s := s + ' ';
    k:= 0;
    n:= 1;
    i:= 0;
    for n:= 1 to length(s) do begin
      i:= n - k; 
 
      if (s[n] = ' ') then begin 
        m := copy(s, k, i);
        k := n; 
      end;
 
      if (m <> '') and (q <= MaxStek) then begin 
        PUSH(m);
        m:= '';
      end;
 
      if q = MaxStek then begin
        for st := 1 to q do
          POP;
        writeln(g);
      end;
 
    end;
 
  end;
 
if q<>0 then begin
for i:=1 to q do
POP()
end;
 
  close(g);
  close(t);
end.
Вот результат выполнения программы, но это неверно:
" из один использовав незаконно назад, дней пару создал я Тайник
дороги. железной кавказской з управления транспортного компьютеров
"
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
24.02.2014, 19:31
Ответы с готовыми решениями:

Получить новый файл, в котором все слова во всех предложениях исходного файла, записаны в обратном порядке
1)На языке программирования Pascal реализовать процедуры работы со стеком на последовательном...

Напечатать все элементы файла, в котором записаны отдельные слова
Напечатать все элементы файла, в котором записаны отдельные слова. Известно, что в существующем...

Слова в обратном порядке в предложениях
Здравствуйте! Есть задачка, поменять слова в предложениях в обратном порядке при минимальном...

Сформировать второй массив, в котором элементы записаны в обратном порядке
помогите сформулировать второй массив, в котором элементы записаны в обратном порядке...

39
13104 / 5885 / 1706
Регистрация: 19.09.2009
Сообщений: 8,808
26.02.2014, 16:55 2
Лучший ответ Сообщение было отмечено CrazyDrummer13 как решение

Решение

Эту задачу можно решать в упрощённом виде или без упрощения. В упрощённом виде - это когда в выходной файл не записываются знаки препинания и отступы. В этом случае достаточно использовать один стек - в него будут записываться слова предложений. Если решать без упрощения, то понадобится использовать стек и очередь или 2 стека. Если порядок следования знаков препинания не надо менять, тогда понадобится стек и очередь. В стек будут записываться слова предложений, а в очередь - части текста, расположенные между словами. Если порядок следования знаков препинания (и отступов) тоже надо поменять местами - тогда следует использовать 2 стека - один для слов, другой - для частей текста между словами.

Если принять упрощённый способ, то решить можно так. Здесь в выходном файле каждое предложение записывается на отдельной строке.
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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
program Project1;
 
type
  {Основные данные элемента стека.}
  TData = String;
  {Указатель на элемент стека.}
  TPElem = ^TElem;
  {Элемент стека.}
  TElem = record
    Data : TData;   {Основные данные.}
    PNext : TPElem; {Указатель на следующий элемент стека.}
  end;
  {Для стека отдельный тип можно не создавать. Стек будет представлен в виде
  указателя на элемент, который расположен на вершине стека. Поэтому, переменная,
  представляющая стек, будет иметь тип TPElem.}
 
{Стек.}
 
{Добавление элемента на вершину стека.}
procedure Push(var aPSt : TPElem; const aData : TData);
var
  PElem : TPElem;
begin
  New(PElem); {Выделение памяти для нового элемента.}
  PElem^.Data := aData; {Записываем основные данные.}
  {Прикрепляем к новому элементу первый элемент стека. Таким образом, новый
  элемент оказывается на вершине стека.}
  PElem^.PNext := aPSt;
  {В переменную стека записываем указатель на вершину стека - т. е., на новый элемент.}
  aPSt := PElem;
end;
 
{Изъятие элемента с вершины стека.
Если стек не пуст, то с вершины стека изымается элемент и его значение
(основные данные) возвращается через параметр aData. В этом случае, функция
возвращает значение True. Если стек пуст, то операция отменяется, а функция
возвращает значение False.}
function Pop(var aPSt : TPElem; var aData : TData) : Boolean;
var
  PElem : TPElem;
begin
  Pop := False;
  if aPSt <> nil then
  begin
    PElem := aPSt; {Получаем указатель на тот элемент, который находится на вершине стека.}
    aData := PElem^.Data; {Читаем основные данные элемента.}
    {Указатель стека теперь будет указывать на второй элемент. Таким образом,
    второй элемент теперь оказывается на вершине стека.}
    aPSt := PElem^.PNext;
    Dispose(PElem); {Освобождаем память, занятую под элемент, который раньше был на вершине стека.}
    Pop := True;
  end;
end;
 
{Освобождение памяти, занятой для стека (очистка стека).}
procedure StFree(var aPSt : TPElem);
var
  Data : TData;
begin
  while Pop(aPSt, Data) do;
end;
 
const
  {Имена входного и выходного файлов.}
  FnIn = 'file_in.txt';
  FnOut = 'file_out.txt';
  {Разделители слов.}
  Dw = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
  {Разделители предложений.}
  Doff = ['.', '!', '?'];
var
  FIn, FOut : Text;
  PSt : TPElem; {Стек.}
  S, Sw : String;
  i, Len, LenW, Cnt : Integer;
begin
  {Начальная инициализация стека.}
  PSt := nil;
  {Связываем файловые переменные с именами файлов.}
  Assign(FIn, FnIn);
  Assign(FOut, FnOut);
 
  repeat
    Writeln('Входной файл: ', FnIn);
    Writeln('Выходной файл: ', FnIn);
    Writeln('Выполнить обработку - д, Д, y, Y. Любой другой символ - выход.');
    Readln(S);
    if (S = '') or not (S[1] in ['д', 'Д', 'y', 'Y']) then
      Break;
 
    {Открываем файлы.}
    Reset(FIn);
    Rewrite(FOut);
    {Читаем построчно данные из входного файла. При этом отслеживаем предложения
    и слова. Слова складываем в стек. Как только обнаружится конец предложения,
    слова изымаем из стека и записываем их в выходной файл в виде отдельного
    предложения.}
    while not Eof(FIn) do
    begin
      {Читаем очередную строку из файла.}
      Readln(FIn, S);
      Len := Length(S);
      {Посимвольно просматриваем строку. Найденные слова записываем в стек.
      И каждый раз, когда нам будет встречаться конец предложения, мы будем
      извлекать все слова из стека и записывать их в выходной файл. Таким образом
      в выходном файле слова предложений будут оказываться в обратном порядке.}
      LenW := 0;
      for i := 1 to Len do
      begin
        {Обработка слов.}
        {Если символ не является разделителем, значит он принадлежит слову.}
        if not (S[i] in Dw) then
        begin
          Inc(LenW); {Учитываем очередной символ в длине слова.}
          if (i = Len) or (S[i + 1] in Dw) then {Отслеживаем конец слова.}
          begin
            Push(PSt, Copy(S, i - LenW + 1, LenW)); {Добавляем слово в стек.}
            LenW := 0; {Сброс длины слова.}
          end;
        end;
        {Обработка предложений.}
        {Если мы обнаружили конец предложения.}
        if (S[i] in Doff) or (Eof(FIn) and (i = Len)) then
        begin
          {Извлекаем из стека слова и записываем их в выходной файл.}
          Cnt := 0;
          while Pop(PSt, Sw) do
          begin
            Inc(Cnt);
            if Cnt > 1 then
              Write(FOut, ' ');
            Write(FOut, Sw);
          end;
          {Дописываем знак конца предложения, если он присутствует (в конце
          файла знак конца предложения может отсутствовать, например, по ошибке автора).}
          if S[i] in Doff then
            Write(FOut, S[i]);
          {Записываем перевод строки.}
          if not Eof(FIn) then
            Writeln(FOut);
        end;
      end;
    end;
 
    {Закрываем файлы.}
    Close(FIn);
    Close(FOut);
    {Освобождение памяти, занятой для стека.}
    StFree(PSt);
    Writeln('Обработка завершена.');
    Writeln('Память, выделенная для стека, освобождена.');
    Writeln;
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.
Например, если входной файл содержит следующий текст:
Тайник я создал пару дней
назад, незаконно использовав один из компьютеров
транспортного управления кавказской железной дороги.
И ещё раз о том же самом.
Тайник я создал пару дней
назад, незаконно использовав один из компьютеров
транспортного управления кавказской железной дороги!
То в выходной файл программа запишет следующее:
дороги железной кавказской управления транспортного компьютеров из один использовав незаконно назад дней пару создал я Тайник.
самом же том о раз ещё И.
дороги железной кавказской управления транспортного компьютеров из один использовав незаконно назад дней пару создал я Тайник!
1
3 / 3 / 1
Регистрация: 07.11.2013
Сообщений: 49
26.02.2014, 18:30  [ТС] 3
спасибо большое, буду разбираться с вашим кодом. Хотелось бы ещё реализацию на 2 стека увидеть.

Добавлено через 10 минут
А здесь учитывается главное условие - размерность стека?
0
13104 / 5885 / 1706
Регистрация: 19.09.2009
Сообщений: 8,808
26.02.2014, 21:32 4
Цитата Сообщение от CrazyDrummer13 Посмотреть сообщение
А здесь учитывается главное условие - размерность стека?
В том коде - не учитывается. Если надо задать ограничение глубины стека, можно сделать так:
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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
program Project1;
 
const
  StMaxSize = 10; {Наибольшая глубина стека.}
  
type
  {Основные данные элемента стека.}
  TData = String;
  {Указатель на элемент стека.}
  TPElem = ^TElem;
  {Элемент стека.}
  TElem = record
    Data : TData;   {Основные данные.}
    PNext : TPElem; {Указатель на следующий элемент стека.}
  end;
  {Тип, описывающий стек.}
  TStack = record
    PTop : TPElem; {Указатель на вершину стека.}
    Cnt : Integer; {Количество элементов в стеке.}
  end;
 
{Стек.}
 
{Инициализация стека. Эту процедуру можно выполнять только в отношении
заведомо пустого стека. Иначе, будут утечки памяти.}
procedure StInit(var aSt : TStack);
begin
  aSt.PTop := nil;
  aSt.Cnt := 0;
end;
 
{Добавление элемента на вершину стека.
Если в стеке есть свободное место (количество элементов в стеке меньше,
чем StMaxSize), то новый элемент добавляется на вершину стека и функция
возвращает значение True.
Если в стеке свободного места нет, то действие отменяется и функция возвращает
значение False.}
function Push(var aSt : TStack; const aData : TData) : Boolean;
var
  PElem : TPElem;
begin
  Push := False;
  if aSt.Cnt < StMaxSize then
  begin
    New(PElem); {Выделение памяти для нового элемента.}
    PElem^.Data := aData; {Записываем основные данные.}
    {Прикрепляем к новому элементу первый элемент стека. Таким образом, новый
    элемент оказывается на вершине стека.}
    PElem^.PNext := aSt.PTop;
    {В переменную стека записываем указатель на вершину стека - т. е., на новый элемент.}
    aSt.PTop := PElem;
    Inc(aSt.Cnt); {Отмечаем, что количество элементов в стеке стало на 1 больше.}
    Push := True;
  end;
end;
 
{Изъятие элемента с вершины стека.
Если стек не пуст, то с вершины стека изымается элемент и его значение
(основные данные) возвращается через параметр aData. В этом случае, функция
возвращает значение True. Если стек пуст, то операция отменяется, а функция
возвращает значение False.}
function Pop(var aSt : TStack; var aData : TData) : Boolean;
var
  PElem : TPElem;
begin
  Pop := False;
  if aSt.PTop <> nil then
  begin
    PElem := aSt.PTop; {Получаем указатель на тот элемент, который находится на вершине стека.}
    aData := PElem^.Data; {Читаем основные данные элемента.}
    {Указатель стека теперь будет указывать на второй элемент. Таким образом,
    второй элемент теперь оказывается на вершине стека.}
    aSt.PTop := PElem^.PNext;
    Dispose(PElem); {Освобождаем память, занятую под элемент, который раньше был на вершине стека.}
    Dec(aSt.Cnt); {Отмечаем, что количество элементов в стеке стало на 1 меньше.}
    Pop := True;
  end;
end;
 
{Освобождение памяти, занятой для стека (очистка стека).}
procedure StFree(var aSt : TStack);
var
  Data : TData;
begin
  while Pop(aSt, Data) do;
end;
 
const
  {Имена входного и выходного файлов.}
  FnIn = 'file_in.txt';
  FnOut = 'file_out.txt';
  {Разделители слов.}
  Dw = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
  {Разделители предложений.}
  Doff = ['.', '!', '?'];
var
  FIn, FOut : Text;
  St : TStack; {Стек.}
  S, Data : String;
  i, Len, LenW, Cnt : Integer;
  IsAdd : Boolean; {True - элемент добавлен в стек, False - произошло переполнение стека.}
begin
  {Начальная инициализация стека.}
  StInit(St);
  {Связываем файловые переменные с именами файлов.}
  Assign(FIn, FnIn);
  Assign(FOut, FnOut);
 
  repeat
    Writeln('Входной файл: ', FnIn);
    Writeln('Выходной файл: ', FnOut);
    Writeln('Выполнить обработку - д, Д, y, Y. Любой другой символ - выход.');
    Readln(S);
    if (S = '') or not (S[1] in ['д', 'Д', 'y', 'Y']) then
      Break;
 
    {Открываем файлы.}
    Reset(FIn);
    Rewrite(FOut);
    {Читаем построчно данные из входного файла. При этом отслеживаем предложения
    и слова. Слова складываем в стек. Как только обнаружится конец предложения,
    слова изымаем из стека и записываем их в выходной файл в виде отдельного
    предложения.}
    IsAdd := True;
    while not Eof(FIn) do
    begin
      {Читаем очередную строку из файла.}
      Readln(FIn, S);
      Len := Length(S);
      {Посимвольно просматриваем строку. Найденные слова записываем в стек.
      И каждый раз, когда нам будет встречаться конец предложения, мы будем
      извлекать все слова из стека и записывать их в выходной файл. Таким образом
      в выходном файле слова предложений будут оказываться в обратном порядке.}
      LenW := 0;
      for i := 1 to Len do
      begin
        {Обработка слов.}
        {Если символ не является разделителем, значит он принадлежит слову.}
        if not (S[i] in Dw) then
        begin
          Inc(LenW); {Учитываем очередной символ в длине слова.}
          if (i = Len) or (S[i + 1] in Dw) then {Отслеживаем конец слова.}
          begin
            IsAdd := Push(St, Copy(S, i - LenW + 1, LenW)); {Добавляем слово в стек.}
            LenW := 0; {Сброс длины слова.}
          end;
        end;
        {Обработка предложений.}
        {Если мы обнаружили конец предложения.}
        if (S[i] in Doff) or (Eof(FIn) and (i = Len)) then
        begin
          {Если было переполнение стека, значит некоторые слова в конце предложения
          в стек не попали. Извещаем об этом путём записи в выходной файл
          текста '(*!!!Переполнение!!!*)' - на том месте, где должны были находиться
          не уместившиеся слова.}
          Cnt := 0;
          if not IsAdd then
          begin
            Write(FOut, '(*!!!Переполнение!!!*)');
            Inc(Cnt);
          end;
          {Извлекаем из стека слова и записываем их в выходной файл.}
          while Pop(St, Data) do
          begin
            Inc(Cnt);
            if Cnt > 1 then
              Write(FOut, ' ');
            Write(FOut, Data);
          end;
          {Дописываем знак конца предложения, если он присутствует (в конце
          файла знак конца предложения может отсутствовать, например, по ошибке автора).}
          if S[i] in Doff then
            Write(FOut, S[i]);
          {Записываем перевод строки.}
          if not Eof(FIn) then
            Writeln(FOut);
        end;
      end;
    end;
 
    {Закрываем файлы.}
    Close(FIn);
    Close(FOut);
    {Освобождение памяти, занятой для стека.}
    StFree(St);
    Writeln('Обработка завершена.');
    Writeln('Память, выделенная для стека, освобождена.');
    Writeln;
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.
Результат работы программы:
Текст во входном файле:
Тайник я создал пару дней
назад, незаконно использовав один из компьютеров
транспортного управления кавказской железной дороги.
И ещё раз о том же самом.
Тайник я создал пару дней
назад, незаконно использовав один из компьютеров
транспортного управления кавказской железной дороги!
Текст, записанный программой в выходной файл:
(*!!!Переполнение!!!*) из один использовав незаконно назад дней пару создал я Тайник.
самом же том о раз ещё И.
(*!!!Переполнение!!!*) из один использовав незаконно назад дней пару создал я Тайник!
0
3 / 3 / 1
Регистрация: 07.11.2013
Сообщений: 49
27.02.2014, 00:48  [ТС] 5
Дело в том, что не нужно, чтобы вместо текста показывало "переполнение".. Нужно чтобы текст и дальше шёл.
0
13104 / 5885 / 1706
Регистрация: 19.09.2009
Сообщений: 8,808
27.02.2014, 11:17 6
Тогда нужно убрать строки, где выполняется вывод этого сообщения и надо убрать переменную IsAdd:
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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
program Project1;
 
const
  StMaxSize = 10; {Наибольшая глубина стека.}
  
type
  {Основные данные элемента стека.}
  TData = String;
  {Указатель на элемент стека.}
  TPElem = ^TElem;
  {Элемент стека.}
  TElem = record
    Data : TData;   {Основные данные.}
    PNext : TPElem; {Указатель на следующий элемент стека.}
  end;
  {Тип, описывающий стек.}
  TStack = record
    PTop : TPElem; {Указатель на вершину стека.}
    Cnt : Integer; {Количество элементов в стеке.}
  end;
 
{Стек.}
 
{Инициализация стека. Эту процедуру можно выполнять только в отношении
заведомо пустого стека. Иначе, будут утечки памяти.}
procedure StInit(var aSt : TStack);
begin
  aSt.PTop := nil;
  aSt.Cnt := 0;
end;
 
{Добавление элемента на вершину стека.
Если в стеке есть свободное место (количество элементов в стеке меньше,
чем StMaxSize), то новый элемент добавляется на вершину стека и функция
возвращает значение True.
Если в стеке свободного места нет, то действие отменяется и функция возвращает
значение False.}
function Push(var aSt : TStack; const aData : TData) : Boolean;
var
  PElem : TPElem;
begin
  Push := False;
  if aSt.Cnt < StMaxSize then
  begin
    New(PElem); {Выделение памяти для нового элемента.}
    PElem^.Data := aData; {Записываем основные данные.}
    {Прикрепляем к новому элементу первый элемент стека. Таким образом, новый
    элемент оказывается на вершине стека.}
    PElem^.PNext := aSt.PTop;
    {В переменную стека записываем указатель на вершину стека - т. е., на новый элемент.}
    aSt.PTop := PElem;
    Inc(aSt.Cnt); {Отмечаем, что количество элементов в стеке стало на 1 больше.}
    Push := True;
  end;
end;
 
{Изъятие элемента с вершины стека.
Если стек не пуст, то с вершины стека изымается элемент и его значение
(основные данные) возвращается через параметр aData. В этом случае, функция
возвращает значение True. Если стек пуст, то операция отменяется, а функция
возвращает значение False.}
function Pop(var aSt : TStack; var aData : TData) : Boolean;
var
  PElem : TPElem;
begin
  Pop := False;
  if aSt.PTop <> nil then
  begin
    PElem := aSt.PTop; {Получаем указатель на тот элемент, который находится на вершине стека.}
    aData := PElem^.Data; {Читаем основные данные элемента.}
    {Указатель стека теперь будет указывать на второй элемент. Таким образом,
    второй элемент теперь оказывается на вершине стека.}
    aSt.PTop := PElem^.PNext;
    Dispose(PElem); {Освобождаем память, занятую под элемент, который раньше был на вершине стека.}
    Dec(aSt.Cnt); {Отмечаем, что количество элементов в стеке стало на 1 меньше.}
    Pop := True;
  end;
end;
 
{Освобождение памяти, занятой для стека (очистка стека).}
procedure StFree(var aSt : TStack);
var
  Data : TData;
begin
  while Pop(aSt, Data) do;
end;
 
const
  {Имена входного и выходного файлов.}
  FnIn = 'file_in.txt';
  FnOut = 'file_out.txt';
  {Разделители слов.}
  Dw = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
  {Разделители предложений.}
  Doff = ['.', '!', '?'];
var
  FIn, FOut : Text;
  St : TStack; {Стек.}
  S, Data : String;
  i, Len, LenW, Cnt : Integer;
begin
  {Начальная инициализация стека.}
  StInit(St);
  {Связываем файловые переменные с именами файлов.}
  Assign(FIn, FnIn);
  Assign(FOut, FnOut);
 
  repeat
    Writeln('Входной файл: ', FnIn);
    Writeln('Выходной файл: ', FnOut);
    Writeln('Выполнить обработку - д, Д, y, Y. Любой другой символ - выход.');
    Readln(S);
    if (S = '') or not (S[1] in ['д', 'Д', 'y', 'Y']) then
      Break;
 
    {Открываем файлы.}
    Reset(FIn);
    Rewrite(FOut);
    {Читаем построчно данные из входного файла. При этом отслеживаем предложения
    и слова. Слова складываем в стек. Как только обнаружится конец предложения,
    слова изымаем из стека и записываем их в выходной файл в виде отдельного
    предложения.}
    while not Eof(FIn) do
    begin
      {Читаем очередную строку из файла.}
      Readln(FIn, S);
      Len := Length(S);
      {Посимвольно просматриваем строку. Найденные слова записываем в стек.
      И каждый раз, когда нам будет встречаться конец предложения, мы будем
      извлекать все слова из стека и записывать их в выходной файл. Таким образом
      в выходном файле слова предложений будут оказываться в обратном порядке.}
      LenW := 0;
      for i := 1 to Len do
      begin
        {Обработка слов.}
        {Если символ не является разделителем, значит он принадлежит слову.}
        if not (S[i] in Dw) then
        begin
          Inc(LenW); {Учитываем очередной символ в длине слова.}
          if (i = Len) or (S[i + 1] in Dw) then {Отслеживаем конец слова.}
          begin
            {Добавляем слово в стек. Слово добавится только, если в стеке есть
            свободное место.}
            Push(St, Copy(S, i - LenW + 1, LenW));
            LenW := 0; {Сброс длины слова.}
          end;
        end;
        {Обработка предложений.}
        {Если мы обнаружили конец предложения.}
        if (S[i] in Doff) or (Eof(FIn) and (i = Len)) then
        begin
          {Извлекаем из стека слова и записываем их в выходной файл.}
          Cnt := 0;
          while Pop(St, Data) do
          begin
            Inc(Cnt);
            if Cnt > 1 then
              Write(FOut, ' ');
            Write(FOut, Data);
          end;
          {Дописываем знак конца предложения, если он присутствует (в конце
          файла знак конца предложения может отсутствовать, например, по ошибке автора).}
          if S[i] in Doff then
            Write(FOut, S[i]);
          {Записываем перевод строки.}
          if not Eof(FIn) then
            Writeln(FOut);
        end;
      end;
    end;
 
    {Закрываем файлы.}
    Close(FIn);
    Close(FOut);
    {Освобождение памяти, занятой для стека.}
    StFree(St);
    Writeln('Обработка завершена.');
    Writeln('Память, выделенная для стека, освобождена.');
    Writeln;
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.
Добавлено через 7 часов 20 минут
Цитата Сообщение от CrazyDrummer13 Посмотреть сообщение
Хотелось бы ещё реализацию на 2 стека увидеть.
Я подумал на эту тему. В общем, удобнее будет обойтись одним стеком. В один и тот же стек будем складывать и слова и части текста, расположенные между слов - я их "междусловиями" назвал. И надо учитывать, что при записи в выходной файл, слова мы должны записывать как есть, а междусловия должны переворачивать. Я попробовал сделать таким образом. Результат получился правильный, но текст в выходном файле может получаться неудобным для чтения. Это связано с тем, что переносы строк тоже меняют своё положение. Чтобы текст выглядел аккуратным, понадобилось сделать следующее:
- Переносы строк внутри предложений заменяются на пробелы.
- Смежные междусловия, разделённые переносами - склеиваются.
- Те переносы, которые встречаются в начале предложений - не учитываются.
- В выходном тексте каждое предложение записывается на отдельной строке.
С учётом этого получилось следующее:
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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
program Project1;
 
type
  {Основные данные элемента стека.}
  TData = String;
  {Указатель на элемент стека.}
  TPElem = ^TElem;
  {Элемент стека.}
  TElem = record
    Data : TData;   {Основные данные.}
    PNext : TPElem; {Указатель на следующий элемент стека.}
  end;
  {Для стека отдельный тип можно не создавать. Стек будет представлен в виде
  указателя на элемент, который расположен на вершине стека. Поэтому, переменная,
  представляющая стек, будет иметь тип TPElem.}
 
{Стек.}
 
{Добавление элемента на вершину стека.}
procedure Push(var aPSt : TPElem; const aData : TData);
var
  PElem : TPElem;
begin
  New(PElem); {Выделение памяти для нового элемента.}
  PElem^.Data := aData; {Записываем основные данные.}
  {Прикрепляем к новому элементу первый элемент стека. Таким образом, новый
  элемент оказывается на вершине стека.}
  PElem^.PNext := aPSt;
  {В переменную стека записываем указатель на вершину стека - т. е., на новый элемент.}
  aPSt := PElem;
end;
 
{Изъятие элемента с вершины стека.
Если стек не пуст, то с вершины стека изымается элемент и его значение
(основные данные) возвращается через параметр aData. В этом случае, функция
возвращает значение True. Если стек пуст, то операция отменяется, а функция
возвращает значение False.}
function Pop(var aPSt : TPElem; var aData : TData) : Boolean;
var
  PElem : TPElem;
begin
  Pop := False;
  if aPSt <> nil then
  begin
    PElem := aPSt; {Получаем указатель на тот элемент, который находится на вершине стека.}
    aData := PElem^.Data; {Читаем основные данные элемента.}
    {Указатель стека теперь будет указывать на второй элемент. Таким образом,
    второй элемент теперь оказывается на вершине стека.}
    aPSt := PElem^.PNext;
    Dispose(PElem); {Освобождаем память, занятую под элемент, который раньше был на вершине стека.}
    Pop := True;
  end;
end;
 
{Освобождение памяти, занятой для стека (очистка стека).}
procedure StFree(var aPSt : TPElem);
var
  Data : TData;
begin
  while Pop(aPSt, Data) do;
end;
 
const
  {Имена входного и выходного файлов.}
  FnIn = 'file_in.txt';
  FnOut = 'file_out.txt';
  {Разделители слов.}
  Dw = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
  {Разделители предложений.}
  Doff = ['.', '!', '?'];
var
  FIn, FOut : Text;
  PSt : TPElem; {Стек.}
  S, Data, DataTmp : String;
  Ch : Char;
  {Len - длина строки, LenW - длина слова, LenBw - длина междусловия.}
  i, j, Len, LenW, LenBw : Integer;
  IsOff : Boolean; {True - индекс находится внутри предложения, иначе - False.}
begin
  {Начальная инициализация стека.}
  PSt := nil;
  {Связываем файловые переменные с именами файлов.}
  Assign(FIn, FnIn);
  Assign(FOut, FnOut);
 
  repeat
    Writeln('Входной файл: ', FnIn);
    Writeln('Выходной файл: ', FnOut);
    Writeln('Выполнить обработку - д, Д, y, Y. Любой другой символ - выход.');
    Readln(S);
    if (S = '') or not (S[1] in ['д', 'Д', 'y', 'Y']) then
      Break;
 
    {Открываем файлы.}
    Reset(FIn);
    Rewrite(FOut);
    {Читаем построчно данные из входного файла. При этом отслеживаем предложения,
    слова и части, расположенные между слов (междусловия). Слова и междусловия
    складываем в стек. После записи каждого слова/междусловия добавляем в стек
    признак, который будет определять тип предыдущего элемента. Например,
    пускай, для слова признаком будет строка '1', для междусловия - строка '2'.
    Как только обнаружится конец предложения, изымаем из стека все слова и
    междусловия и записываем их в выходной файл. При этом междусловия записываем
    задом наперёд, а слова - как есть.
    Из за того, что междусловия могут быть разделены переносами строк, во время
    их записи в стек будем выполнять склейку. Склейка будет происходить так.
    Если надо добавить в стек междусловие, то мы проверяем - если на вершине
    стека уже лежит другое междусловие, то мы это другое междусловие изымаем
    из стека и склеиваем его с текущим междусловием. И затем склеенное
    междусловие записываем обратно - в стек.
    В отношении переносов строк будем поступать так. Переносы строк, расположенные
    в начале предложений не будем учитывать. А те переносы, которые расположены
    внутри предложений будем заменять на пробелы.
    Флаг IsOff будет сигнализировать: True - индекс (i) внутри предложения,
    False - индекс за пределами предложения.}
    IsOff := False;
    while not Eof(FIn) do
    begin
      {Читаем очередную строку из файла (без перехода на следующую сроку).}
      Read(FIn, S);
      Len := Length(S);
      {Обработка строки.}
      LenW := 0;
      LenBw := 0;
      for i := 1 to Len do
      begin
        {Обработка междусловий.}
        {Если символ является разделителем, значит он принадлежит междусловию.}
        if S[i] in Dw then
        begin
          Inc(LenBw); {Учитываем очередной символ в длине междусловия.}
          if (i = Len) or not (S[i + 1] in Dw) then {Отслеживаем конец междусловия.}
          begin
            Data := Copy(S, i - LenBw + 1, LenBw); {Берём из строки текущее междусловие.}
            {Если на вершине стека уже лежит другое междусловие, то изымаем это
            междусловие с вершины стека, выполняем его склейку с текущим
            междусловием, а затем склеенное междусловие записываем обратно - в стек.}
            if Pop(PSt, DataTmp) then {Берём из стека признак.}
              if DataTmp = '2' then {Если признак соответствует междусловию.}
              begin
                Pop(PSt, DataTmp); {Берём из стека междусловие.}
                Data := DataTmp + Data; {Склеиваем взятое междусловие с текущим междусловием.}
              end
              else {Если признак НЕ соответствует междусловию.}
                Push(PSt, DataTmp); {Возвращаем признак в стек.}
            Push(PSt, Data); {Добавляем междусловие в стек.}
            Push(PSt, '2'); {Добавляем в стек признак междусловия.}
            LenBw := 0; {Сброс длины междусловия.}
            IsOff := True; {True означает, что мы находимся внутри предложения.}
          end;
        end
        {Обработка слов.}
        {Если символ НЕ является разделителем, значит он принадлежит слову.}
        else
        begin
          Inc(LenW); {Учитываем очередной символ в длине слова.}
          if (i = Len) or (S[i + 1] in Dw) then {Отслеживаем конец слова.}
          begin
            Push(PSt, Copy(S, i - LenW + 1, LenW)); {Добавляем слово в стек.}
            Push(PSt, '1'); {Добавляем в стек признак слова.}
            LenW := 0; {Сброс длины слова.}
          end;
          IsOff := True; {True означает, что мы находимся внутри предложения.}
        end;
        {Обработка предложений.}
        {Если мы обнаружили конец предложения.}
        if (S[i] in Doff) or ((i = Len) and Eof(FIn)) then
        begin
          {Извлекаем из стека слова и междусловия и записываем их в выходной файл.}
          while Pop(PSt, Data) do {Извлекаем из стека признак слова/междусловия.}
            {Далее поступаем в зависимости от значения признака.}
            case Data[1] of
              '1' : {'1' - значит следующий элемент в стеке является словом.}
              begin
                Pop(PSt, Data);    {Извлекаем из стека слово.}
                Write(FOut, Data); {Записываем слово в выходной файл.}
              end;
              '2' : {'2' - значит следующий элемент в стеке является междусловием.}
              begin
                {Извлекаем из стека междусловие.}
                Pop(PSt, Data);
                {Переворачиваем междусловие.}
                LenBw := Length(Data);
                for j := 1 to LenBw div 2 do
                begin
                  Ch := Data[LenBw - j + 1];
                  Data[LenBw - j + 1] := Data[j];
                  Data[j] := Ch;
                end;
                Write(FOut, Data); {Записываем междусловие в выходной файл.}
              end;
              else
                Write(FOut, '(*Ошибка! Незарегистрированный тип: ', Data, '!*)');
            end;
          {Записываем перевод строки.}
          if not Eof(FIn) then
            Writeln(FOut);
          IsOff := False; {False означает, что мы вышли за пределы предложения.}
        end;
        {Обработка переносов строк.
        Переносы строк внутри предложений будем заменять на пробелы и записывать
        в стек в виде междусловий.}
        if IsOff and (i = Len) and Eoln(FIn) and not Eof(FIn) then
        begin
          Push(PSt, ' '); {Добавляем пробел в стек.}
          Push(PSt, '2'); {Добавляем в стек признак междусловия.}
        end;
      end;
      Readln(FIn); {Переход на следующую строку во входном файле.}
    end;
 
    {Закрываем файлы.}
    Close(FIn);
    Close(FOut);
    {Освобождение памяти, занятой для стека.}
    StFree(PSt);
    Writeln('Обработка завершена.');
    Writeln('Память, выделенная для стека, освобождена.');
    Writeln;
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.
Пример.
Исходный текст:
В нашей стране есть всё:
лес, горы, степи,
моря и реки.
И ещё раз.
В нашей стране есть всё:
лес, горы, степи,
моря и реки!
Текст в выходном файле, сформированный программой:
.реки и моря ,степи ,горы ,лес :всё есть стране нашей В
.раз ещё И
!реки и моря ,степи ,горы ,лес :всё есть стране нашей В
0
3 / 3 / 1
Регистрация: 07.11.2013
Сообщений: 49
28.02.2014, 01:04  [ТС] 7
вот последний код почти всё правильно делает, вот только я не понял как он обрабатывает переполнение..
и ещё, хорошо бы было, чтобы каждое предложение не начиналось с новой строки, а продолжалось как в тексте, вот например что у меня получилось по моему тексту.
Вложения
Тип файла: txt file_in.txt (1.2 Кб, 6 просмотров)
Тип файла: txt file_out.txt (1.3 Кб, 3 просмотров)
0
13104 / 5885 / 1706
Регистрация: 19.09.2009
Сообщений: 8,808
28.02.2014, 20:28 8
Цитата Сообщение от CrazyDrummer13 Посмотреть сообщение
и ещё, хорошо бы было, чтобы каждое предложение не начиналось с новой строки, а продолжалось как в тексте
Вот 2 варианта с точным преобразованием. Первый - без ограничения глубины стека, второй - с ограничением. В обоих вариантах используется один стек - в него записываются и слова и части, расположенные между словами (междусловия).

1. Без ограничения глубины стека.
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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
program Project1;
 
type
  {Основные данные элемента стека.}
  TData = String;
  {Указатель на элемент стека.}
  TPElem = ^TElem;
  {Элемент стека.}
  TElem = record
    Data : TData;   {Основные данные.}
    Sign : Char;    {'1' - слово, '2' - междусловие.}
    PNext : TPElem; {Указатель на следующий элемент стека.}
  end;
  {Для стека отдельный тип можно не создавать. Стек будет представлен в виде
  указателя на элемент, который расположен на вершине стека. Поэтому, переменная,
  представляющая стек, будет иметь тип TPElem.}
 
{Стек.}
 
{Добавление элемента на вершину стека.
aData - основные данные: слово или междусловие.
aSign - знак, задающий тип данных: '1' - слово, '2' - междусловие.}
procedure Push(var aPSt : TPElem; const aData : TData; const aSign : Char);
var
  PElem : TPElem;
begin
  New(PElem); {Выделение памяти для нового элемента.}
  PElem^.Data := aData; {Записываем основные данные.}
  PElem^.Sign := aSign; {Записываем сведения о типе данных.}
  {Прикрепляем к новому элементу первый элемент стека. Таким образом, новый
  элемент оказывается на вершине стека.}
  PElem^.PNext := aPSt;
  {В переменную стека записываем указатель на вершину стека - т. е., на новый элемент.}
  aPSt := PElem;
end;
 
{Изъятие элемента с вершины стека.
Если стек не пуст, то с вершины стека изымается элемент и его значение
(основные данные) возвращается через параметры aData и aSign. В этом случае,
функция возвращает значение True. Если стек пуст, то операция отменяется,
и функция возвращает значение False.}
function Pop(var aPSt : TPElem; var aData : TData; var aSign : Char) : Boolean;
var
  PElem : TPElem;
begin
  Pop := False;
  if aPSt <> nil then
  begin
    PElem := aPSt; {Получаем указатель на тот элемент, который находится на вершине стека.}
    aData := PElem^.Data; {Читаем основные данные элемента.}
    aSign := PElem^.Sign; {Читаем сведения о типе данных.}
    {Указатель стека теперь будет указывать на второй элемент. Таким образом,
    второй элемент теперь оказывается на вершине стека.}
    aPSt := PElem^.PNext;
    Dispose(PElem); {Освобождаем память, занятую под элемент, который раньше был на вершине стека.}
    Pop := True;
  end;
end;
 
{Освобождение памяти, занятой для стека (очистка стека).}
procedure StFree(var aPSt : TPElem);
var
  Data : TData;
  Sign : Char;
begin
  while Pop(aPSt, Data, Sign) do;
end;
 
{Прикладные процедуры.}
 
{Запись содержимого стека в файл.}
procedure StWrite(const aF : Text; var aPSt : TPElem);
var
  Data, DataTmp : TData;
  Sign : Char;
  i, Len : Integer;
  Ch : Char;
begin
  {Извлекаем из стека слова и междусловия и записываем их в выходной файл.}
  while Pop(aPSt, Data, Sign) do
  begin
    {Если выбрано междусловие.}
    if Sign = '2' then
    begin
      {Склейка смежных междусловий.}
      while Pop(aPSt, DataTmp, Sign) and (Sign = '2') do
        Data := DataTmp + Data;
      {Если поседний выбранный из стека элемент не является междусловием,
      то возвращаем его обратно - в стек.}
      if Sign <> '2' then
        Push(aPSt, DataTmp, Sign);
      {Переворачиваем муждусловие.}
      Len := Length(Data);
      for i := 1 to Len div 2 do
      begin
        Ch := Data[Len - i + 1];
        Data[Len - i + 1] := Data[i];
        Data[i] := Ch;
      end;
    end;
    Write(aF, Data); {Записываем элемент в файл.}
  end;
end;
 
const
  {Имена входного и выходного файлов.}
  FnIn = 'file_in.txt';
  FnOut = 'file_out.txt';
  {Разделители слов.}
  Dw = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
  {Разделители предложений.}
  Doff = ['.', '!', '?'];
var
  FIn, FOut : Text;
  PSt : TPElem; {Стек.}
  S, Sw, Sb : String;
  {Len - длина строки, LenW - длина слова, LenBw - длина междусловия.}
  i, Len, LenW, LenBw : Integer;
begin
  {Начальная инициализация стека.}
  PSt := nil;
  {Связываем файловые переменные с именами файлов.}
  Assign(FIn, FnIn);
  Assign(FOut, FnOut);
 
  repeat
    Writeln('Входной файл: ', FnIn);
    Writeln('Выходной файл: ', FnOut);
    Writeln('Выполнить обработку - д, Д, y, Y. Любой другой символ - выход.');
    Readln(S);
    if (S = '') or not (S[1] in ['д', 'Д', 'y', 'Y']) then
      Break;
 
    {Открываем файлы.}
    Reset(FIn);
    Rewrite(FOut);
    {Обработка файла.}
    Sw := ''; {Слово.}
    Sb := ''; {Междусловие.}
    while not Eof(FIn) do
    begin
      {Читаем очередную строку из файла (без перехода на следующую сроку).}
      Read(FIn, S);
      Len := Length(S);
      {Обработка строки.}
      LenW := 0;
      LenBw := 0;
      for i := 1 to Len do
      begin
        {Обработка междусловий.}
        {Если символ является разделителем, значит он принадлежит междусловию.}
        if S[i] in Dw then
        begin
          Inc(LenBw); {Учитываем очередной символ в длине междусловия.}
          {Отслеживаем конец междусловия.}
          if (S[i] in Doff) or ((i = Len) or not (S[i + 1] in Dw)) then
          begin
            Push(PSt, Copy(S, i - LenBw + 1, LenBw), '2'); {Добавление междусловия в стек.}
            LenBw := 0; {Сброс длины междусловия.}
          end;
        end
        {Обработка слов.}
        {Если символ НЕ является разделителем, значит он принадлежит слову.}
        else
        begin
          Inc(LenW); {Учитываем очередной символ в длине слова.}
          {Отслеживаем конец слова.}
          if (i = Len) or (S[i + 1] in Dw) then
          begin
            Push(PSt, Copy(S, i - LenW + 1, LenW), '1'); {Добавление слова в стек.}
            LenW := 0; {Сброс длины слова.}
          end;
        end;
        {Обработка предложений.}
        {Если обнаружен конец предложения.}
        if (S[i] in Doff) or ((i = Len) and Eof(FIn)) then
          StWrite(FOut, PSt); {Запись содержимого стека в файл.}
      end;
      {Обработка переносов строк.}
      if Eoln(FIn) and not Eof(FIn) then
      begin
        Push(PSt, #10#13, '2'); {Добавляем в стек перевёрнутый перенос строки.}
        Readln(FIn); {Переходим к следующей строке во входном файле.}
      end;
    end;
    {Записываем в файл то, что осталось в стеке.}
    StWrite(FOut, PSt);
 
    {Закрываем файлы.}
    Close(FIn);
    Close(FOut);
    {Освобождение памяти, занятой для стека.}
    StFree(PSt);
    Writeln('Обработка завершена.');
    Writeln('Память, выделенная для стека, освобождена.');
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.
2. С ограничением глубины стека.
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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
program Project1;
 
const
  aStackMaxSize = 100; {Наибольшая глубина стека.}
 
type
  {Основные данные элемента стека.}
  TData = String;
  {Указатель на элемент стека.}
  TPElem = ^TElem;
  {Элемент стека.}
  TElem = record
    Data : TData;   {Основные данные.}
    Sign : Char;    {'1' - слово, '2' - междусловие.}
    PNext : TPElem; {Указатель на следующий элемент стека.}
  end;
  {Тип, описывающий стек.}
  TStack = record
    PTop : TPElem; {Указатель на вершину стека.}
    Cnt : Integer; {Количество элементов в стеке.}
  end;
 
{Стек.}
 
{Инициализация стека. Эту процедуру можно выполнять только в отношении пустого
стека. Иначе будут утечки памяти.}
procedure Init(var aSt : TStack);
begin
  aSt.PTop := nil;
  aSt.Cnt := 0;
end;
 
{Добавление элемента на вершину стека.
aData - основные данные: слово или междусловие.
aSign - знак, задающий тип данных: '1' - слово, '2' - междусловие.
Если глубина стека меньше наибольшей допустимой, то новый элемент добавляется
в стек. В этом случае функция возвращает значение True. Если глубина стека
равна наибольшей допустимой, то операция отменяется и функция возвращает
значение False.}
function Push(var aSt : TStack; const aData : TData; const aSign : Char) : Boolean;
var
  PElem : TPElem;
begin
  Push := False;
  if aSt.Cnt < aStackMaxSize then
  begin
    New(PElem); {Выделение памяти для нового элемента.}
    PElem^.Data := aData; {Записываем основные данные.}
    PElem^.Sign := aSign; {Записываем сведения о типе данных.}
    {Прикрепляем к новому элементу первый элемент стека. Таким образом, новый
    элемент оказывается на вершине стека.}
    PElem^.PNext := aSt.PTop;
    {В переменную стека записываем указатель на вершину стека - т. е., на новый элемент.}
    aSt.PTop := PElem;
    Inc(aSt.Cnt); {Отмечаем, что количество элементов в стеке увеличилось на 1.}
    Push := True;
  end;
end;
 
{Изъятие элемента с вершины стека.
Если стек не пуст, то с вершины стека изымается элемент и его значение
(основные данные) возвращается через параметры aData и aSign. В этом случае,
функция возвращает значение True. Если стек пуст, то операция отменяется,
и функция возвращает значение False.}
function Pop(var aSt : TStack; var aData : TData; var aSign : Char) : Boolean;
var
  PElem : TPElem;
begin
  Pop := False;
  if aSt.PTop <> nil then
  begin
    PElem := aSt.PTop; {Получаем указатель на тот элемент, который находится на вершине стека.}
    aData := PElem^.Data; {Читаем основные данные элемента.}
    aSign := PElem^.Sign; {Читаем сведения о типе данных.}
    {Указатель стека теперь будет указывать на второй элемент. Таким образом,
    второй элемент теперь оказывается на вершине стека.}
    aSt.PTop := PElem^.PNext;
    Dispose(PElem); {Освобождаем память, занятую под элемент, который раньше был на вершине стека.}
    Dec(aSt.Cnt); {Отмечаем, что количество элементов в стеке уменьшилось на 1.}
    Pop := True;
  end;
end;
 
{Освобождение памяти, занятой для стека (очистка стека).}
procedure StFree(var aSt : TStack);
var
  Data : TData;
  Sign : Char;
begin
  while Pop(aSt, Data, Sign) do;
end;
 
{Прикладные процедуры.}
 
{Запись содержимого стека в файл.}
procedure StWrite(const aF : Text; var aSt : TStack);
var
  Data, DataTmp : TData;
  Sign : Char;
  i, Len : Integer;
  Ch : Char;
begin
  {Извлекаем из стека слова и междусловия и записываем их в выходной файл.}
  while Pop(aSt, Data, Sign) do
  begin
    {Если выбрано междусловие.}
    if Sign = '2' then
    begin
      {Склейка смежных междусловий.}
      while Pop(aSt, DataTmp, Sign) and (Sign = '2') do
        Data := DataTmp + Data;
      {Если поседний выбранный из стека элемент не является междусловием,
      то возвращаем его обратно - в стек.}
      if Sign <> '2' then
        Push(aSt, DataTmp, Sign);
      {Переворачиваем муждусловие.}
      Len := Length(Data);
      for i := 1 to Len div 2 do
      begin
        Ch := Data[Len - i + 1];
        Data[Len - i + 1] := Data[i];
        Data[i] := Ch;
      end;
    end;
    Write(aF, Data); {Записываем элемент в файл.}
  end;
end;
 
const
  {Имена входного и выходного файлов.}
  FnIn = 'file_in.txt';
  FnOut = 'file_out.txt';
  {Разделители слов.}
  Dw = ['.', ',', ':', ';', '!', '?', '-', ' ', #9, #10, #13];
  {Разделители предложений.}
  Doff = ['.', '!', '?'];
var
  FIn, FOut : Text;
  St : TStack; {Стек.}
  S, Sw, Sb : String;
  {Len - длина строки, LenW - длина слова, LenBw - длина междусловия.}
  i, Len, LenW, LenBw : Integer;
begin
  {Начальная инициализация стека.}
  Init(St);
  {Связываем файловые переменные с именами файлов.}
  Assign(FIn, FnIn);
  Assign(FOut, FnOut);
 
  repeat
    Writeln('Входной файл: ', FnIn);
    Writeln('Выходной файл: ', FnOut);
    Writeln('Выполнить обработку - д, Д, y, Y. Любой другой символ - выход.');
    Readln(S);
    if (S = '') or not (S[1] in ['д', 'Д', 'y', 'Y']) then
      Break;
 
    {Открываем файлы.}
    Reset(FIn);
    Rewrite(FOut);
    {Обработка файла.}
    Sw := ''; {Слово.}
    Sb := ''; {Междусловие.}
    while not Eof(FIn) do
    begin
      {Читаем очередную строку из файла (без перехода на следующую сроку).}
      Read(FIn, S);
      Len := Length(S);
      {Обработка строки.}
      LenW := 0;
      LenBw := 0;
      for i := 1 to Len do
      begin
        {Обработка междусловий.}
        {Если символ является разделителем, значит он принадлежит междусловию.}
        if S[i] in Dw then
        begin
          Inc(LenBw); {Учитываем очередной символ в длине междусловия.}
          {Отслеживаем конец междусловия.}
          if (S[i] in Doff) or ((i = Len) or not (S[i + 1] in Dw)) then
          begin
            Push(St, Copy(S, i - LenBw + 1, LenBw), '2'); {Добавление междусловия в стек.}
            LenBw := 0; {Сброс длины междусловия.}
          end;
        end
        {Обработка слов.}
        {Если символ НЕ является разделителем, значит он принадлежит слову.}
        else
        begin
          Inc(LenW); {Учитываем очередной символ в длине слова.}
          {Отслеживаем конец слова.}
          if (i = Len) or (S[i + 1] in Dw) then
          begin
            Push(St, Copy(S, i - LenW + 1, LenW), '1'); {Добавление слова в стек.}
            LenW := 0; {Сброс длины слова.}
          end;
        end;
        {Обработка предложений.}
        {Если обнаружен конец предложения.}
        if (S[i] in Doff) or ((i = Len) and Eof(FIn)) then
          StWrite(FOut, St); {Запись содержимого стека в файл.}
      end;
      {Обработка переносов строк.}
      if Eoln(FIn) and not Eof(FIn) then
      begin
        Push(St, #10#13, '2'); {Добавляем в стек перевёрнутый перенос строки.}
        Readln(FIn); {Переходим к следующей строке во входном файле.}
      end;
    end;
    {Записываем в файл то, что осталось в стеке.}
    StWrite(FOut, St);
 
    {Закрываем файлы.}
    Close(FIn);
    Close(FOut);
    {Освобождение памяти, занятой для стека.}
    StFree(St);
    Writeln('Обработка завершена.');
    Writeln('Память, выделенная для стека, освобождена.');
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.
Пример обработки.
Текст во входном файле:
Кликните здесь для просмотра всего текста
Код
- Притормози, - говорю я, когда мы минуем манговые заросли и проезжаем мимо вполне среднерусской чащобы.
- У следующей тропинки.
- До квартал "Аль-Кабар" еще далеко, - говорит водитель.
- Останови.
Машина останавливается. Я открываю дверь, отхожу от лимузина на шаг.
Водитель покорно ждет. И я тоже - просвет на дороге. Зачем нам свидетели?
Вот, наконец-то...
Я целюсь в машину, стреляю. Револьвер бьет негромко, отдача слабая,
но машина мгновенно вспыхивает. Водитель сидит, глядя перед собой.
Несколько секунд - и у "Дип-проводника" становится одним такси меньше.
Хорошо. Пусть все выглядит, как развлечение пьяной шпаны. Я иду в
лес.
- Неэтично... - бормочет из булавок "Виндоус-Хоум".
- Ты оптимизировалась?
- Да.
- Все, теперь мне нужна помощь. Ищи тайник, код "Иван".
- Светящееся дерево, - сообщает программа.
Я озираюсь. Ага. Вот он, огромный дуб, мерцающий колдовским синим
светом. Мерцающий лишь для меня. Я подхожу к нему, засовываю руку в дупло,
вынимаю большой тяжелый сверток. Переодеваюсь в полотняную белую рубаху и
штаны, подпоясываюсь узорчатым поясом. Короткий меч в ножнах, несколько
вещичек в карманах. Тайник я создал пару дней назад, незаконно использовав
один из компьютеров транспортного управления з кавказской железной дороги.

Текст, сформированный программой в выходном файле:
Кликните здесь для просмотра всего текста
Код
.чащобы среднерусской вполне мимо проезжаем и заросли манговые минуем мы когда ,я говорю - ,Притормози -.тропинки следующей У -
.водитель говорит - ,далеко еще Кабар"-"Аль квартал До -
.Останови -
.останавливается Машина
.шаг на лимузина от отхожу ,дверь открываю Я .ждет покорно Водитель
.дороге на просвет - тоже я И ?свидетели нам Зачем .то-наконец ,Вот
...стреляю ,машину в целюсь Я
.вспыхивает мгновенно машина но
,слабая отдача ,негромко бьет Револьвер .собой перед глядя ,сидит Водитель .меньше такси одним становится проводника"-"Дип у и - секунд Несколько
.Хорошо
.шпаны пьяной развлечение как ,выглядит все Пусть .лес
в иду Я .Неэтично -
...Хоум"-"Виндоус булавок из бормочет - ?оптимизировалась Ты -
.Да -
.помощь нужна мне теперь ,Все -
."Иван" код ,тайник Ищи .программа сообщает - ,дерево Светящееся -
.озираюсь Я
.Ага .светом
синим колдовским мерцающий ,дуб огромный ,он Вот .меня для лишь Мерцающий .сверток тяжелый большой вынимаю
,дупло в руку засовываю ,нему к подхожу Я .поясом узорчатым подпоясываюсь ,штаны
и рубаху белую полотняную в Переодеваюсь .карманах в вещичек
несколько ,ножнах в меч Короткий .дороги железной кавказской з управления транспортного компьютеров из один
использовав незаконно ,назад дней пару создал я Тайник
1
3 / 3 / 1
Регистрация: 07.11.2013
Сообщений: 49
28.02.2014, 21:08  [ТС] 9
Да!
Вывод как надо. Только я чуть чуть не понял... Глубина стека = 100 ? Надо ведь 10..
0
13104 / 5885 / 1706
Регистрация: 19.09.2009
Сообщений: 8,808
28.02.2014, 21:15 10
Ну это я просто начальную глубину поставил - 100. Можно на 10 поменять.

Добавлено через 1 минуту
Но только надо иметь в виду, что у нас сейчас в стек пишутся не только слова, но и междусловия. Поэтому, возможно имеет смысл глубину поставить больше, чем 10.
0
3 / 3 / 1
Регистрация: 07.11.2013
Сообщений: 49
28.02.2014, 21:17  [ТС] 11
так а по условию размерность стека = 10
0
13104 / 5885 / 1706
Регистрация: 19.09.2009
Сообщений: 8,808
28.02.2014, 21:28 12
Ну можно 10 поставить. Только слов маловато будет тогда в стек помещаться. Если предложение полностью расположено на одной строке, то будет 5 слов и 5 междусловий. Если предложение переносится на другую строку и при этом получилось так, что какое-то междусловие разделилось на 2 части, то уже получим, например, 4 слова и 6 междусловий. Потому, что перевод строки засчитывается, как отдельное междусловие.
0
3 / 3 / 1
Регистрация: 07.11.2013
Сообщений: 49
28.02.2014, 21:29  [ТС] 13
и что делать тогда?
0
13104 / 5885 / 1706
Регистрация: 19.09.2009
Сообщений: 8,808
28.02.2014, 21:44 14
Здесь по-разному можно поступить. Если придерживаться существующей архитектуры, то можно склейку междусловий выполнять на этапе заполнения стека (сейчас склейка выполняется на этапе записи в файл). Но всё равно в стеке будут слова и междусловия.

Или можно задействовать 2 стека - в один складывать слова, в другой - междусловия. Глубину обоих стеков установить равной 10, например. Если 2 стека разрешено использовать можно вот так тогда и поступить.
0
3 / 3 / 1
Регистрация: 07.11.2013
Сообщений: 49
28.02.2014, 21:45  [ТС] 15
да, два стека можно использовать
0
13104 / 5885 / 1706
Регистрация: 19.09.2009
Сообщений: 8,808
28.02.2014, 21:47 16
Хотя можно и 1 стеком для слов обойтись. Но это будет решение, в котором стеки вообще не нужны. И там стек будет выглядеть неуместным образом...
0
3 / 3 / 1
Регистрация: 07.11.2013
Сообщений: 49
28.02.2014, 21:47  [ТС] 17
Покажете?
0
13104 / 5885 / 1706
Регистрация: 19.09.2009
Сообщений: 8,808
28.02.2014, 21:48 18
Цитата Сообщение от CrazyDrummer13 Посмотреть сообщение
да, два стека можно использовать
Это хорошо. Я тогда попозже напишу вариант с двумя стеками.
1
3 / 3 / 1
Регистрация: 07.11.2013
Сообщений: 49
28.02.2014, 21:48  [ТС] 19
спасибо большое, не знаю, чем вас отблагодарить
0
13104 / 5885 / 1706
Регистрация: 19.09.2009
Сообщений: 8,808
01.03.2014, 09:27 20
Решение с двумя стеками. В один стек записываются слова, в другой - междусловия. Здесь опять в двух вариантах: 1 - без ограничения глубины стеков, 2 - с ограничением.

Теперь в перечень разделителей слов добавлен знак двойной кавычки ":
Delphi
1
2
{Разделители слов.}
Dw = ['.', ',', ':', ';', '!', '?', '-', '"', ' ', #9, #10, #13];
Склейка смежных междусловий выполняется на этапе добавления в стек. Это обеспечивает режим чередования: слово - междусловие - слово - ...

1. Без ограничения глубины стеков.
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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
program Project1;
 
type
  {Основные данные элемента стека.}
  TData = String;
  {Указатель на элемент стека.}
  TPElem = ^TElem;
  {Элемент стека.}         
  TElem = record
    Data : TData;   {Основные данные.}
    PNext : TPElem; {Указатель на следующий элемент стека.}
  end;
  {Для стека отдельный тип можно не создавать. Стек будет представлен в виде
  указателя на элемент, который расположен на вершине стека. Поэтому, переменная,
  представляющая стек, будет иметь тип TPElem.}
 
{Стек.}
 
{Добавление элемента на вершину стека.}
procedure Push(var aPSt : TPElem; const aData : TData);
var
  PElem : TPElem;
begin
  New(PElem); {Выделение памяти для нового элемента.}
  PElem^.Data := aData; {Записываем основные данные.}
  {Прикрепляем к новому элементу первый элемент стека. Таким образом, новый
  элемент оказывается на вершине стека.}
  PElem^.PNext := aPSt;
  {В переменную стека записываем указатель на вершину стека - т. е., на новый элемент.}
  aPSt := PElem;
end;
 
{Изъятие элемента с вершины стека.
Если стек не пуст, то с вершины стека изымается элемент и его значение
(основные данные) возвращается через параметр aData. В этом случае, функция
возвращает значение True. Если стек пуст, то операция отменяется, а функция
возвращает значение False.}
function Pop(var aPSt : TPElem; var aData : TData) : Boolean;
var
  PElem : TPElem;
begin
  Pop := False;
  if aPSt <> nil then
  begin
    PElem := aPSt; {Получаем указатель на тот элемент, который находится на вершине стека.}
    aData := PElem^.Data; {Читаем основные данные элемента.}
    {Указатель стека теперь будет указывать на второй элемент. Таким образом,
    второй элемент теперь оказывается на вершине стека.}
    aPSt := PElem^.PNext;
    Dispose(PElem); {Освобождаем память, занятую под элемент, который раньше был на вершине стека.}
    Pop := True;
  end;
end;
 
{Освобождение памяти, занятой для стека (очистка стека).}
procedure StFree(var aPSt : TPElem);
var
  Data : TData;
begin
  while Pop(aPSt, Data) do;
end;
 
{Прикладные процедуры.}
 
{Запись содержимого стека в файл.}
procedure StWrite(var aF : Text; var aPStW, aPStBw : TPElem; const aIsWord : Boolean);
var
  PSt1, PSt2 : TPElem;
  Data : TData;
  Ch : Char;
  i, Len : Integer;
  IsData1, IsData2 : Boolean;
begin
  {Переливаем междусловия в стек PSt1 и выполняем переворачивания.}
  PSt1 := nil; {Инициализация стека PSt1}
  while Pop(aPStBw, Data) do {Берём междусловие из стека междусловий.}
  begin
    {Переворачиваем междусловие.}
    Len := Length(Data);
    for i := 1 to Len div 2 do
    begin
      Ch := Data[i];
      Data[i] := Data[Len - i + 1];
      Data[Len - i + 1] := Ch;
    end;
    Push(PSt1, Data); {Записываем междусловие в стек PSt1.}
  end;
  {Переливаем междусловия обратно - в стек междусловий.}
  while Pop(PSt1, Data) do
    Push(aPStBw, Data);
 
  {Выбираем очерёдность стеков.}
  if aIsWord then
  begin
    PSt1 := aPStW;
    PSt2 := aPStBw;
  end
  else
  begin
    PSt1 := aPStBw;
    PSt2 := aPStW;
  end;
 
  {Извлекаем из стеков слова и междусловия и записываем их в выходной файл.}
  repeat
    IsData1 := Pop(PSt1, Data);
    if IsData1 then
      Write(aF, Data);
    IsData2 := Pop(PSt2, Data);
    if IsData2 then
      Write(aF, Data);
  until not (IsData1 or IsData2);
  {Теперь стеки пусты, выполняем инициализацию представляющих их параметров.}
  aPStW := nil;
  aPStBw := nil;
end;
 
const
  {Имена входного и выходного файлов.}
  FnIn = 'file_in.txt';
  FnOut = 'file_out.txt';
  {Разделители слов.}
  Dw = ['.', ',', ':', ';', '!', '?', '-', '"', ' ', #9, #10, #13];
  {Разделители предложений.}
  Doff = ['.', '!', '?'];
var
  FIn, FOut : Text;
  PStW, PStBw : TPElem; {Стек слов и стек междусловий.}
  Data, DataTmp : TData;
  S : String;
  {Len - длина строки, LenW - длина слова, LenBw - длина междусловия.}
  i, Len, LenW, LenBw : Integer;
  {IsWord:
  True - последний записанный в стек элемент является словом,
  False - последний записанный в стек элемент является междусловием.}
  IsWord : Boolean;
begin
  {Начальная инициализация стеков.}
  PStW := nil;
  PStBw := nil;
  {Связываем файловые переменные с именами файлов.}
  Assign(FIn, FnIn);
  Assign(FOut, FnOut);
 
  repeat
    Writeln('Входной файл: ', FnIn);
    Writeln('Выходной файл: ', FnOut);
    Writeln('Выполнить обработку - д, Д, y, Y. Любой другой символ - выход.');
    Readln(S);
    if (S = '') or not (S[1] in ['д', 'Д', 'y', 'Y']) then
      Break;
 
    {Открываем файлы.}
    Reset(FIn);
    Rewrite(FOut);
    {Обработка файла.}
    IsWord := True;
    while not Eof(FIn) do
    begin
      {Читаем очередную строку из файла (без перехода на следующую сроку).}
      Read(FIn, S);
      Len := Length(S);
      {Обработка строки.}
      LenW := 0;
      LenBw := 0;
      for i := 1 to Len do
      begin
        {Обработка междусловий.}
        {Если символ является разделителем, значит он принадлежит междусловию.}
        if S[i] in Dw then
        begin
          Inc(LenBw); {Учитываем очередной символ в длине междусловия.}
          {Отслеживаем конец междусловия.}
          if (S[i] in Doff) or ((i = Len) or not (S[i + 1] in Dw)) then
          begin
            Data := Copy(S, i - LenBw + 1, LenBw); {Берём из строки междусловие.}
            {Если предыдущий элемент строки являлся междусловием, то выполняем склейку.}
            if not IsWord and Pop(PStBw, DataTmp) then
              Data := DataTmp + Data;
            Push(PStBw, Data); {Добавление междусловия в стек.}
            IsWord := False; {Флаг: последний добавленный элемент - междусловие.}
            LenBw := 0; {Сброс длины междусловия.}
          end;
        end
        {Обработка слов.}
        {Если символ НЕ является разделителем, значит он принадлежит слову.}
        else
        begin
          Inc(LenW); {Учитываем очередной символ в длине слова.}
          {Отслеживаем конец слова.}
          if (i = Len) or (S[i + 1] in Dw) then
          begin
            Push(PStW, Copy(S, i - LenW + 1, LenW)); {Добавление слова в стек.}
            IsWord := True; {Флаг: последний добавленный элемент - слово.}
            LenW := 0; {Сброс длины слова.}
          end;
        end;
        {Обработка предложений.}
        {Если обнаружен конец предложения.}
        if (S[i] in Doff) or ((i = Len) and Eof(FIn)) then
          StWrite(FOut, PStW, PStBw, IsWord); {Запись содержимого стека в файл.}
      end;
      {Обработка переносов строк.}
      if Eoln(FIn) and not Eof(FIn) then
      begin
        Data := #10#13; {Перевёрнутый перенос строки.}
        {Если предыдущий элемент строки являлся междусловием, то выполняем склейку.}
        if not IsWord and Pop(PStBw, DataTmp) then
          Data := DataTmp + Data;
        Push(PStBw, Data); {Добавление междусловия в стек.}
        IsWord := False; {Флаг: последний добавленный элемент - междусловие.}
        Readln(FIn); {Переходим к следующей строке во входном файле.}
      end;
    end;
    {Записываем в файл то, что осталось в стеке.}
    StWrite(FOut, PStW, PStBw, IsWord);
 
    {Закрываем файлы.}
    Close(FIn);
    Close(FOut);
    {Освобождение памяти, занятой для стеков.}
    StFree(PStW);
    StFree(PStBw);
    Writeln('Обработка завершена.');
    Writeln('Память, выделенная для стеков, освобождена.');
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.
2. С ограничением глубины стеков. Сейчас выставлено ограничение глубины: aStackMaxSize = 100. Можно поменять это значение на другое - на 10, например.
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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
program Project1;
 
const
  aStackMaxSize = 100; {Наибольшая глубина стека.}
 
type
  {Основные данные элемента стека.}
  TData = String;
  {Указатель на элемент стека.}
  TPElem = ^TElem;
  {Элемент стека.}
  TElem = record
    Data : TData;   {Основные данные.}
    PNext : TPElem; {Указатель на следующий элемент стека.}
  end;
  {Тип, описывающий стек.}
  TStack = record
    PTop : TPElem; {Указатель на вершину стека.}
    Cnt : Integer; {Количество элементов в стеке.}
  end;
 
{Стек.}
 
{Инициализация стека. Эту процедуру можно выполнять только в отношении пустого
стека. Иначе будут утечки памяти.}
procedure Init(var aSt : TStack);
begin
  aSt.PTop := nil;
  aSt.Cnt := 0;
end;
 
{Добавление элемента на вершину стека.
aData - основные данные: слово или междусловие.
Если глубина стека меньше наибольшей допустимой, то новый элемент добавляется
в стек. В этом случае функция возвращает значение True. Если глубина стека
равна наибольшей допустимой, то операция отменяется и функция возвращает
значение False.}
function Push(var aSt : TStack; const aData : TData) : Boolean;
var
  PElem : TPElem;
begin
  Push := False;
  if aSt.Cnt < aStackMaxSize then
  begin
    New(PElem); {Выделение памяти для нового элемента.}
    PElem^.Data := aData; {Записываем основные данные.}
    {Прикрепляем к новому элементу первый элемент стека. Таким образом, новый
    элемент оказывается на вершине стека.}
    PElem^.PNext := aSt.PTop;
    {В переменную стека записываем указатель на вершину стека - т. е., на новый элемент.}
    aSt.PTop := PElem;
    Inc(aSt.Cnt); {Отмечаем, что количество элементов в стеке увеличилось на 1.}
    Push := True;
  end;
end;
 
{Изъятие элемента с вершины стека.
Если стек не пуст, то с вершины стека изымается элемент и его значение
(основные данные) возвращается через параметр aData. В этом случае функция
возвращает значение True. Если стек пуст, то операция отменяется и функция
возвращает значение False.}
function Pop(var aSt : TStack; var aData : TData) : Boolean;
var
  PElem : TPElem;
begin
  Pop := False;
  if aSt.PTop <> nil then
  begin
    PElem := aSt.PTop; {Получаем указатель на тот элемент, который находится на вершине стека.}
    aData := PElem^.Data; {Читаем основные данные элемента.}
    {Указатель стека теперь будет указывать на второй элемент. Таким образом,
    второй элемент теперь оказывается на вершине стека.}
    aSt.PTop := PElem^.PNext;
    Dispose(PElem); {Освобождаем память, занятую под элемент, который раньше был на вершине стека.}
    Dec(aSt.Cnt); {Отмечаем, что количество элементов в стеке уменьшилось на 1.}
    Pop := True;
  end;
end;
 
{Освобождение памяти, занятой для стека (очистка стека).}
procedure StFree(var aSt : TStack);
var
  Data : TData;
begin
  while Pop(aSt, Data) do;
end;
 
{Прикладные процедуры.}
 
{Запись содержимого стека в файл.}
procedure StWrite(var aF : Text; var aStW, aStBw : TStack; const aIsWord : Boolean);
var
  St1, St2 : TStack;
  Data : TData;
  Ch : Char;
  i, Len : Integer;
  IsData1, IsData2 : Boolean;
begin
  {Переливаем междусловия в стек St1 и выполняем переворачивания.}
  Init(St1);
  while Pop(aStBw, Data) do {Берём междусловие из стека междусловий.}
  begin
    {Переворачиваем междусловие.}
    Len := Length(Data);
    for i := 1 to Len div 2 do
    begin
      Ch := Data[i];
      Data[i] := Data[Len - i + 1];
      Data[Len - i + 1] := Ch;
    end;
    Push(St1, Data); {Записываем междусловие в стек St1.}
  end;
  {Переливаем междусловия обратно - в стек междусловий.}
  while Pop(St1, Data) do
    Push(aStBw, Data);
 
  {Выбираем очерёдность стеков.}
  if aIsWord then
  begin
    St1 := aStW;
    St2 := aStBw;
  end
  else
  begin
    St1 := aStBw;
    St2 := aStW;
  end;
 
  {Извлекаем из стеков слова и междусловия и записываем их в выходной файл.}
  repeat
    IsData1 := Pop(St1, Data);
    if IsData1 then
      Write(aF, Data);
    IsData2 := Pop(St2, Data);
    if IsData2 then
      Write(aF, Data);
  until not (IsData1 or IsData2);
  {Теперь стеки пусты, выполняем инициализацию представляющих их параметров.}
  Init(aStW);
  Init(aStBw);
end;
 
const
  {Имена входного и выходного файлов.}
  FnIn = 'file_in.txt';
  FnOut = 'file_out.txt';
  {Разделители слов.}
  Dw = ['.', ',', ':', ';', '!', '?', '-', '"', ' ', #9, #10, #13];
  {Разделители предложений.}
  Doff = ['.', '!', '?'];
var
  FIn, FOut : Text;
  StW, StBw : TStack; {Стек слов и стек междусловий.}
  Data, DataTmp : TData;
  S : String;
  {Len - длина строки, LenW - длина слова, LenBw - длина междусловия.}
  i, Len, LenW, LenBw : Integer;
  {IsWord = True - последний записанный в стек элемент является словом,
    False - последний записанный в стек элемент является междусловием.
  IsDataW = True - слово успешно добавлено в стек слов. Иначе - False.
  IsDataBw = True - междусловие успешно добавлено в стек междусловий. Иначе - False.}
  IsWord, IsDataW, IsDataBw : Boolean;
begin
  {Начальная инициализация стеков.}
  Init(StW);
  Init(StBw);
  {Связываем файловые переменные с именами файлов.}
  Assign(FIn, FnIn);
  Assign(FOut, FnOut);
 
  repeat
    Writeln('Входной файл: ', FnIn);
    Writeln('Выходной файл: ', FnOut);
    Writeln('Выполнить обработку - д, Д, y, Y. Любой другой символ - выход.');
    Readln(S);
    if (S = '') or not (S[1] in ['д', 'Д', 'y', 'Y']) then
      Break;
 
    {Открываем файлы.}
    Reset(FIn);
    Rewrite(FOut);
    {Обработка файла.}
    IsWord := True;
    IsDataW := True;
    IsDataBw := True;
    while not Eof(FIn) do
    begin
      {Читаем очередную строку из файла (без перехода на следующую сроку).}
      Read(FIn, S);
      Len := Length(S);
      {Обработка строки.}
      LenW := 0;
      LenBw := 0;
      for i := 1 to Len do
      begin
        {Обработка междусловий.}
        {Если символ является разделителем, значит он принадлежит междусловию.}
        if S[i] in Dw then
        begin
          Inc(LenBw); {Учитываем очередной символ в длине междусловия.}
          {Отслеживаем конец междусловия.}
          if (S[i] in Doff) or ((i = Len) or not (S[i + 1] in Dw)) then
          begin
            if IsDataBw then
            begin
              Data := Copy(S, i - LenBw + 1, LenBw); {Берём из строки междусловие.}
              {Если предыдущий элемент строки являлся междусловием, то выполняем склейку.}
              if not IsWord and Pop(StBw, DataTmp) then
                Data := DataTmp + Data;
              IsDataBw := Push(StBw, Data); {Добавление междусловия в стек.}
              if IsDataBw then
                IsWord := False; {Флаг: последний добавленный элемент - междусловие.}
            end;
            LenBw := 0; {Сброс длины междусловия.}
          end;
        end
        {Обработка слов.}
        {Если символ НЕ является разделителем, значит он принадлежит слову.}
        else
        begin
          Inc(LenW); {Учитываем очередной символ в длине слова.}
          {Отслеживаем конец слова.}
          if (i = Len) or (S[i + 1] in Dw) then
          begin
            if IsDataW then
            begin
              IsDataW := Push(StW, Copy(S, i - LenW + 1, LenW)); {Добавление слова в стек.}
              if IsDataBw then
                IsWord := True; {Флаг: последний добавленный элемент - слово.}
            end;
            LenW := 0; {Сброс длины слова.}
          end;
        end;
        {Обработка предложений.}
        {Если обнаружен конец предложения.}
        if (S[i] in Doff) or ((i = Len) and Eof(FIn)) then
        begin
          StWrite(FOut, StW, StBw, IsWord); {Запись содержимого стека в файл.}
          IsDataW := True;
          IsDataBw := True;
        end;
      end;
      {Обработка переносов строк.}
      if Eoln(FIn) and not Eof(FIn) then
      begin
        {Если в стеке междусловий есть свободное место, то добавляем в него
        перевёрнутый перенос строки.}
        if IsDataBw then
        begin
          Data := #10#13; {Перевёрнутый перенос строки.}
          {Если предыдущий элемент строки являлся междусловием, то выполняем склейку.}
          if not IsWord and Pop(StBw, DataTmp) then
            Data := DataTmp + Data;
          IsDataBw := Push(StBw, Data); {Добавление междусловия в стек.}
          if IsDataBw then
            IsWord := False; {Флаг: последний добавленный элемент - междусловие.}
        end;
        Readln(FIn); {Переходим к следующей строке во входном файле.}
      end;
    end;
    {Записываем в файл то, что осталось в стеке.}
    StWrite(FOut, StW, StBw, IsWord);
 
    {Закрываем файлы.}
    Close(FIn);
    Close(FOut);
    {Освобождение памяти, занятой для стеков.}
    StFree(StW);
    StFree(StBw);
    Writeln('Обработка завершена.');
    Writeln('Память, выделенная для стеков, освобождена.');
 
    Writeln('Повторить - Enter. Выход - любой символ + Enter.');
    Readln(S);
  until S <> '';
end.
0
01.03.2014, 09:27
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
01.03.2014, 09:27
Помогаю со студенческими работами здесь

Используя стек, распечатать слова из текстового файла в обратном порядке
помогите решить задачу. используя стек распечатать слова в текстовом файле в обратном порядке....

В каждой строке текстового файла переставить слова в обратном порядке
Дан текстовый файл.Создать новый, каждая строка которого получается из соответствующей строки...

Вывести слова каждого предложения текстового файла на экран в обратном порядке
Помогите пожалуйста Задание: Написать программу, выводящую слова каждого предложения текстового...

Имеется типизированный файл, в котором записаны 18 целых чисел. Переписать все положительные числа файла в массив в том же порядке
program viweglavnoidiagonaali; var f:file of integer; i,bi,k,d,z,z1,a,b,x,y:integer; begin...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
20
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2024, CyberForum.ru