Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Закрытая тема
Ваша тема закрыта, почему это могло произойти? Возможно,
Нет наработок или кода, если нужно готовое решение - создайте тему в разделе Фриланс и оплатите работу.
Название темы включает слова - "Помогите", "Нужна помощь", "Срочно", "Пожалуйста".
Название темы слишком короткое или не отражает сути вашего вопроса.
Тема исчерпала себя, помните, один вопрос - одна тема
Прочитайте правила и заново правильно создайте тему.
 
Опции темы Поиск в этой теме
Старый 03.12.2006, 10:05   #1
Колян
Пользователь
 
Регистрация: 03.12.2006
Сообщений: 17
По умолчанию Помогите решить задачу!!!

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

Заранее спасибо!!! Не бросайте человека в беде!!
Колян вне форума
Старый 03.12.2006, 12:08   #2
Сильванович Михаил
Студент
Форумчанин
 
Регистрация: 10.11.2006
Сообщений: 196
По умолчанию

type
TMyStrArr = array of string;

function GetWordsBy1stWord(str: string): TMyStrArr;

function WordsInStrA(s: string): integer;
var
b: boolean;
i,j,k: integer;
str: string;
begin
str:=s+' ';
b:=false;
j:=Length(str);
k:=0;
for i:=1 to j do
begin
if (Ord(str[i])=32)and b then
begin
Inc(k);
b:=false;
end else if (Ord(str[i])>64)and(not b) then b:=true;
end;
Result:=k;
end;

function GetWordByNum(x: string; num: integer): string;
var
i,k,l: integer;
begin
if (num<=WordsInStrA(x))and(num>1) then
begin
l:=0;
for i:=1 to num-1 do
begin
repeat
Inc(l);
until x[l]=' ';
repeat
Inc(l);
until x[l]<>' ';
end;
k:=l-1;
if l<Length(x) then
begin
repeat
Inc(k)
until x[k]=' ';
Result:=Copy(x,l,k-l);
end else Result:=''+x[l];
end else if Num=1 then
begin
l:=0;
repeat
Inc(l);
until x[l]=' ';
Result:=Copy(x,1,l-1);
end else Result:='NaN';
end;

var
x: set of Char;
back: string;
c,res: TMyStrArr;
b: boolean;
i,j,count: integer;
begin
if WordsInStrA(str)=1 then
begin
SetLength(res,1);
res[0]:=GetWordByNum(str,1);
Result:=res;
end else if WordsInStrA(str)<1 then
begin
SetLength(res,1);
res[0]:='NaN';
Result:=res;
end else
begin
SetLength(c,WordsInStrA(str));
SetLength(res,WordsInStrA(str));
for i:=0 to WordsInStrA(str)-1 do
c[i]:=GetWordByNum(str,i+1);
back:=GetWordByNum(str,1);
x:=[back[1]];
for i:=1 to Length(back) do
if (not (back[i] in x))or(back[i]<>' ') then x:=x+[back[i]];
x:=x+[' '];
count:=0;
for i:=0 to WordsInStrA(str)-1 do
begin
for j:=1 to Length(c[i]) do
begin
b:=c[i,j] in x;
if not b then break;
end;
if b then
begin
res[count]:=c[i];
Inc(count);
end
end;
c:=res;
SetLength(res,count);
for i:=0 to count-1 do
res[i]:=c[i];
Result:=res;
end;
end;

Вот функция, возвращающая массив слов состоящих из букв, имеющихся
в первом слове строки, включая само первое слово, вроде работает.
Visita Interiorem Terrae Rectificando Operae Lapidem...
Сильванович Михаил вне форума
Старый 03.12.2006, 18:07   #3
Колян
Пользователь
 
Регистрация: 03.12.2006
Сообщений: 17
По умолчанию

Благодарю за решённую задачу!!
Колян вне форума
Старый 03.12.2006, 22:19   #4
Alar
Александр
Администратор
 
Аватар для Alar
 
Регистрация: 28.10.2006
Сообщений: 17,758
По умолчанию

Есть раздел помощь студентам, пишите, пожалуйста, в следующий раз там!
Alar вне форума
Закрытая тема


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
помогите решить задачу... studentIC Помощь студентам 3 12.03.2008 08:29
Помогите решить задачу. Кронос Помощь студентам 3 28.10.2007 14:11
Помогите решить задачу cL1zMa Паскаль, Turbo Pascal, PascalABC.NET 5 15.12.2006 11:04