Строковые, слова одинаковой длины |
1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!
Строковые, слова одинаковой длины |
Кристина |
Сообщение
#1
|
Гость |
Привет! Как всегда помогите с задачей на строковые:
Определить количество слов в строке, есть ли одинаковой длины сколько и какие. Если количеством строк все просто, то с длиной сложнее. Помогите хотя бы советом, хотя лучше прогу! Заранее спасибо!!! |
BlackShadow |
Сообщение
#2
|
Гость |
Разбери строку на слова, сохрани их в массисе, а там уж хоть прямым перебором...
|
BlackShadow |
Сообщение
#3
|
Гость |
Код Var s:String; i,j,k,n,len:Integer; Words:Array[1..100] Of String; Const Separators = [' ',',','.','!','?']; {Дополнить по желанию} Begin ReadLn(s); n:=1; i:=1; While i<Length(s) Do Begin While (i<Length(s)) And (s[i] In Separators) Do Inc(i); If Length(s)<i Then Break; j:=i; While (j<Length(s)) And (s[j] In Separators) Do Inc(j); i:=j; Words[n]:=Copy(s,i,j-i); Inc(n) End; WriteLn('Total ',n,' words.'); If n=0 Then Halt; For i:=1 To n-1 Do Begin Len:=Length(Words[i]); k:=i; For j:=i+1 To n Do If Length(Words[j])<Len Then Begin Len:=Length(Words[j]); k:=j End; If k<>i Then Begin s:=Words[i]; Words[i]:=Words[k]; Words[k]:=s End End; i:=1; While i<n Do Begin j:=i+1; While (j<n) And (Length(Words[j])=Length(Words[i])) Do Begin WriteLn(Words[j]); Inc(j) End; If j<>i+1 Then Begin WriteLn(Words[i]); WriteLn('-----------'); WriteLn('Words Of Length ',Length(Words[i])) End; i:=j End End. Должно быть что-то похожее... К сожалению проверить не могу, т. к. Pascal'я под рукой нет. Решение примерно следующее: 1). Вводим строку. 2). Разбираем её на слова и сохраняем их в Words, а их кол-во в n. 3). Сортируем Words по длине строк. Пузырьком, чтоб не париться 4). Выводим строки одинаковой длины: а). Берём очередную строку. б). Рассматриваем все последующие. в). Если длины строк совпадают, то переходим к следующей, иначе прерываем перебор. г). Если нашлась ещё хоть одна строка такой длины, то выводим текущую строку на экран, а затем и длину всех этих строк. Прости за туфтологию :D Вот и всё. |
Кристина |
Сообщение
#4
|
Гость |
Спасибо за программу! Вопрос: а можно сделать то же самое но без массива?
|
BlackShadow |
Сообщение
#5
|
Гость |
а тебя, что списки больше прикалывют?
|
trminator |
Сообщение
#6
|
Четыре квадратика Группа: Пользователи Сообщений: 579 Пол: Мужской Репутация: 4 |
Можно и без массива. Пройти по строке, при этом начало и конец слова выделяются просто. Конец слова -- это когда шли по строке и встречали буквы (слово, то бишь), и вдруг встретили [пробел, запятую, точку, двоеточие, запяточку, ..., далее -- .,: ;]. Начало слова, соответственно, наоборот.
То есть идем по строке,если встретили [.,: ;] (далее -- разделитель),помечаем, что мы -- в слове и начинаем считать символы после этого. Когда встретили следующий разделитель, смотрим, что насчитали. Можно это куда-нибудь сохранить (нет, сохранять все-таки в массив надо будет =). Правда, при таком подходе может получиться слово нулевой длины -- это значит, что коварный препод ввел в строке два разделителя подряд... или три... как я, например, ввожу многоточия =) Слова нулевой длины без особого вреда для здоровья можно игнорировать. ЗЫ Когда снова буду в инете -- не гарантирую =/ так что программа запоздает (если вообще будет=) -------------------- Закон добровольного труда Зимерги:
Люди всегда согласны сделать работу, когда необходимость в этом уже отпала |
trminator |
Сообщение
#7
|
Четыре квадратика Группа: Пользователи Сообщений: 579 Пол: Мужской Репутация: 4 |
Код program words; const letters=['a'..'z']; var s : string; keys : array[0..5, 0..255] of byte; i, l, n : integer; begin Write('Enter string > '); readLn(s); i := 1; n := length(s); while i <= n do begin l := 0; while not (s[i] in letters) and (i <= n) do inc(i); while (s[i] in letters) and (i <= n) do begin inc(l); inc(i) end; inc(keys[0, l]); keys[keys[0, l], l] := i - l; end; for i := 1 to 255 do if keys[0,i] > 1 then writeLn(keys[0,i], ' words with length ', i); ReadLn; end. Вроде работает... В массиве keys в i-м столбце -- номера букв, с которых начинаются слова длины i, в нулевой строке -- количество слов длины i. Можно довольно просто дописАть пару-тройку строк, чтобы выдавались и сами слова с одинаковым кол-вом символов -------------------- Закон добровольного труда Зимерги:
Люди всегда согласны сделать работу, когда необходимость в этом уже отпала |
Текстовая версия | 19.04.2024 18:49 |