Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Object Pascal: кроссплатформенные технологии > Помогите доделать программу на строки


Автор: Snoooppy 29.5.2006, 17:46
Народ помогите доделать прогу!!!!! Пожалуйста очень нужно!!!!! 

Код
program borlpasc; 
var s,max,ch:string; 
i:integer; 
c:char; 
begin 
repeat 
write('Введите строку:'); 
readln(s); 
ch:=''; 
max:=''; 
for i:=1 to length(s) do 
begin if (s[i]>='A') and (s[i]<='z') then ch:=ch+s[i] 
else begin if length(ch)>length(max) then max:=ch; 
ch:='' 
end; 
end; 
writeln('Слова с неубывающей последовательностью=',length(max)); 
writeln('Продолжить?(y/n)'); 
readln©; 
until c='n' 
end.


Прога должна находить и выводить все слова, буквы которых образуют неубывающую последовательность. 
Например: 
Ввести строку - 
абвг абвгде авыавапефпк5пп иклмнопрсту 
Слова с неубывающей последовательностью - 
абвг абвгде иклмнопрсту


M
Snowy		Подалуйста, используйте кнопку КОД
  

Автор: volvo877 29.5.2006, 18:47
Ну, "доделать" здесь - громко сказано. Твоя программа изначально делала нечто совсем другое... Я бы делал так:
Код

program borlpasc;
var
  s, _word: string;
  i, count: integer;
  c: char;
  ok: boolean;
begin
  repeat
    write('Введите строку:'); readln(s);
    Writeln('Слова с неубывающей последовательностью:'); 
  
    { s := '23456 abcde defkk abnju'; }
  
    _word := '';
    count := 0; ok := true;
    for i := 1 to length(s) do begin
      if not ok or (s[i] = ' ') then begin
  
        if ok and (_word <> '') then begin
          writeln(_word); inc(count);
        end;
        ok := true; _word := '';
  
      end
      else
        if (i > 1)
        then
          if (s[i-1] = ' ') or
             ((s[i-1] <> ' ') and (s[i-1] <= s[i]))
          then begin
            _word := _word + s[i];
          end
          else ok := false
        else _word := _word + s[i];
  
    end;
    if count = 0 then writeln('Не найдены...');
  
    readln(c);
  until upcase(c)='N'
end.


Хотя, возможно, я чересчур усложнил программу и кто-то предложит более простой вариант... 

Автор: Snoooppy 29.5.2006, 21:02
да я ее уже под себя оформил, все работает спасибо огромное!!!
Только вот теперь такой вопрос - разделителями между словами должна служить точка, запятая и пробел.
Как эта функция выглядит???
 

Автор: volvo877 29.5.2006, 21:27
Цитата(Snoooppy @  29.5.2006,  21:02 Найти цитируемый пост)
разделителями между словами должна служить точка, запятая и пробел.
Как эта функция выглядит???

Почти так же, как и раньше (следи за изменениями):
Код

program borlpasc;
var
  s, _word: string;
  i, count: integer;
  c: char;
  ok: boolean;
begin
  repeat
    write('Введите строку:'); readln(s);
    Writeln('Слова с неубывающей последовательностью:'); 

    { s := '23456,abcde defkk,abnju.'; }

    _word := '';
    count := 0; ok := true;
    for i := 1 to length(s) do begin
      if not ok or (s[i] in [' ', ',', '.']) then begin

        if ok and (_word <> '') then begin
          writeln(_word); inc(count);
        end;
        ok := true; _word := '';

      end
      else
        if (i > 1)
        then
          if (s[i-1] in [' ', ',', '.']) or
             (not(s[i-1] in [' ', ',', '.']) and (s[i-1] <= s[i]))
          then begin
            _word := _word + s[i];
          end
          else ok := false
        else _word := _word + s[i];
  
    end;
    if count = 0 then writeln('Не найдены...');
  
    readln(c);
  until upcase(c)='N'
end.
 

Автор: Snoooppy 30.5.2006, 19:02
Вот еще одна проблема, смотрел прогу через дебуггер, вобщем все понятно, она просматривает каждую букву и при правильной последовательности заносит ее в память для дальнейшего вывода на экран, НО прога так же выводит последовательность ИЗ СЛОВ (т.е. талкваабв - и выводит абв) не хотелось бы что бы она это делала, как это исправляется?? подскажите пожалуйста 

Автор: volvo877 30.5.2006, 20:27
Цитата(Snoooppy @  30.5.2006,  19:02 Найти цитируемый пост)
как это исправляется?

Если исправлять эту же программу - то:
Код

    for i := 1 to length(s) do begin
      if not ok or (s[i] in [' ', ',', '.']) then begin
        if ok and (_word <> '') then begin
          writeln(_word); inc(count);
        end
        else                                                        { <--- Добавляем }
          if not ok and not(s[i] in [' ', ',', '.']) then continue; { <--- Добавляем }
        ok := true; _word := '';
      end
      { Дальше - без изменений ... }


но по-моему это уже надо переписывать ... Что-то очень много однотипных действий...

Вот так, например:  smile
Код

const
  delimit = [' ', '.', ','];

var
  s, _word: string;

  i, j, back: byte;
  ok: boolean;

begin
   i := 1;
   write('enter string: '); readln(s);
   { s := '23456,abcdefft defkk,abnjuabcde.'; }

   while i <= length(s) do begin

      while (i <= length(s)) and (s[i] in delimit) do inc(i);
      if i <= length(s) then begin
         back := i;
         while(i <= length(s)) and not(s[i] in delimit) do inc(i);

         _word := copy(s, back, i - back);

         ok := true; j := 2;
         while ok and (j <= length(_word)) do begin
            ok := _word[j - 1] <= _word[j];
            inc(j);
         end;

         if ok then writeln(_word);
      end;

   end;
end.
 

Автор: Snoooppy 30.5.2006, 21:47
я навен с этой прогой скоро с ума сойду!!!!!!!!!!!!!!!
теперь фишка в том что она нехочет записывать последнюю последовательность....например вводим "абв апраопр эюя" - выводит только "абв" про "эюя" забывает
ЧТО ДЕЛАТЬ?? это последний штрих в проге. оставил старый вариант проги
Код

program borlpasc;
Uses Crt;
var
  s, word: string;
  i, count: integer;
  c: char;
  ok: boolean;
begin
ClrScr;
  repeat
    writeln('Программа находит и выводит слова, буквы которых образуют неубывающую последовательность');
    write('Ведите строку:');
    readln(s);
    Writeln('Слова с неубывающей последовательностью букв:');

    { s := '23456 abcde defkk abnju'; }

    word := '';
    count := 0;
    ok := true;
    for i:=1 to length(s) do begin
      if not ok or (s[i] in [' ', ',', '.']) then begin
        if ok and (word <> '') then begin
          writeln(word);
          inc(count);
        end;
        else
          if not ok and not (s[i] in [' ', ',' '.']) then continue;
        ok := true;
        word := '';
      end
      else
        if (i > 1)
        then
          if (s[i-1] in [' ', ',', '.']) or
             (not(s[i-1] in [' ', ',', '.']) and (s[i-1] <= s[i]))
          then begin
            word := word + s[i];
          end
          else ok :=false
        else word :=word + s[i];
    end;
    if count = 0 then writeln('Не найдены...');
    writeln('Продолжить? (y/n)');
    readln(c);

  until (c)='n'
end.

 

и еще не хотелось бы что бы она латинские буквы читала, только кириллицу 

Автор: Zero 31.5.2006, 21:50
Цитата(Snoooppy @  30.5.2006,  22:47 Найти цитируемый пост)
ЧТО ДЕЛАТЬ??

Добавь перед строкой:
Код

if count = 0 then writeln('Не найдены...');

вот такую строку:
Код

if ok and (word <> '') then writeln(word);

Короче вся фишка в том, что когда последняя буква входной строки должна выводится, то у тебя цикл который побуквенно рассматривает каждый символ заканчивается и из него происходит выход, а вывод у тебя предусмотрен внутри этого цикла, вот поэтому у тебя "ЭЮЯ" и не выводится.
Цитата(Snoooppy @  30.5.2006,  22:47 Найти цитируемый пост)
и еще не хотелось бы что бы она латинские буквы читала, только кириллицу

И как это понимать??? smile 
Латиница, это можно сказать английский алфавит
Кириллица это один из видов кодировок ОС...

PS: задавай вопросы по русски... smile  

Автор: Snoooppy 31.5.2006, 21:53
ну чтоб только русские буквы воспринимала
 

Автор: Zero 31.5.2006, 21:57
А, ну это тебе нужно ввод переделать, например не с помощью оператора readln, посимвольно, т.е. в цикле с помощью оператора readkey например и вставить условие приёма символов, чтобы вставлялить только то множество символов которое тебе надо, или наооборот не воспринимались те которые не нужно... 

Автор: Snoooppy 31.5.2006, 22:02
непонял, как это в коде выглядит?? 

Автор: Zero 31.5.2006, 22:06
Короче вот например вставь за место строки:
Код

readln(s);

Вот такой кусок кода:
Код

    s:='';
    repeat
      c:=readkey;
      if c in ['а'..'я','А'..'Я',' ',',','.'] then
      begin
        write(c);
        s:=s+c;
      end;
    until c=#13;

И будет тебе счастье... smile   

Автор: Snoooppy 31.5.2006, 23:12
вобщем додумался  я до такого кода:
Код

program borlpasc;    
Uses Crt;    
var    
  s, word: string;    
  i, count: integer;    
  c: char;    
  ok: boolean;    
begin    
ClrScr;    
  repeat    
    writeln('Программа находит и выводит слова, буквы которых образуют неубывающую последовательность');    
    write('Ведите строку:');    
    readln(s);    
    Writeln('Слова с неубывающей последовательностью букв:');    
    { s := '23456 abcde defkk abnju'; }    
    word := '';    
    count := 0;    
    ok := true;    
    for i:=1 to length(s) do begin
     if ((ord(s[i])>=160)and(ord(s[i])<=175))or((ord(s[i])>=224)and(ord(s[i])<=243))or((ord(s[i])>=128)and(ord(s[i])<=159))or(s[i]='.')or(s[i]=' ')or(s[i]=',') then    
      if not ok or (s[i] in [' ', ',', '.']) then begin    
        if ok and (word <> '') then begin    
          writeln(word);    
          inc(count);    
        end    
        else    
          if not ok and not (s[i] in [' ', ',', '.']) then continue;    
        ok := true;    
        word := '';    
      end    
      else    
        if (i > 1)    
        then    
          if (s[i-1] in [' ', ',', '.']) or    
             (not(s[i-1] in [' ', ',', '.']) and (s[i-1] <= s[i]))    
          then begin    
            word := word + s[i];    
          end    
          else ok :=false    
        else word :=word + s[i];    
    end;
    if ok and (word<> '') then
    writeln(word);    
    if count = 0 then writeln('Не найдены...');    
    writeln('Продолжить? (y/n)');    
    readln(c);    
  until (c)='n'    
end.


и вот новый вопрос, конечно извините что их так много просто в среде программирования я буквально месяц....
короче, мне нужно, чтобы она маленькие и большие буквы считала эквивалентными.....т.е.
АбВгДе ываывавыаыва
строка с неуб посл:
АбВгДе 

Автор: volvo877 1.6.2006, 00:52
Цитата(Snoooppy @  31.5.2006,  23:12 Найти цитируемый пост)
мне нужно, чтобы она маленькие и большие буквы считала эквивалентными

Тогда описывай вот такую функцию (она переводит любой символ - русский или латинский - в верхний регистр):
Код
Function UpperCase(ch: char): char;
Begin
  UpperCase := ch;
  Case ch Of
    'a' .. 'z',
    #160 .. #175: UpperCase := Chr(Ord(ch)-$20);
    #224 .. #239: UpperCase := Chr(Ord(ch)-$50);
  End;
End;

и сравнивай символы последовательности не так:
Код
(s[i-1] <= s[i])

, а вот так:
Код
(UpperCase(s[i-1]) <= UpperCase(s[i]))


(в результате все сравнения будут производиться в верхнем регистре, а сама строка изменяться не будет...) 

Автор: Snoooppy 1.6.2006, 01:06
Спасибо вам мужики!!!! Чтоб я без вас делал???СПАСИБО!!!! 

Автор: ~FoX~ 14.6.2006, 10:43
Цитата(volvo877 @  1.6.2006,  01:52 Найти цитируемый пост)
UpperCase

А зачем вилосипед изабритать, есть же стандартная UpCase функция. 

Автор: volvo877 14.6.2006, 14:20
Цитата(~FoX~ @  14.6.2006,  10:43 Найти цитируемый пост)
есть же стандартная UpCase функция
... которая работает только с латинскими буквами. А с кириллицей что делать? Не использовать? 

Автор: Romikgy 14.6.2006, 15:23
volvo877, AnsiUpperCase
Код

The conversion uses the current locale.
 

Автор: volvo877 14.6.2006, 18:28
Romikgy, Тема в каком разделе? Паскаль? Или Дельфи?
Ты в TPascal видел функцию AnsiUpperCase

Ребята, давайте уже начнем обращать внимание на РАЗДЕЛ, в котором отвечаем?  

Автор: Romikgy 15.6.2006, 08:37
Я конечно , очень давно юзал чистый паскаль smile
Цитата(volvo877 @  14.6.2006,  17:28 Найти цитируемый пост)
Ты в TPascal видел функцию AnsiUpperCase

Честно не видел, как не видел и 
Цитата(~FoX~ @  14.6.2006,  09:43 Найти цитируемый пост)
 UpCase функция.

Сказал по аналогии, если не прав тогда извеняюсь 

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)