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

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

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

Восстановить пароль

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

Ответ
 
Опции темы Поиск в этой теме
Старый 13.09.2013, 03:18   #1
AnutaPr
 
Регистрация: 16.08.2013
Сообщений: 6
По умолчанию Задача на паскале -словарь

Не понимаю как решать данную задачу на паскале.
Из всей задачи понимаю, что придется работать с массивами, но как циклы построить правильно для перебора слов я затрудняюсь. Подскажите пожалуйста.

Текст задачи:
У Васи на клавиатуре не работает клавиша пробел. Поэтому все тексты он теперь набирает слитно. Напишите программу, которая будет разделять набранный Васей текст на слова из данного словаря.
Формат входных данных
Сначала на вход программы поступает текст, введенный Васей – одна строка из не более чем 100 латинских строчных букв. В следующей строке входных данных задается значение N – количество слов в словаре (N – натуральное число, не превосходящее 2000). В следующих N строках записаны слова из словаря – по одному слову в строке, каждое слово содержит не более 20 латинских строчных букв. Слова записаны в алфавитном порядке.
Формат выходных данных
Выведите Васин текст с пробелами между словами (пробел после последнего слова допустим). Если возможно несколько вариантов разбиения строки на слова, выведите любой их них. Гарантируется, что хотя бы один способ разбиения строки на словарные слова существует.

Заранее спасибо)
AnutaPr вне форума Ответить с цитированием
Старый 13.09.2013, 10:09   #2
gaw4
Форумчанин
 
Регистрация: 31.05.2010
Сообщений: 407
По умолчанию

N – количество слов в словаре (N – натуральное число, не превосходящее 2000)
словарь составлен ?
icq 584 308 611
gaw4 вне форума Ответить с цитированием
Старый 13.09.2013, 10:28   #3
Serge_Bliznykov
Старожил
 
Регистрация: 09.01.2008
Сообщений: 26,229
По умолчанию

Цитата:
Сообщение от gaw4 Посмотреть сообщение
словарь составлен ?
коллега, ну что Вы, зачем TC составлять словарь, если он КАЖДЫЙ раз будет разный.

Это явно олимпиадная задачка. Словарь задаётся исходными данными.
"Подлянка" будет в том, что будут слова, начинающиеся одинако.
например,
МАМАМЫЛАРАМУ

будет такой словарь
АМУ
АРА
ЛАР
МА
МАМ
МАМЫ
МУ

вполне допускаю, что задачу можно решать через рекурсию (если не удалось найти очередное слово, откатываемся назад, берём следующее подходящее...), главное, чтобы хватило стека и времени...
Serge_Bliznykov вне форума Ответить с цитированием
Старый 13.09.2013, 11:53   #4
gaw4
Форумчанин
 
Регистрация: 31.05.2010
Сообщений: 407
По умолчанию

(N – натуральное число, не превосходящее 2000
тогда довольно таки забавно проверять работоспособность программы
если N=2000 и каждый раз вводить словарь
icq 584 308 611
gaw4 вне форума Ответить с цитированием
Старый 13.09.2013, 12:09   #5
BDA
МегаМодератор
СуперМодератор
 
Аватар для BDA
 
Регистрация: 09.11.2010
Сообщений: 7,430
По умолчанию

Тестировать можно здесь - http://informatics.mccme.ru/moodle/m...?chapterid=515.
Мб вечером попробую решить.
Пишите язык программирования - это форум программистов, а не экстрасенсов. (<= это подпись )
BDA вне форума Ответить с цитированием
Старый 15.09.2013, 00:14   #6
BDA
МегаМодератор
СуперМодератор
 
Аватар для BDA
 
Регистрация: 09.11.2010
Сообщений: 7,430
По умолчанию

Не хватило сил додумать основной цикл вчера.
Первоначальное решение (можно, скорее всего, упростить):
Код:
var
  s: string;
  a: array [1 .. 2000] of string[20];
  c: array ['a' .. 'z'] of integer;
  i, n, k, l, m: integer;
  d: char;
  b: array [1 .. 100] of integer;

begin
  readln(s);
  readln(n);
  for d := 'a' to 'z' do
    c[d] := -1;
  for i := 1 to 100 do
    b[i] := -1;
  for i := 1 to n do
  begin
    readln(a[i]);
    if c[a[i][1]] = -1 then
      c[a[i][1]] := i;
  end;
  k := 1;
  l := length(s);
  m := 1;
  while k <= l do
  begin
    if b[m] = -1 then
      b[m] := c[s[k]]
    else
      inc(b[m]);
    if (b[m] = -1) or (a[b[m]][1] <> s[k]) then
    begin
      b[m] := -1;
      dec(m);
      dec(k, length(a[b[m]]));
    end
    else if copy(s, k, length(a[b[m]])) = a[b[m]] then
    begin
      inc(k, length(a[b[m]]));
      inc(m);
    end;
  end;
  for i := 1 to m do
    write(a[b[i]], ' ');
end.
Проходит все 12 тестов (максимум 0.372 секунды - ограничение 1 секунда).
Решение запутанное, так как вместо рекурсивной функции был реализован стек через массив. Уровень "неприятности" можно оценить хотя бы по уровню косвенности (конструкции вида c[a[i][1]] или a[b[m]]).
Пишите язык программирования - это форум программистов, а не экстрасенсов. (<= это подпись )
BDA вне форума Ответить с цитированием
Старый 19.09.2013, 18:03   #7
Poma][a
Новичок
Джуниор
 
Регистрация: 11.10.2011
Сообщений: 3,882
По умолчанию

Добрый день..
Вот я что-то накропал.. Проходит только 2 теста.. в остальных или неправильный ответ или "Ошибка во время выполнения программы"..
Свой косяк я найти не могу.. мои тесты проходят.. прошу помощь, заранее спасибо!
Код:
var
	txt : string;
	dict, p : array [1..20000] of string;
	n, cnt : Integer;



procedure Init ;
var
	i : Integer;

begin
	ReadLn (txt);
	ReadLn (n);
	cnt := 1;

    for i := 1 to 2000 do
                p[i] := #13;

	for i := 1 to n do
		ReadLn (dict[i])
end;


function DeleteSpace (s : string) : string;
var
	i : Integer;
	r : string;

begin
	r := '';

	for i := 1 to Length(s) do
		if (s[i] <> ' ') and (s[i] <> #13) then
			r := r +s[i];

	DeleteSpace := r
end;

procedure Solution ;
var
	t, s : string;
	i, j, k, count : Integer;
	a : array [1..1000] of string;


begin
	t := '';
        i := 1;
        while i <= Length(txt) do begin
			count := 0;
			t := txt[i];
                for j := 1 to n do
                	if t = dict[j][1] then begin
		                Inc (count);
                        a[count] := dict[j];
                        end;


			if count = 1 then begin
                for j := 1 to cnt do
                        if (a[1][1] <> DeleteSpace(p[j])[i]) or
                        (Length(DeleteSpace(p[j])) < Length(a[1])+i-2)
                        or (Length(DeleteSpace(p[j])) = 0)then
							p[j] := p[j] + ' ' + a[1];

                        Inc (i, Length(a[1])-1);

			end;

			if count > 1 then begin
				for  k := 1 to cnt do
					for j := 1 to count do
						p[k*count+j] := p[j] + ' ';

				cnt := count*cnt;

				for k := 1 to cnt do
                    if a[k div count+1][1] <> DeleteSpace(p[k])[i-1] then begin
                    p[k] := p[k] + a[k div count+1]
                end;
			end;

			Inc (i)
        end;

end;


procedure PrintSolution;
var
	i, max : Integer;
begin
        max := 1;
        while DeleteSpace(p[max]) <> txt do
                Inc (max);

        for i := max+1 to cnt do
            if (Length(DeleteSpace(p[max])) < Length(DeleteSpace(p[i])))
                and (DeleteSpace(p[i]) = txt)  then
                max := i;

        i := 1;
        while p[max][i] in [' ', #13] do
            Inc (i);

        for i := i to Length(p[max]) do
            Write (p[max][i]);

end;

begin
	Init;
	Solution;
	PrintSolution
end.
Пока нашел пару косяков.. исправляю..

Последний раз редактировалось Poma][a; 19.09.2013 в 21:36.
Poma][a вне форума Ответить с цитированием
Старый 19.09.2013, 22:18   #8
BDA
МегаМодератор
СуперМодератор
 
Аватар для BDA
 
Регистрация: 09.11.2010
Сообщений: 7,430
По умолчанию

Пока прочел не весь Ваш код и не "въехал" в принцип. Замечания по ходу чтения:
Легко могу переполнить массив a;
Не вижу пока смысла в размере на 20000 массива dict.

Интересно, вернется ли ТС за решением, или тема перетечёт в обсуждение различных решений задачки.
Пишите язык программирования - это форум программистов, а не экстрасенсов. (<= это подпись )
BDA вне форума Ответить с цитированием
Старый 19.09.2013, 22:24   #9
Poma][a
Новичок
Джуниор
 
Регистрация: 11.10.2011
Сообщений: 3,882
По умолчанию

Цитата:
Не вижу пока смысла в размере на 20000 массива dict.
Проблема в копирке массива p при варианте, где кол-во подходящих элементов > 1.
А раз отдельно вынести dict я уже и забыл.. Спасибо!
Цитата:
Легко могу переполнить массив a;
Да.. Пожалуй Вы правы.. Нужно добить его до 2000.
Цитата:
Пока прочел не весь Ваш код и не "въехал" в принцип.
Он достаточно прост, я из-за нехватки времени записал его не в очень удобоваримом виде.. ну ниче.. вся ночь впереди, еще успею добить
Цитата:
Интересно, вернется ли ТС за решением, или тема перетечёт в обсуждение различных решений задачки.
А на кой ляд Вам ТС? Система для проверки есть, что ж еще ждать?

Последний раз редактировалось Poma][a; 19.09.2013 в 22:31.
Poma][a вне форума Ответить с цитированием
Старый 20.09.2013, 00:45   #10
Poma][a
Новичок
Джуниор
 
Регистрация: 11.10.2011
Сообщений: 3,882
По умолчанию

Вот я чуть-чуть подправил..
Код:
var
	txt : string;
	p : array [1..20000] of string;
	dict : array [1..2000] of string;
	n, cnt : Integer;

procedure Init ;
var
	i : Integer;

begin
	ReadLn (txt);
	ReadLn (n);
	cnt := 1;

    for i := 1 to 2000 do
                p[i] := #13;

	for i := 1 to n do
		ReadLn (dict[i])
end;


function DeleteSpace (s : string) : string;
var
	i : Integer;
	r : string;

begin
	r := '';

	for i := 1 to Length(s) do
		if (s[i] <> ' ') and (s[i] <> #13) then
			r := r +s[i];

	DeleteSpace := r
end;

procedure Solution ;
var
	t, s : string;
	i, j, k, count : Integer;
	a : array [1..2000] of string;


begin
	t := '';
        i := 1;
        while i <= Length(txt) do begin
			count := 0;
			t := txt[i];
                for j := 1 to n do
                	if t = dict[j][1] then begin
		                Inc (count);
                        a[count] := dict[j];
                        end;


			if count = 1 then begin
                for j := 1 to cnt do
                        if (a[1][1] <> DeleteSpace(p[j])[i]) or
                        (Length(DeleteSpace(p[j])) < Length(a[1])+i-2)
                        or (Length(DeleteSpace(p[j])) = 0)then
							p[j] := p[j] + ' ' + a[1];

                        Inc (i, Length(a[1])-1);

			end;

			if count > 1 then begin
				for  k := 0 to count-1 do
					for j := 1 to cnt do
                        p[k*cnt+j] := p[j] + ' ';
				cnt := count*cnt;
                for k := 1 to count do
                    for j := 1 to cnt do
                    if a[k][1] <> DeleteSpace(p[j])[i] then
                        p[j] := p[j] + a[k];
{			for k := 1 to cnt do
                    if a[(k div count)+1][1] <> DeleteSpace(p[k])[i-1] then begin
                    p[k] := p[k] + a[k div count+1]
                end;
 }		end;

			Inc (i)
        end;

end;


procedure PrintSolution;
var
	i, max : Integer;
begin
        max := 1;
        while (DeleteSpace(p[max]) <> txt) and (max < cnt) do
                Inc (max);

        for i := max+1 to cnt do
            if (Length(DeleteSpace(p[max])) < Length(DeleteSpace(p[i])))
                and (DeleteSpace(p[i]) = txt)  then
                max := i;

        i := 1;
        while p[max][i] in [' ', #13] do
            Inc (i);

        for i := i to Length(p[max]) do
            Write (p[max][i]);

end;

begin
	Init;
	Solution;
	PrintSolution
end.
Всё осталось точно также
Poma][a вне форума Ответить с цитированием
Ответ


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



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
словарь ssdo Паскаль, Turbo Pascal, PascalABC.NET 0 29.11.2011 14:57
словарь t9 Yippee-ki-yay Помощь студентам 1 08.11.2011 00:13
Словарь Ципихович Эндрю Microsoft Office Word 2 22.02.2011 21:02
Словарь Rebel123 Софт 4 03.07.2009 09:19