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

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

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

> строки на слова
arhimag
сообщение 20.03.2006 20:37
Сообщение #1


Знаток
****

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

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

program WordsToArray;
uses crt;
type TArray=array[1..128]of string;

var s:string;
mas:TArray;i:integer;

procedure GetWords(s:string; var mas:TArray);
var i,j:shortint;
begin
while pos('  ',s)<>0 do delete(s,pos('  ',s),1);
if s[1]=' ' then delete(s,1,1);
if s[length(s)]=' ' then delete(s,length(s),1);
i:=1;
for j:=1 to length(s) do
if s[j]<>' ' then mas[i]:=mas[i]+s[j] else if i<>high(mas) then inc(i);
end;

procedure EnterElement(s:string; i:integer; arr:TArray);
var j: integer;
begin
for j:= 255 downto i do Arr[j+1]:=Arr[j];
Arr[i]:=s;
end;

procedure Filter(arr:TArray);
var i:integer;
    s: string;
begin
for I:= 1 to 128 do
    case Arr[i,length(Arr[i])] of
    ',': begin s:=','; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas) end;
    '.': begin s:='.'; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    '"': begin s:='"'; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    '!': begin s:='!'; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    '(': begin s:='('; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    ')': begin s:=')'; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    ':': begin s:=':'; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    ';': begin s:=';'; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    '?': begin s:='?'; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    end;
end;

begin
clrscr;
write('> ');
readln(s);
GetWords(s,mas);
filter(mas);
for i:=1 to high(mas) do if mas[i]<>'' then writeln(i,' - ',mas[i]);
end.

пачему выводит стек оверфло?


--------------------
Чего хочет женщина – того хочет Бог
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
  Ответить  Открыть новую тему 
Ответов
arhimag
сообщение 20.03.2006 21:06
Сообщение #2


Знаток
****

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

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

спс yes2.gif

все равно sad.gif no1.gif
Код
program WordsToArray;
uses crt;
type TArray=array[1..128]of string;

var s:string;
mas:TArray;i:integer;

procedure GetWords(s:string; var mas:TArray);
var i,j:shortint;
begin
while pos('  ',s)<>0 do delete(s,pos('  ',s),1);
if s[1]=' ' then delete(s,1,1);
if s[length(s)]=' ' then delete(s,length(s),1);
i:=1;
for j:=1 to length(s) do
if s[j]<>' ' then mas[i]:=mas[i]+s[j] else if i<>high(mas) then inc(i);
end;

procedure EnterElement(s:string; i:integer; arr:TArray);
var j: integer;
begin
for j:= 127 downto i do Arr[j+1]:=Arr[j];
Arr[i]:=s;
end;

procedure Filter(arr:TArray);
var i:integer;
    s: string;
begin
for I:= 1 to 127 do
    case Arr[i,length(Arr[i])] of
    ',': begin s:=','; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas) end;
    '.': begin s:='.'; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    '"': begin s:='"'; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    '!': begin s:='!'; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    '(': begin s:='('; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    ')': begin s:=')'; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    ':': begin s:=':'; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    ';': begin s:=';'; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    '?': begin s:='?'; delete(Arr[i],length(Arr[i]),1); if length(arr[i])<>1 then enterelement(s,i+1,mas)end;
    end;
end;

begin
clrscr;
write('> ');
readln(s);
GetWords(s,mas);
filter(mas);
for i:=1 to high(mas) do if mas[i]<>'' then writeln(i,' - ',mas[i]);
end.


--------------------
Чего хочет женщина – того хочет Бог
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме
arhimag   строки на слова   20.03.2006 20:37
klem4   for j:= 255 downto i do Arr[j+1]:=Arr[j]; 255 + ...   20.03.2006 20:54
arhimag   спс :yes2: все равно :( :no1: program WordsToAr...   20.03.2006 21:06
arhimag   ПАМАГИТТЕ ПЛИЗ   20.03.2006 21:48
Романтик   ПАМАГИТТЕ ПЛИЗ у тебя случайно не ошибка 202???...   20.03.2006 22:02
klem4   Во первых при каких входных данных у тебя возникае...   20.03.2006 22:28
arhimag   нужно разбить строчку на слова , причем каждый зна...   20.03.2006 22:33
klem4   Так пойдет ? uses crt; type TWords = array [...   20.03.2006 22:45
arhimag   Как это помнимать?   20.03.2006 23:00
klem4   inc ( c );   20.03.2006 23:02
arhimag   гразобрался, понял, работьает :) спс   20.03.2006 23:03

« Предыдущая тема · Задачи · Следующая тема »
 

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

 

Режим отображения: Переключить на: Стандартный · Переключить на: Линейный · Древовидный

Подписка на тему · Сообщить другу · Версия для печати · Подписка на этот форум

- Текстовая версия 19.07.2025 23:40
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"