Неправильно работает код удаления слова из строки Опции

[-студент-]

Дана строка типа слово1 слово2 слово3 слово1
Надо чтобы после парсинга строки удалились дубликаты те получилось
слово1 слово2 слово3

Код

var
  t,single:string;
  i,j:integer;


function word(t_temp:string; var count: integer):string;
  var
    l1,l2:integer;
  begin
    delete(t_temp, 1, count);
    l1:=pos(' ', t_temp);
    l2:=pos(',', t_temp);
    while (l1=1) or (l2=1) do
      begin
        l1:=pos(' ', t_temp);
        l2:=pos(',', t_temp);
        if (l1=1) or (l2=1) then
          begin
            delete(t_temp,1,1);
            inc(i);
          end;
      end;
    if l1<l2 then
      begin
       result:=copy(t_temp,1,l1);
       inc(count, l1)
      end
    else
      begin
        result:=copy(t_temp,1,l2);
        inc(count,l2);
      end;
end;

function double(t_temp:string; sub:string; vaar count:integer):boolean;
  begin
    delete(t_temp,1,count);
    j:=pos(sub,t_temp);
    if j= 0 then result:=false
    else
      result:=true;
  end;

procedure cut(var str:string; sub:string; var count:integer);
  begin
    j:=pos(sub,str);
     while j<>0 do
      begin
        j:=pos(sub,str);
        delete(str,j,length(sub));
      end;
  end;

begin
  writeln('Enter your string...');
  readln(t);
  i:=0;
  while i<=length(t) do
    begin
      single:=word(t,i);
      if double(t,single,i) then
        cut(t,single,i)
      else inc(i);
    end;
  writeln(t);
  readln;
end.

Помогите пожалуйста

[volvo]

Велосипеды изобретаем? Я пользуюсь вот этим:
Разбиение на слова. Все способы

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

[Гость]

Разбить не проблема проблема удалить дубликаты

[volvo]

Вот как раз это - не проблема... Проход по списку АДРЕСОВ слов (не самих слов, я фактически НЕ изменяю входную строку, как это пытаешься сделать ты) от последнего к первому... 2 вложенных цикла...

+ Пользуйся поиском... Ты думаешь, ты первый, кому это понадобилось? Отнюдь...

[Гость]

Проблема в том что нужно еще вывести слова правильно те
если было слово1 слово2, слово1 то вывести [B]слово2, [B]те оставить пунктуацию

[Гость]

сорри, буду разбираться)

[volvo]

Ты по ссылке был? Видел, КАК находятся слова? Индекс начала и длина... В любой момент времени у тебя есть полный доступ к любому слову, но исходная строка НЕ изменена... Пунктуация твоя никуда не денется... Хотя да, я забыл, тебе же "разбить" не проблема, чего это я?

Велосипед-то твой, ты и изобретай...

[Гость]

я понял спасибо) буду аккуратнее :D

[GuRman]

нет, все таки возник еще один вопрос.
вот есть процедура procedure kill_doubles(var s:string; var wrd: array of info);
в ней мы анализируем слова и удаляем дубликаты. мы можем делать в ней setlength(wrd,length(wrd)-1) ?

[volvo]

SetLength это что? Открытые массивы? Компилятор у тебя какой? Тут вообще-то "чистый" TP подразумевается... Для 32-бит и Delphi есть отдельные форумы...

[GuRman]

все, задачу решил наконец-то)

[volvo]

Молодец! А теперь код выложи сюда, и давай сравним... У меня вот что получилось (привожу только основную часть программы - без функции get_words):

{
  Здесь - реализация get_words ...
}

procedure kill_dups(var s: string; var words: array of wrd_info;
          const size: integer);

  function get_word(ix: integer): string;
  begin
    get_word := copy(s, words[ix].start, words[ix].len)
  end;

var
  i, j: integer;
begin
  for i := pred(size) downto 0 do
    for j := pred(i) downto 0 do
      if get_word(i) = get_word(j) then begin
        delete(s, words[i].start, words[i].len);
        break { breaks the For J loop }
      end;
end;


const
  max_word = 255;
var
  words: array[1 .. max_word] of wrd_info;
  i, n: integer;

const
  s: string = 'thats,,, all :: folks all all, all !!! bye to all...';

begin
  n := get_words(s, words);
  kill_dups(s, words, n);
  writeln(s);
end.

[GuRman]

ну у меня задача еще немного отличалась но этот код получился таким

Код

const
  limits = [#32, ',', '.'];

type
  wrd_info = record
    start, len: byte;
  end;
  tarr= array of wrd_info;
{

  Здесь - реализация get_words ...

}

procedure kill_doubles(var s:string; var wrd: tarr);
var
  i,j,k,l:integer;
begin
  i:=0;
  while i<= high(wrd) do begin
      j:=i+1;
      while j<=high(wrd) do begin
          if copy(s,wrd[i].start,wrd[i].len) = copy(s,wrd[j].start,wrd[j].len) then
            begin
              delete(s,wrd[j].start,wrd[j].len);
              for k:=j+1 to length(wrd) do wrd[k-1]:=wrd[k];
              setlength(wrd, length(wrd)-1);
              for k:=j to length(wrd) do
                with wrd[k] do start:=start-wrd[i].len;
            end
            else
          inc(j);
        end;
      inc(i);
    end;
end;

var
  words: tarr;
  s:string;
  i:integer;

begin
  writeln('Enter your string...');
  readln(s);
  get_wrd(s, words);
  kill_doubles(s,words);
  writeln(s);
  readln;
end.

Основная трабла была как раз в адрессах, я проходился по массиву и соотвественно ему удалял слова. но так же удалял элементы что бы не было повторений лишних. но при этом пришлось изменять адресса начал всех последующих слов. уж не знаю как оптимальней, но на первый раз по-моему не плохо) да и get_words я переписал как процедуру

ЗЫ замечания? 8)

Сообщение отредактировано: GuRman - 16.02.2006 0:04

[volvo]

ЗЫ замечания? 8)

А можешь полностью свою программу приаттачить? Я попробовал переделать get_words в процедуру, но у меня в kill_doubles программа вываливается (FPC 2.0.0) ... Ты чем компилировал?