IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> Строки
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 10
Пол: Мужской
Реальное имя: Кирилл

Репутация: -  0  +


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

Вводится текст.
Создается новый массив подстрок, выделяется из каждой строки подстроки:
Разделенные более чем тремя знаками звездочка <*>.Среди выделенных подстрок находится подстрока:
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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


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

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

qwerty***123456

?



--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

Группа: Пользователи
Сообщений: 10
Пол: Мужской
Реальное имя: Кирилл

Репутация: -  0  +


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

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

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

а вот если ввести : qwerty123456
то программа просто выводит всю строку
а должна ничего не выводить...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Знаток
****

Группа: Пользователи
Сообщений: 396
Пол: Мужской

Репутация: -  9  +


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

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


--------------------
Objective-C, Unity3d
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


update

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



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


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Новичок
*

Группа: Пользователи
Сообщений: 10
Пол: Мужской
Реальное имя: Кирилл

Репутация: -  0  +


Цитата(klem4 @ 16.01.2008 19:27) *

update

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


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


Сообщение отредактировано: КириллV -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


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

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.


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Знаток
****

Группа: Пользователи
Сообщений: 396
Пол: Мужской

Репутация: -  9  +


Народ, не пойму где глюк!
если раскоментировать {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.



--------------------
Objective-C, Unity3d
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


The matrix has me!!!
**

Группа: Пользователи
Сообщений: 74
Пол: Мужской
Реальное имя: Евгений

Репутация: -  0  +


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

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


--------------------
"Брать производную можно научить даже обезьяну" - мой препод по матану! :-)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Новичок
*

Группа: Пользователи
Сообщений: 10
Пол: Мужской
Реальное имя: Кирилл

Репутация: -  0  +


Цитата(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.



неработает, ввожу строку, даже как в примере, и ничего не происходит...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Знаток
****

Группа: Пользователи
Сообщений: 396
Пол: Мужской

Репутация: -  9  +


Цитата(Yevgeny @ 16.01.2008 21:45) *

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

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

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


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


--------------------
Objective-C, Unity3d
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Perl. Just code it!
******

Группа: Пользователи
Сообщений: 4 100
Пол: Мужской
Реальное имя: Андрей

Репутация: -  44  +


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


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Знаток
****

Группа: Пользователи
Сообщений: 396
Пол: Мужской

Репутация: -  9  +


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


Прикрепленные файлы
Прикрепленный файл  STR.PAS ( 1.66 килобайт ) Кол-во скачиваний: 161


--------------------
Objective-C, Unity3d
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Новичок
*

Группа: Пользователи
Сообщений: 10
Пол: Мужской
Реальное имя: Кирилл

Репутация: -  0  +


Цитата(klem4 @ 17.01.2008 9:17) *

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


Извини не заметил... good.gif
Всем спасибо за помощь...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 3.12.2020 11:54
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name