Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Центр помощи > [Pascal]Редактирование текста

Автор: fandelle 1.6.2009, 19:56

Обнаружить в тексте дважды записанное слово и исправить такие ошибки.

Вот я сам попробовал, но ничего дельного не выходит

Код


var s1,s2,s3,t,r:string;
d,c,b,a,n,j,i,k:integer;
begin
  Readln(t);
  n:=length(t);
  r:='.';
  for i:=1 to n do
 begin
   if t[i]='' then 
   a:=i;
   for j:=1 to a do
   s1[j]:=t[j];
   b:=i+1;
   for k:=b to n do
  begin
    if t[k]='' then
    d:=1;
    c:=k;
    for j:=b to c do 
 begin
   s2[d]:=t[b];
   d:=d+1;
 end;
  end;
 if s1=s2 then
 s3:=copy(t,1,a) else
 s3:=copy(t,1,k);
 r:=concat(r,s3,'');
 r:=delete(t,i,k);
 end;
writeln(r);
end.

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

M
Rodman

Модератор: Используйте корректную подсветку кода!

Автор: neic 2.6.2009, 00:27

Цитата(fandelle @ 1.6.2009, 19:56

)

и исправить такие ошибки.

Какие?

Если хочешь сам решить могу посоветовать что нужно сделать.

Объявляешь массив, в котором будут храниться слова и кол-во совпадений.
Например:

Код


VAR SLOVA:ARRAY[1..999,2] OF STRING

{тут ищешь слово, дошёл до пробела или знака препинания входишь в цикл (ниже приведён), и так каждое слово}
FOR I:=1 TO 999 DO
BEGIN
       IF SLOVA[I,1] = '' THEN 
       BEGIN
             SLOVA[I,1]:= SLOVO;
             SLOVA[I,1]:= 1;
             I:=999; {выходим из цикла}
       END;

       IF SLOVA[I,1] = SLOVO THEN SLOVA[I,2]:=SLOVA[I,2]+1
END;

writeln;
writeln('Дважды записанное слово');

FOR I:=1 TO n DO
BEGIN
       IF SLOVA[I,2] = 2 THEN writeln(SLOVA[I,1]);
END;

НУ вот что-то похожее.
Тока тут нужно посмотреть даст ли паскаль заносить цифры в массив этот и сравнивать.

Если не даст, то можно сделать 2 массива (одномерных) в одном массиве слово, а в другом параллельно кол-во совпадение например.

Код


SLOVA[1]:='предмет' {слово}
SLOVA2[1]:=1 {кол-во совпадений слова предмет}

SLOVA[1]:='Pascal' {фамилия}
SLOVA2[1]:=2 {кол-во совпадений слова Pascal}

Ну и тогда объявления будут такими:

Код


SLOVA: array [1...n] of string;
SLOVA2: array [1...n] of integer;

Идея понятна?
Можно, и наверное нужно, предусмотреть регистры слов. Т.е. в моём примере если будут слова "предмет" и "Предмет" программа посчитает эти слова разными.
Выход таков, весь текст сделать в высоком регистре, либо в маленьком, в общем чтобы "предмет" и "Предмет", стали "ПРЕДМЕТ" и "ПРЕДМЕТ" или наоборот "предмет" и "предмет"

Автор: fandelle 2.6.2009, 04:57

Цитата

Какие?

Я наверно не полностью отразил суть задания. Надо не просто узнать сколько слово повторяется, но и удалить повторяющееся, так, чтобы один раз только встречалось.

Автор: volvo877 2.6.2009, 09:59

Цитата(fandelle @ 2.6.2009, 04:57

)

Надо не просто узнать сколько слово повторяется, но и удалить повторяющееся, так, чтобы один раз только встречалось

Я для таких целей пользуюсь вот этим:

Код

const
  delimiter = [#32, ',', '.', '!', ':'];
type
  wrd_info = record
    start, len: byte;
  end;
function get_words(s: string;
         var words: array of wrd_info): integer;
var
  count: integer;
  i, curr_len: byte;
begin
  count := -1; i := 1;
  while i <= length(s) do begin
    while (s[i] in delimiter) and (i <= length(s)) do inc(i);
    curr_len := 0;
    while not (s[i] in delimiter) and (i <= length(s)) do begin
      inc(i); inc(curr_len);
    end;
    if curr_len > 0 then begin
      inc(count);
      with words[count] do begin
        start := i - curr_len;
        len := curr_len
      end;
    end;
  end;
  get_words := count + 1;
end;

procedure delete_dup(var s: string;
          var words: array of wrd_info; n: integer);
var i, j: integer;
begin
  for i := pred(n) downto 0 do
    for j := pred(i) downto 0 do
      if copy(s, words[i].start, words[i].len) =
         copy(s, words[j].start, words[j].len) then
           delete(s, words[i].start, words[i].len);
end;

const
  max_word = 255;
var
  words: array[1 .. max_word] of wrd_info;
  i, n: integer;
const
  { Вот эту строку будем проверять }
  s: string = 'thats,,, all :: thats folks !!! bye..bye.';
begin
  n := get_words(s, words);
  delete_dup(s, words, n);
  writeln('s = ', s);
end.

Алгоритм очень простой: проходим по строке, и выделяем из нее слова, а потом дубликаты удаляем... Только сами слова не храним, а храним их "координаты": позицию начала (от начала строки) и длину. А конструкции типа

Цитата(neic @ 2.6.2009, 00:27

)

Код

VAR SLOVA:ARRAY[1..999,2] OF STRING

я не использую, ибо компилятор просто не отдаст 101888 байт под массив. Нету у него столько... Есть на всё про всё 64К. Это все-таки Паскаль, а не Дельфи.

Если что непонятно по моему коду - спрашивай...

Автор: fandelle 2.6.2009, 10:47

Не могли бы вы пояснить первую процедуру по подробнее. В частности чем два цикла while отличаются.

Автор: volvo877 2.6.2009, 11:00

Цитата(fandelle @ 2.6.2009, 10:47

)

В частности чем два цикла while отличаются.

Условием. Там not во втором цикле добавлен... Итого: пока работает первый - пропускаются разделители между словами (до первой буквы), пока работает второй - мы находимся внутри слова, считаем его буквы (до первого разделителя)...

Автор: fandelle 2.6.2009, 11:44

Код


 if curr_len > 0 then begin
      inc(count);
     with words[count] do begin

и вот это ещё поясните пжлст. with для чего?

Автор: neic 2.6.2009, 18:04

fandelle, это атрибуты записи, смотри volvo же описал этот тип

Код


type
  wrd_info = record
    start, len: byte;
  end;

А тут:

Код


      with words[count] do begin
        start := i - curr_len;
        len := curr_len
      end;

заполняются эти атрибуты...

Автор: fandelle 2.6.2009, 18:24

Ага, понятно.
Спасибо большое.