Строки Опции

[КириллV]

Помогите пожалуйста отладить программу, задача такая:

Вводится текст.
Создается новый массив подстрок, выделяется из каждой строки подстроки:
Разделенные более чем тремя знаками звездочка <*>.Среди выделенных подстрок находится подстрока:
Cодержащая минимальное число латинских букв.

Неполадка заключается в том что программа формирует и выводит массив строк даже, если символа звездочка нет или меньше 3х...

Вот код программы:

 

Program StringAnalyz;

uses crt;

var
   f                                  :text;
   s                                  :string;
   substrings                         :array [0..200] of string;
   i,j,min,minindex,counter,lettercode:integer;

Begin
clrscr;
writeln('Создать новый массив подстрок, выделив из каждой строки подстроки:');
writeln('Разделенные более чем тремя знаками звездочка <*>.');
writeln('Среди выделенных подстрок найти подстроку:');
writeln('Содержащую минимальное число латинских букв.');

assign(f,'swop.tmp');
rewrite(f);
Writeln ('Введите текст:');
readln (s);
i:=0;
while not(s='') do
      begin
      writeln(f,s);
      while pos('****',s)>0 do
         begin
         if length(copy(s,1,pos('****',s)-1))>0 then
            begin
            substrings[i]:=copy(s,1,pos('****',s)-1);
            i:=i+1;
            end;
         delete(s,1,pos('****',s)+2);
         while copy(s,1,1)='*' do delete (s,1,1);
         end;
      if length(s)>0 then
         begin
         substrings[i]:=s;
         i:=i+1;
         end;
      readln (s);
      end;
close(f);

writeln('Подстроки:');
min:=length(substrings[0]);
for j:=0 to i-1 do
    begin
    writeln(substrings[j]);
    counter:=0;
    for i:=1 to length(substrings[j]) do
        begin
        lettercode:=ord((substrings[j])[i]);
        if ((lettercode>64) and (lettercode<98))or((lettercode>89) and (lettercode<123)) then counter:=counter+1;
        end;
    if counter<min then
        begin
        min:=counter;
        minindex:=j;
        end;
    end;

writeln;
writeln('Строка содержащая минимальное кол-во латинских букв:');
writeln(substrings[minindex],'   (',min,' латинских букв)');
writeln;
writeln('Нажмите любую клавишу для завершения работы...');
while not keypressed do;
End.

 

Сообщение отредактировано: КириллV - 16.01.2008 13:58

[klem4]

приведи пару примеров входных/выходных данных

напримет вот в этом примере 2 подстроки или ни одной ?

qwerty***123456

?

[КириллV]

входные данные: qwerty***123456
выходные: qwerty***123456

тоесть подстроки прога не выделила, но она и не должна, она должна выделять только когда больше 3х символов звездочка...
пример:
входные данные: qwerty****123456
выходные:
Подстроки:
qwerty
123456

строка с мин. кол-вом лат букв: 123456...

а вот если ввести : qwerty123456
то программа просто выводит всю строку
а должна ничего не выводить...

[Rian]

несколько строк, конечно не помешают
по условию в той строке нет подстрок он и проверяет через pos() четыре снежинки.
(должно быть >3)

Может лучше проверять строку вручную, по символьно циклом?
если появляется снежинка, то индекс увеличить, ещё одна-ещё увеличить, А если снежинки закончились и следующий не снежинка, то проверить их количество. Если их мало обнулить индекс, если достаточно скопировать подстроку и удалить...

[klem4]

update

изивиняюсь, вопрос неверный задал. В общем разделитель - последователность символов '*' в количестве 4 и более, так ?



Сообщение отредактировано: klem4 - 16.01.2008 19:31

[КириллV]

update

изивиняюсь, вопрос неверный задал. В общем разделитель - последователность символов '*' в количестве 4 и более, так ?

Да совершенно верно... и программа как раз должна выделять подстроки если он есть, а если нет то писать что их нет...)
Я щас думаю над разными вариантами исправления, если у кого появятся идеи пишите код прямо здесь, заранее спасибо)


Сообщение отредактировано: КириллV - 16.01.2008 20:42

[klem4]

проверь вот это:

uses crt;
const
  max_sequence: string = '';
  max_count: Byte = 0;

function get_count(const s: string): Byte;
var
  i, count: Byte;
begin
  count := 0;
  for i := 1 to length(s) do
    if UpCase(s[i]) in ['A'..'Z'] then
      inc(count);
  get_count := count;
end;

procedure pharse(s: string; was: Boolean);
var
  p, cnt: Byte;
begin
  p := pos('****', s);

  if p = 1 then begin
    p := 5;

    while (p <= length(s)) and (s[p] = '*') do
      inc(p);

    pharse(copy(s, p, 255), true);
  end else begin
    if (p = 0) and was then
      p := length(s)
    else if p > 0 then
      dec(p);

    if p > 0 then begin
      cnt := get_count(copy(s, 1, p));

      if cnt > max_count then begin
        max_count := cnt;
        max_sequence := copy(s, 1, p);
      end;
      pharse(copy(s, p + 1, 255), false);
    end;
  end;
end;

var
  s: String;

begin
  clrscr;

  s := 'qwerty******123**1******6yu***qwertyu';
  pharse(s, false);

  writeln('max_sequence = "', max_sequence, '"');

  readln;
end.

[Rian]

Народ, не пойму где глюк!
если раскоментировать {else count:=0;} то выбивает ошибку "акцес виолатион",
а условие if st[i+1]<>'*' then вообще не проверяется или всегда true???
единственное, что контролирует количество снежинок это if count>3 ПОЧЕМУ?

uses crt;
label
again;
var
st1:string;
st:array[0..20]of string;
i,z,count:integer;
begin
clrscr;
writeln('vasha stroka - ');
readln(st1);

z:=-1;
again:
count:=0;
for i:=1 to length(st1)-1 do
if st1[i]='*' then
   begin
   count:=count+1;
   if st[i+1]<>'*' then
                       begin
                        if count>3
                        then
                          begin
                          z:=z+1;
                          st[z]:=copy(st1,1,i);
                          delete(st1,1,i);
                          goto again;
                          end;
                        {else count:=0;}
                       end;
   end;

for z:=0 to 20 do
if st[z]<>'' then writeln(st[z]);;
readln;
end.

end.

[Yevgeny]

Если раскоментить {else count:=0;}, то тогда у ветви THEN по окончании не должно быть ";", попробуй убрать после End точку с запятой)))

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

[КириллV]

проверь вот это:

uses crt;
const
  max_sequence: string = '';
  max_count: Byte = 0;

function get_count(const s: string): Byte;
var
  i, count: Byte;
begin
  count := 0;
  for i := 1 to length(s) do
    if UpCase(s[i]) in ['A'..'Z'] then
      inc(count);
  get_count := count;
end;

procedure pharse(s: string; was: Boolean);
var
  p, cnt: Byte;
begin
  p := pos('****', s);

  if p = 1 then begin
    p := 5;

    while (p <= length(s)) and (s[p] = '*') do
      inc(p);

    pharse(copy(s, p, 255), true);
  end else begin
    if (p = 0) and was then
      p := length(s)
    else if p > 0 then
      dec(p);

    if p > 0 then begin
      cnt := get_count(copy(s, 1, p));

      if cnt > max_count then begin
        max_count := cnt;
        max_sequence := copy(s, 1, p);
      end;
      pharse(copy(s, p + 1, 255), false);
    end;
  end;
end;

var
  s: String;

begin
  clrscr;

  s := 'qwerty******123**1******6yu***qwertyu';
  pharse(s, false);

  writeln('max_sequence = "', max_sequence, '"');

  readln;
end.

неработает, ввожу строку, даже как в примере, и ничего не происходит...

[Rian]

Если раскоментить {else count:=0;}, то тогда у ветви THEN по окончании не должно быть ";", попробуй убрать после End точку с запятой)))

дело не в ней я её убираю

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

count-это глобальная переменная я её использую как накопитель и флаг и в цикле я хочу её обнулять при определённых условиях, но именн оно не работает.

[klem4]

а вот вранья не надо, моя программа проходит _все_ тексты приведенные на этой странице, только единственное ищется подстрока с максимальным содержанием букв, не ужели так сложно догадаться по префиксам max_ ? Изменить нужно буквально три строчки ...

[Rian]

Закончил я свой код.
Боже, какое ламерство, столько паники, а всего единичку не дописал.
klem4, спасибо за функцию.

[КириллV]

а вот вранья не надо, моя программа проходит _все_ тексты приведенные на этой странице, только единственное ищется подстрока с максимальным содержанием букв, не ужели так сложно догадаться по префиксам max_ ? Изменить нужно буквально три строчки ...

Извини не заметил...
Всем спасибо за помощь...