На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Поиск Участники Календарь Избранное RSS
msm.ru
! Исходники Паскаля , Cодержание FAQ (ЧАВО) Паскаля
Название темы должно быть информативным !
Прежде чем задать вопрос, воспользуйтесь Поиском. и проверьте в FAQ (ЧАВО) Паскаля
Чтобы получить вразумительный ответ, подробно опишите проблему: что надо сделать, что не получается и номер ошибки (если есть), которую выводит компилятор.
Для вставки кода ваших программ используйте, пожалуйста, кнопку СODE=pas или выпадающий список СODE для других языков (подсветка синтаксиса).
[!] Как правильно задавать вопросы | Руководство по языку B.Pascal 7 & Objects/LR | Borland Pascal. Руководство пользователя
Модераторы: volvo877
  
> Повторяющиеся символы
Sir
Сообщ. #1 ,

    Junior
    *
    Профиль · PM
    Рейтинг (т): 0
    Условие задачи:
    В файле - строка (не более 255 символов) , удаляем из неё повторяющиеся символы ,
    оставляя символы в том порядке ,в каком они были , пишем полученную
    строку в выходной файл.

    Пример строки во входном файле:
    qqwe12Q21145weW

    Пример выходного файла:
    qwe12Q45W

    Помогите найти ошибку , в выходном файле выдаётся какая-то дребедень

    var inp,outp:text;
       tmp,st:string;
       i,k:byte;
    function search(st:string;ch:char):boolean;
    var
    cnt:byte;
    begin
    for k:=1 to length(tmp) do
    if tmp[k]=ch then cnt:=cnt+1;
    if cnt<>0 then search:=true;
    end;
    function makestr:string;
    begin
    for i:=1 to length(st) do
    if search(tmp,st[i])=false then tmp:=tmp+st[i];
    end;
    begin
        assign(inp,'input.txt');
        reset(inp);
        assign(outp,'output.txt');
        rewrite(outp);
        readln(inp,st);
        tmp:='';
        st:=makestr;
        writeln(outp,st);
        close(outp);
        close(inp);
    end.
    P.O.D
    Сообщ. #2 ,

      Guru
      *******
      Профиль · PM
      Поощрения: 1 Dgm
      Рейтинг (т): 274
      дык cnt надо обнулять.

      Добавлено в
      и вааще алгоритм у тя не рабочий smile.gif

      if search(tmp,st[i])=false then ... а если true ? что тогда ? smile.gif

      т.е ты запишешь только повторы
      Сообщение отредактировано: P.O.D -
      wormball
      Сообщ. #3 ,
        Unregistered
        procedure del_rep(var i, o: string);
         var x: integer; s: array [0..255] of byte;
         begin
          o:='';
          for x:=0 to 255 do s[x]:=0;
          for x:=1 to length(i) do if s[byte(i[x])]=0 do begin
           o:=o+i[x];
           s[byte(i[x])]:=1;
          end;
         end;
        vot
        Some1
        Сообщ. #4 ,
          Profi
          *****
          Профиль · PM
          Поощрения: 32 Dgm
          Рейтинг (т): 63
          Вот ещё более простой способ:
          {qqwe12Q21145weW}
          var
           s,s2:string;
           f:text;
           p:byte;
          begin
           assign(f,'a1.pas'); {Ха, прочтём с самого начала этого файла;))}
           reset(f);
           readln(f,s);
           close(f);
           for p:=1 to length(s) do if pos(s[p],s2)=0 then s2:=s2+s[p];
           assign(f,'out.txt'); {А может лучше в конец этого же файла написать ? Тогда не надо этой строки}
           rewrite(f);  {И тогда тут просто append(f);  %))}
           writeln(f,s2);
           close(f);
          end.
          Сообщение отредактировано: Some1 -
          NneRreaLl
          Сообщ. #5 ,
            Unregistered
            А можно ваааще ч/з множества. Только придётся шманать по регистру. А то он какие укажешь, такие и обработает
            Vesper
            Сообщ. #6 ,

              Master
              ******
              Профиль · PM
              Поощрения: 10 Dgm
              Рейтинг (т): 94
              Пожалуй через множества будет проще, будет где-то такое:
              procedure bla(s1:string;var s2:string);
              var i,j:integer;
              b: set of char;
              begin
               j:=0;
               b:=[];
               s2:='';
               for i:=1 to length(s1) do
               if s1[i] not in b then begin
                 b:=b+[s1[i]];
                 inc(j);
                 s2[j]:=s1[i];
               end;
               s2[0]:=chr(j);
              end;
              Вроде все... smile.gif
              Имхо будет еще и быстрее, так как pos ищет циклом, а not in - нет...
              Сообщение отредактировано: vesper1 -
              wormball
              Сообщ. #7 ,
                Unregistered
                Цитата
                vesper1, 4.12.03, 08:38
                Имхо будет еще и быстрее, так как pos ищет циклом, а not in - нет...

                а как он потвоему ищет??????? интуитивно чтоли??
                Vesper
                Сообщ. #8 ,

                  Master
                  ******
                  Профиль · PM
                  Поощрения: 10 Dgm
                  Рейтинг (т): 94
                  Ну да :) var b:set of char;c:char;
                  c not in b эквивалентно b[ord©]=0
                  wormball
                  Сообщ. #9 ,
                    Unregistered
                    а ежели будет set of longint или set of string??
                    ничего я про множества не знаю smile.gif
                    уменя так с самого начала было smile.gif
                    Some1
                    Сообщ. #10 ,
                      Profi
                      *****
                      Профиль · PM
                      Поощрения: 32 Dgm
                      Рейтинг (т): 63
                      "set of longint" и "set of string" нет в БП (и в ТМТ). Именно потому что пришлось бы создать очень объёмный массив. Зато в TMT можно задать "set of word".

                      Тут вобщето баланс такой - либо быстрее, но больше ресурсов жрёт (как у vesper1), либо медленнее, но меньше ресурсов (как у меня).

                      З.Ы. Зато моя самая короткая - в одной строке кода формируется требуемая строка %)) (тьфу, тафтология)
                      Сообщение отредактировано: Some1 -
                      0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
                      0 пользователей:


                      Рейтинг@Mail.ru
                      [ Script execution time: 0,0249 ]   [ 15 queries used ]   [ Generated: 8.06.23, 22:53 GMT ]  
                      Powered by Invision Power Board(U) v1.2 © 2003  IPS, Inc.