Модераторы: volvo877, Snowy, MetalFan

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Помогите доделать программу на строки, программа на строки 
:(
    Опции темы
Snoooppy
Дата 29.5.2006, 17:46 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 29
Регистрация: 29.5.2006

Репутация: нет
Всего: нет
Народ помогите доделать прогу!!!!! Пожалуйста очень нужно!!!!! 

Код
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		Подалуйста, используйте кнопку КОД
  
PM MAIL   Вверх
volvo877
Дата 29.5.2006, 18:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 2
Всего: 116
Ну, "доделать" здесь - громко сказано. Твоя программа изначально делала нечто совсем другое... Я бы делал так:
Код

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.


Хотя, возможно, я чересчур усложнил программу и кто-то предложит более простой вариант... 
PM MAIL   Вверх
Snoooppy
Дата 29.5.2006, 21:02 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 29
Регистрация: 29.5.2006

Репутация: нет
Всего: нет
да я ее уже под себя оформил, все работает спасибо огромное!!!
Только вот теперь такой вопрос - разделителями между словами должна служить точка, запятая и пробел.
Как эта функция выглядит???
 
PM MAIL   Вверх
volvo877
Дата 29.5.2006, 21:27 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 2
Всего: 116
Цитата(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.
 
PM MAIL   Вверх
Snoooppy
Дата 30.5.2006, 19:02 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 29
Регистрация: 29.5.2006

Репутация: нет
Всего: нет
Вот еще одна проблема, смотрел прогу через дебуггер, вобщем все понятно, она просматривает каждую букву и при правильной последовательности заносит ее в память для дальнейшего вывода на экран, НО прога так же выводит последовательность ИЗ СЛОВ (т.е. талкваабв - и выводит абв) не хотелось бы что бы она это делала, как это исправляется?? подскажите пожалуйста 
PM MAIL   Вверх
volvo877
Дата 30.5.2006, 20:27 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 2
Всего: 116
Цитата(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.
 
PM MAIL   Вверх
Snoooppy
Дата 30.5.2006, 21:47 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 29
Регистрация: 29.5.2006

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

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.

 

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

Это сообщение отредактировал(а) Snoooppy - 30.5.2006, 22:00
PM MAIL   Вверх
Zero
Дата 31.5.2006, 21:50 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2169
Регистрация: 23.10.2004
Где: Россия, г. Рязань

Репутация: нет
Всего: 24
Цитата(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  
PM MAIL ICQ   Вверх
Snoooppy
Дата 31.5.2006, 21:53 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 29
Регистрация: 29.5.2006

Репутация: нет
Всего: нет
ну чтоб только русские буквы воспринимала
 
PM MAIL   Вверх
Zero
Дата 31.5.2006, 21:57 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2169
Регистрация: 23.10.2004
Где: Россия, г. Рязань

Репутация: нет
Всего: 24
А, ну это тебе нужно ввод переделать, например не с помощью оператора readln, посимвольно, т.е. в цикле с помощью оператора readkey например и вставить условие приёма символов, чтобы вставлялить только то множество символов которое тебе надо, или наооборот не воспринимались те которые не нужно... 
PM MAIL ICQ   Вверх
Snoooppy
Дата 31.5.2006, 22:02 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 29
Регистрация: 29.5.2006

Репутация: нет
Всего: нет
непонял, как это в коде выглядит?? 
PM MAIL   Вверх
Zero
Дата 31.5.2006, 22:06 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2169
Регистрация: 23.10.2004
Где: Россия, г. Рязань

Репутация: нет
Всего: 24
Короче вот например вставь за место строки:
Код

readln(s);

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

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

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

Это сообщение отредактировал(а) Zero - 31.5.2006, 22:08
PM MAIL ICQ   Вверх
Snoooppy
Дата 31.5.2006, 23:12 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 29
Регистрация: 29.5.2006

Репутация: нет
Всего: нет
вобщем додумался  я до такого кода:
Код

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.


и вот новый вопрос, конечно извините что их так много просто в среде программирования я буквально месяц....
короче, мне нужно, чтобы она маленькие и большие буквы считала эквивалентными.....т.е.
АбВгДе ываывавыаыва
строка с неуб посл:
АбВгДе 
PM MAIL   Вверх
volvo877
Дата 1.6.2006, 00:52 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Комодератор
Сообщений: 2073
Регистрация: 15.11.2004

Репутация: 2
Всего: 116
Цитата(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]))


(в результате все сравнения будут производиться в верхнем регистре, а сама строка изменяться не будет...) 
PM MAIL   Вверх
Snoooppy
Дата 1.6.2006, 01:06 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Новичок



Профиль
Группа: Участник
Сообщений: 29
Регистрация: 29.5.2006

Репутация: нет
Всего: нет
Спасибо вам мужики!!!! Чтоб я без вас делал???СПАСИБО!!!! 
PM MAIL   Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi"
THandle
Rrader
volvo877

Запрещается!

1. Обсуждать и делится взломанными компонентами или программным обеспечением

2. Публиковать ссылки на варез

3. Оффтопить

  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, THandle, Rrader, volvo877.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Object Pascal: кроссплатформенные технологии | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0589 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.