Поиск в строке самой длинной фразы, ограниченной знаками препинания (точкой или запятой)

@Quantum of Solance · Регистрация: 27.03.2009

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

Исходные данные представляют собой строку символов, в состав которой входят предложения, содержащие точки и запятые. Написать Паскаль-программу, включающую две процедуры, выполняющие следующие действия:
1. Поиск в строке самой длинной фразы, ограниченной знаками препинания (точкой или запятой);
2. Исключение из строки самых коротких слов.

Добавлено через 1 час 22 минуты 55 секунд
Вот что я написал, но процедуры как нужно не работают:

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 Laba5;
Uses crt;
Const Fname='c:\1.txt';
 
 
Procedure Input_String(var s1:string; var f:text; var errorcod:byte);
Var i:integer;
Begin
clrscr;
errorcod:=0;
assign(f,Fname);
{$I--}
reset(f);
{$I++}
if ioresult <> 0
then
     begin
     Errorcod:=1;
     end
else
if eof(f)
then
     begin
     Errorcod:=2;
     end
else
i:=0;
while not Eof(f) do
     begin
     readln(f,s1);
     i:=i+1;
     end;
close(f);
writeln(s1);
readln;
end;
 
 
 
procedure find_long_word(s1:string);
const zn=['.',','];
var s2:string;
    s3:string;
    s4:string;
    i,len,max:integer;
Begin
max:=0;
len:=0;
s4:=s1;
s2:='';
s3:='';
i:=1;
while i<=length(s4) do
    begin
    if (s4[i]='.') or (s4[i]=',') {если конец фразы}
    then
         begin
         s2:=copy(s4,1,i); {запоминаем фразу}
         len:=i-1; {длина фразы без последнего знака}
         delete(s4,1,i);
         if len>max
         then
             begin
             max:=len;
             s3:=s2;
             end;{if}
         i:=i+1; {к следующему символу}
         end{if}
    else i:=i+1;
    end;
writeln(s3);
readln;
end;
 
 
 
procedure dell_small_word(s1:string);
const zn=[' '];
      zn1=['.',','];
var s2,s3,s4:string;
    i,j,len,min:integer;
Begin
s2:=s1;
{for i:=1 to length(s2) do
if s2[i] in zn1
then
s2[i]:=' ';
s2:=s2+' ';
while pos('  ',s2)>0 do
delete(s2,pos('  ',s2),1);}
i:=1;
j:=1;
min:=200;
while i<=length(s2) do
      begin
      if s2[i]=' '
      then
            begin
            len:=i-j;
            if len<min
            then
                begin
                min:=len;
                end;
            i:=i+1;
            j:=i;
            end
      else
      i:=i+1;
      end;
writeln('Длина наименьшего слова равна = ',min);
i:=1;
j:=1;
while i<=length(s2) do
      begin
      if s2[i] in zn
      then
            begin
            len:=i-j;
            if len=min
            then
                 begin
                 delete(s2,j,i);
                 end
            else
            i:=i+1;
            j:=i;
            end
      else
      i:=i+1;
      end;
writeln(s2);
readln;
end;
 
 
 
Procedure Error_analisys(errorcod:integer);
Begin
case errorcod of
1:writeln('Ошибка, файл не найден');
2:writeln('Файл пуст');
end;
end;
 
 
Var s:string;
    fileinput:text;
    errorcode:byte;
Begin
clrscr;
Input_string(s,fileinput,errorcode);
find_long_word(s);
dell_small_word(s);
Error_analisys(errorcode);
readln;
end.

Добавлено через 31 минуту 47 секунд
процедура procedure find_long_word(s1:string); неправильно работает в другой я нашел ошибку.

@Puporev · 27.03.2009, 23:07

1. Ввод из файла обязательно?
2. Вот это что?

Pascal
1
2
3
4
5
6
i:=0;
while not Eof(f) do
     begin
     readln(f,s1);
     i:=i+1;
     end;

Попытка ввести несколько строк? По условию вроде одна строка.

@Quantum of Solance · 27.03.2009, 23:30 **[ТС]**

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

Добавлено через 1 минуту 21 секунду
эта процедура работает нормально, у меня проблема с поиском самой большой фразы, но за замечание спасибо.

Добавлено через 18 минут 50 секунд
Все, исправил все ошибки.
Вот программа все работает:

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
Program Laba5;
Uses crt;
Const Fname='c:\1.txt';
 
 
Procedure Input_String(var s1:string; var f:text; var errorcod:byte);
Begin
clrscr;
errorcod:=0;
assign(f,Fname);
{$I--}
reset(f);
{$I++}
if ioresult <> 0
then
     begin
     Errorcod:=1;
     end
else
if eof(f)
then
     begin
     Errorcod:=2;
     end
else
while not Eof(f) do
     begin
     readln(f,s1);
     end;
close(f);
writeln(s1);
readln;
end;
 
 
 
procedure find_long_word(s1:string);
const zn=['.',','];
var s2:string;
    s3:string;
    s4:string;
    i,len,max:integer;
Begin
max:=0;
len:=0;
s4:=s1;
s2:='';
s3:='';
i:=1;
while i<=length(s4) do
    begin
    if (s4[i]='.') or (s4[i]=',') {Ґб«Ё Є®*Ґж да §л}
    then
         begin
         s2:=copy(s4,1,i); {§ Ї®¬Ё* Ґ¬ да §г}
         len:=i-1; {¤«Ё*  да §л ЎҐ§ Ї®б«Ґ¤*ҐЈ® §* Є }
         delete(s4,1,i);
         if len>max
         then
             begin
             max:=len;
             s3:=s2;
             end;{if}
             i:=0; {здесь была ошибка}
         end{if}
    else i:=i+1;
    end;
writeln(s3);
readln;
end;
 
 
 
procedure dell_small_word(s1:string);
const zn=[' '];
var s2,s3,s4:string;
    i,j,len,min:integer;
Begin
s2:=s1;
i:=1;
j:=1;
min:=200;
while i<=length(s2) do
      begin
      if s2[i]=' '
      then
            begin
            len:=i-j;
            if len<min
            then
                begin
                min:=len;
                end;
            i:=i+1;
            j:=i;
            end
      else
      i:=i+1;
      end;
writeln('„«Ё*  * Ё¬Ґ*миҐЈ® б«®ў  а ў*  = ',min);
i:=1;
j:=1;
while i<=length(s2) do
      begin
      if s2[i] in zn
      then
            begin
            len:=i-j;
            if len=min
            then
                 begin
                 delete(s2,j,(i-j)); {и здесь}
                 end
            else
            i:=i+1;
            j:=i;
            end
      else
      i:=i+1;
      end;
writeln(s2);
readln;
end;
 
 
 
Procedure Error_analisys(errorcod:integer);
Begin
case errorcod of
1:writeln('ЋиЁЎЄ , д ©« *Ґ * ©¤Ґ*');
2:writeln('” ©« Їгбв');
end;
end;
 
 
Var s:string;
    fileinput:text;
    errorcode:byte;
Begin
clrscr;
Input_string(s,fileinput,errorcode);
find_long_word(s);
dell_small_word(s);
Error_analisys(errorcode);
end.

29.11.2010, 23:02

Quantum of Solance

Есть проблема в процедуре поиска самого маленького слова. Если слово стоит в конце предложения у точки, программа считывает слово вместе с точкой и оно теперь не самое маленькое. Если перед точкой стоит пробел, то точка - самое маленькое слово.

11.12.2010, 15:53

Вот мой вариант программы, с решенной проблемой последнего слова.

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
Program Lab5;
uses crt;
CONST F_Name='D:/Lab5.txt';
TYPE Massiv=array [1..255] of integer;{massiv dlya hranenia znacheniy nachal i kontsov fraz i slov}
Procedure ChtenieStroki(CONST xFName:string;{schityvaemiy file}
                        VAR xS:string;{ishodnaya stroka}
                        VAR xErrCode:byte);{kod oshibki}
 
VAR f:text;{peremennaya, privyazyvaemaya k filu}
 
begin
   xErrCode:=0;{obnulyaem kod oshibki}
   assign(f,xFName);{privyazyvaem f k filu xFName}
   {$I-};
   reset(f);
   {$I+};
   if IORESULT<>0 then{esli file otsutstvuet}
      xErrCode:=1{prisvaivaem kodu oshibki znachenie 1}
   else{esli file suschestvuet}
   begin
      if Eof(f) then{esli file pust}
      begin
         xErrCode:=2;{prisvaivaem kodu oshibki znachenie 2}
         close(f);{zacryvaem file}
      end
      else{esli file ne pust}
      begin
         readln(f,xS);{schityvaem stroku}
         close(f);{zacryvaem file}
      end;
   end;
end;{ProcChtenieStroki}
 
Procedure Oshibki(xErrCode:byte{kod oshibki});
begin
   Case (xErrCode) of{elsi kod oshibki raven}
   1: writeln('File otsutstvuet');{edinitse, to soobschaem ob otsutstvii fila}
   2: writeln('File pust');{dvum, to soobschaem o tom, chto file pust}
   end;
end; {ProcChtenieErr}
 
Procedure FindLongFraze(xBF:Massiv;{massiv dlya otslezhivaniya nachal fraz}
                        xEF:Massiv;{massiv dlya otslezhivaniya kontsov fraz}
                        xS:string;{ishodnaya stroka}
                        VAR xSLong:string;{samaya dlinnaya fraza (frazy) stroki}
                        VAR max:integer);{maksimal'naya dlina frazy}
 
CONST Znaki=[',','.'];{znaki prepinaniya}
      SOdinakov='Vse frazy odinakovoi dliny';
      {soobschenie pri ravenstve dlin vseh fraz}
      SOdin='Stroka sostoit iz odnoi frazy';
      {soobschenie pri odnoi fraze v stroke}
VAR xSCopy:string;{kopiya ishodnoi stroki}
    xSTemp:string;{stroka dlya vremennogo hraneniya samyh dlinnyh fraz}
    i:integer;{perviy schetchik}
    j:integer;{vtoroi schetchik}
    k:integer;{tretiy schetchik}
    l:integer;{chetvertiy schetchik}
 
begin
   max:=0;{obnulyaem max}
   xSCopy:=xS;{kopiruem xS v xSCopy}
   xSTemp:='';{opustoshaem xSTemp}
   xSLong:='';{opustoshaem xSLong}
   i:=1;{prisvaivaem schetchiky i znachenie 1}
   j:=i;{priravnivaem j k i}
   k:=0;{obnulyaem k}
   l:=0;{obnulyaem l}
   while i<=length(xSCopy) do{poka ne konchitsya stroka}
   begin
      if xSCopy[i] in Znaki then{esli simvol znak prepinaniya}
      begin
         k:=k+1;{uvelichivaem k na 1}
         xEF[k]:=i;{zapominaem konets frazy po znacheniyu i}
         xBF[k]:=j;{zapominaem nachalo frazy po znacheniyu j}
         {writeln(xBW[k]:8,' ',xEW[k]:8);}
         if (xEF[k]-xBF[k])>max then{esli dlina frazy bolshe maksimal'noi}
            max:=(xEF[k]-xBF[k]);{prisvaivaem etu dliny max}
         i:=i+1;{perehodim k sleduyschemy i}
         j:=i;{priravnivaem j k i}
      end
      else
      begin
         {esli simvol probel, a simvol pered nim znak prepinaniya}
         if (xSCopy[i]=' ') and (xSCopy[i-1]=',') or (xSCopy[i-1]='.') then
         begin
            i:=i+1;{perehodim k sleduyschemy i}
            j:=i;{priravnivaem j k i}
         end
         else
            i:=i+1;{perehodim k sleduyschemy i}
      end;
   end;
   if k=1 then{esli v stroke odna fraza}
      xSLong:=SOdin{vpizyvaem v xSLong soobschenie ob odnoi fraze v stroke}
   else
   begin
      for i:=1 to k do{ot 1 do kol-va vseh fraz}
      begin
         if (xEF[i]-xBF[i])=max then{esli dlina frazy maksimal'na}
         begin
            l:=l+1;{pribavlyaem k l 1}
            xSTemp:=copy(xSCopy,xBF[i],(xEF[i]-xBF[i]));{kopiryem etu frazu}
            xSLong:=xSLong+xSTemp+'; ';{pomeschaem ee v xSLong}
         end;
      end;
      if l=k then{esli dlina vseh slov odinakova}
         xSLong:=SOdinakov;
         {vpisyvaem v xSLong soobschenie o ravenstve dlin vseh fraz}
   end;
end;{ProcFindLongFraze}
 
Procedure DeleteSmallWord(xBW:Massiv;{massiv dlya otslezhivaniya nachal slov}
                          xEW:Massiv;{massiv dlya otslezhivaniya kontsov slov}
                          xS:string;{ishodnaya stroka}
                          VAR xSSmall:string;{stroka s udalennymi samymi malen'kimi slovami}
                          VAR min:integer);{dlina samogo malen'kogo slova}
 
CONST Znaki=[' ','.',','];{znaki prepinaniya i probel}
      SOdinakov='Vse slova odinakovoi dliny';
      {soobschenie pri ravenstve dlin vseh slov}
      SOdin='Stroka sostoit iz odnogo slova';
      {soobschenie pri odnom slove v stroke}
VAR i:integer;{perviy schetchik}
    j:integer;{vtoroi schetchik}
    k:integer;{tretiy schetchik}
    l:integer;{chetvertiy schetchik}
    m:integer;{pyatiy schetchik}
 
begin
   xSSmall:=xS;{kopiruem ishodnuiy stroku v xSSmall}
   i:=1;{prisvaivaem i 1}
   j:=i;{priravnivaem j k i}
   k:=0;{obnulyaem k}
   m:=0;{obnulyaem m}
   min:=255;{prisvaivaem min znachenie 255}
   while i<=length(xSSmall) do{poka stroka ne konchilas'}
   begin
      if xSSmall[i] in Znaki then{esli simvol znak prepinaniya ili probel}
      begin
         if (xSSmall[i]=' ') and (xSSmall[i-1]=',') or (xSSmall[i-1]='.') then
         {esli simvol probel, a simvol do nego zapyataya ili tochka}
         begin
            i:=i+1;{perehodim k sleduiyschemu i}
            j:=i;{priravnivaem j k i}
         end
         else{inache}
         begin
            k:=k+1;{pribavlyaem k k 1}
            xEW[k]:=i;{zapominaem konets slova po znacheniyu i}
            xBW[k]:=j;{zapominaem nachalo slova po znacheniyu j}
            {writeln(xBW[k]:8,' ',xEW[k]:8);}
            if (xEW[k]-xBW[k])<min then{esli dlina slova men'she minimal'noi}
               min:=(xEW[k]-xBW[k]);{prisvaivaem etu dliny min}
            i:=i+1;{perehodim k sleduiyschemu i}
            j:=i;{priravnivaem j k i}
         end;
      end
      else
         i:=i+1;{perehodim k sleduiyschemu i}
   end;
   if k=1 then{esli v stroke odno slovo}
      xSSmall:=SOdin
      {vpisyvaem v xSSmall soobschenie ob odnom slove v stroke}
   else
   begin
      for i:=1 to k do{ot 1 do kol-va vseh slov}
      begin
         if (xEW[i]-xBW[i])=min then{esli dlina slova ravna minimal'noi}
         begin
            m:=m+1;{pribavlyaem k m 1}
            delete(xSSmall,xBW[i],(xEW[i]-xBW[i]));{udalyaem eto slovo iz stroki}
            for l:=1 to k do{ot 1 do kol-va vseh slov}
            begin
            {smeschaem posleduiyschie znacheniya kontsov i nachal slov na min vlevo}
               xBW[l]:=xBW[l]-min;
               xEW[l]:=xEW[l]-min;
            end;
         end;
      end;
      if m=k then{esli vse slova odnoi dliny}
         xSSmall:=SOdinakov;
         {vpisyvaem v xSSmall soobschenie o ravenstve dlin vseh slov}
   end;
end;
 
Procedure Pechat(xS:string;{ishodnaya stroka}
                 xSLong:string;{samaya dlinnaya fraza (frazy)}
                 xSSmall:string;{stroka bez samyh malen'kih slov}
                 max:integer;{dlina samoi dlinnoi frazy}
                 min:integer);{dlina samogo korotkogo slova}
 
begin
   writeln('Ishodnaya stroka:');
   writeln(xS);{pechat' ishodnoi stroki}
   writeln;
   writeln('Samaya dlinnaya fraza (frazy):');
   writeln(xSLong);{pechat' samoi dlinnoi frazy (fraz)}
   writeln('Dlina samoi dlinnoi frazy ravna ',max:3);{pechat' dliny samoi dlinnoi frazy}
   writeln;
   writeln('Stroka s udalennymi samymi korotkimi slovami:');
   writeln(xSSmall);{pechat' stroki bez samyh malen'kih slov}
   writeln('Dlina samogo malen''kogo slova ravna ',min:3);{pechat' dliny samogo korotkogo slova}
end;
 
VAR S:string;{ishodnaya stroka}
    SLong:string;{samaya dlinnaya fraza (frazy)}
    SSmall:string;{stroka bez samyh malen'kih slov}
    ErrCode:byte;{kod oshibki}
    BW:Massiv;{nachala slov}
    EW:Massiv;{kontsy slov}
    BF:Massiv;{nachala fraz}
    EF:Massiv;{kontsy fraz}
    Max:integer;{dlina samoi dlinnoi frazy}
    Min:integer;{dlina samogo malen'kogo slova}
 
begin
   clrscr;{ochistka ecrana}
   ChtenieStroki(F_Name,S,ErrCode);{schityvaem stroku (ili zapominaem kod oshibki)}
   if ErrCode>0 then{esli kod oshibki ne raven nuly}
   begin
      Oshibki(ErrCode);{vyvod oshibki}
      halt;{vyhod iz programmy}
   end;
   FindLongFraze(BF,EF,S,SLong,Max);{nahodym sauiy dlinnuiy frazu (frazy)}
   DeleteSmallWord(BW,EW,S,SSmall,Min);{nachodim i udalyaem samye korotkie slova}
   Pechat(S,SLong,SSmall,Max,Min);{pechat rezul'tatov}
   readln;
end.

Новые блоги и статьи Все статьи Все блоги /
Подключение Box2D v3 к SDL3 для Android: физика и отрисовка коллайдеров 8Observer8 29.01.2026 Содержание блога Box2D - это библиотека для 2D физики для анимаций и игр. С её помощью можно определять были ли коллизии между конкретными объектами. Версия v3 была полностью переписана на Си, в. . .	Инструменты COM: Сохранение данный из VARIANT в файл и загрузка из файла в VARIANT bedvit 28.01.2026 Сохранение базовых типов COM и массивов (одномерных или двухмерных) любой вложенности (деревья) в файл, с возможностью выбора алгоритмов сжатия и шифрования. Часть библиотеки BedvitCOM Использованы. . .	Загрузка PNG с альфа-каналом на SDL3 для Android: с помощью SDL_LoadPNG (без SDL3_image) 8Observer8 28.01.2026 Содержание блога SDL3 имеет собственные средства для загрузки и отображения PNG-файлов с альфа-каналом и базовой работы с ними. В этой инструкции используется функция SDL_LoadPNG(), которая. . .	Загрузка PNG с альфа-каналом на SDL3 для Android: с помощью SDL3_image 8Observer8 27.01.2026 Содержание блога SDL3_image - это библиотека для загрузки и работы с изображениями. Эта пошаговая инструкция покажет, как загрузить и вывести на экран смартфона картинку с альфа-каналом, то есть с. . .
Влияние грибов на сукцессию anaschu 26.01.2026 Бифуркационные изменения массы гриба происходят тогда, когда мы уменьшаем массу компоста в 10 раз, а скорость прироста биомассы уменьшаем в три раза. Скорость прироста биомассы может уменьшаться за. . .	Воспроизведение звукового файла с помощью SDL3_mixer при касании экрана Android 8Observer8 26.01.2026 Содержание блога SDL3_mixer - это библиотека я для воспроизведения аудио. В отличие от инструкции по добавлению текста код по проигрыванию звука уже содержится в шаблоне примера. Нужно только. . .	Установка Android SDK, NDK, JDK, CMake и т.д. 8Observer8 25.01.2026 Содержание блога Перейдите по ссылке: https:/ / developer. android. com/ studio и в самом низу страницы кликните по архиву "commandlinetools-win-xxxxxx_latest. zip" Извлеките архив и вы увидите. . .	Вывод текста со шрифтом TTF на Android с помощью библиотеки SDL3_ttf 8Observer8 25.01.2026 Содержание блога Если у вас не установлены Android SDK, NDK, JDK, и т. д. то сделайте это по следующей инструкции: Установка Android SDK, NDK, JDK, CMake и т. д. Сборка примера Скачайте. . .

ik1993
	29.11.2010, 23:02
	Quantum of Solance Есть проблема в процедуре поиска самого маленького слова. Если слово стоит в конце предложения у точки, программа считывает слово вместе с точкой и оно теперь не самое маленькое. Если перед точкой стоит пробел, то точка - самое маленькое слово.