Помощь - Поиск - Пользователи - Календарь
Полная версия: Строки
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
Кирилл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.


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

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

qwerty***123456

?

КириллV
входные данные: qwerty***123456
выходные: qwerty***123456

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

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

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

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

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

КириллV
Цитата(klem4 @ 16.01.2008 19:27) *

update

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


Да совершенно верно... и программа как раз должна выделять подстроки если он есть, а если нет то писать что их нет...)
Я щас думаю над разными вариантами исправления, если у кого появятся идеи пишите код прямо здесь, заранее спасибо)
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
Цитата(klem4 @ 16.01.2008 21:40) *

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

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
Цитата(Yevgeny @ 16.01.2008 21:45) *

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

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

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


count-это глобальная переменная я её использую как накопитель и флаг и в цикле я хочу её обнулять при определённых условиях, но именн оно не работает.
klem4
а вот вранья не надо, моя программа проходит _все_ тексты приведенные на этой странице, только единственное ищется подстрока с максимальным содержанием букв, не ужели так сложно догадаться по префиксам max_ ? Изменить нужно буквально три строчки ...
Rian
Закончил я свой код.
Боже, какое ламерство, столько паники, а всего единичку не дописал.
klem4, спасибо за функцию.
КириллV
Цитата(klem4 @ 17.01.2008 9:17) *

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


Извини не заметил... good.gif
Всем спасибо за помощь...
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.