Отправляет email-рассылки с помощью сервиса Sendsay

RFpro.ru: Программирование на языке Pascal

Подписаться Бесплатная «Золотая» новостная рассылка . Подписчиков 2.943 RSS
←   Декабрь 2012   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31


За последние 60 дней ни разу не выходила


Сайт рассылки: http://prog.rusfaq.ru/pascal
Открыта: 14-03-2002

Автор
Калашников О.А.

Статистика

2.943 подписчиков
0 за неделю
←   Все выпуски   →

RFpro.ru: Программирование на языке Pascal


Хостинг портала RFpro.ru:
Московский хостер
Профессиональный ХОСТИНГ на базе Linux x64 и Windows x64

РАССЫЛКИ ПОРТАЛА RFPRO.RU

Лучшие эксперты по данной тематике

Асмик Гаряка
Статус: Советник
Рейтинг: 10929
∙ повысить рейтинг » 		Орловский Дмитрий
Статус: Мастер-Эксперт
Рейтинг: 7054
∙ повысить рейтинг » 		lamed
Статус: Академик
Рейтинг: 5512
∙ повысить рейтинг »

/ КОМПЬЮТЕРЫ И СОФТ / Программирование / Pascal (Паскаль)

Номер выпуска:1243
Дата выхода:05.12.2012, 15:30
Администратор рассылки:Boriss (Академик)
Подписчиков / экспертов:67 / 76
Вопросов / ответов:1 / 1

Консультация # 186870: Здравствуйте, уважаемые эксперты! Прошу вас помочь реализовать ряд процедур и функций. Const {определение исключительных ситуаций} Type St=array[1..65520] of char; String1=record p_st:^st;{указатель на строку} max:word;{максимальное количес...

Консультация # 186870:

Здравствуйте, уважаемые эксперты! Прошу вас помочь реализовать ряд процедур и функций.
Const {определение исключительных ситуаций}
Type St=array[1..65520] of char;
String1=record
p_st:^st;{указатель на строку}
max:word;{максимальное количество символов в строке, определяется при инициализации}
N:word {динамическая длина строки}
End;

Procedure InitStr(var st:string1; n:word);
Procedure WriteToStr(var st:string1;s:string);
Procedure WriteFromStr(var s:string;st:string1);
Procedure InputStr(var st:string1);
Procedure OutputStr(const st:string1);
Function Comp(s1,s2:string1;var fl:shortint):boolean;
Procedure Delete(var S:String1;Index,Count:word);
Procedure Insert(Subs:String1;var S:String1;Index:word);
Proc edure Concat( const S1, S2:string1;var srez:string1);
Procedure Copy(S:String1;Index,Count:Word; var Subs:string1);
Function Length(S: String1): word;
Function Pos(SubS, S: String1): word;
Var StrError: {тип переменной ошибки}
procedure SrtSet(var s:string;n,l:word;c:char)

Назначение процедур
1. Procedure InputStr(var st:string1). Ввод строки st с клавиатуры.
2. Procedure OutputStr(const st:string1). Вывод строки st на экран мони-тора.
3. Procedure InitStr(var st:string1; n: word). Выделение динамической памяти под строку st, содержащую от 0 до n символов.
4. Procedure WriteToStr(var st:string1; s:string). Запись данных в строку st из строки s.
5. Procedure WriteFromStr(var s:string; st:string1). Запись данных в строку s из строки st.
6. Function Comp(s1,s2:string1; var fl:shortint):boolean. Сравнивает строки s1 и s2. Возвращает true если s1=s2 и fl=0, если s1>s2 и fl=1, если s1<s2 и fl=-1.
7. P rocedure Delete(var S:String1; Index,Count:Word). Удаляет Count символов из строки S,начиная с позиции Index.
8. Procedure Insert(Subs:String1;var S:String1; Index:Word). Вставляет подстроку SubS в строку S,начиная с позиции Index.
9. Procedure Concat( const S1, S2:string1; var srez:string1). Выполняет конкатенацию строк S1 и S2; результат помещает в srez.
10. Procedure Copy (S:String1;Index,Count:Word; var Subs: String1). Возвращает подстроку Subs из строки S,начиная с позиции Index и длиной Count символов.
11. Function Length(S: String1): Word. Возвращает текущую длину строки S.
12. Function Pos(SubS, S: String1): Word. Возвращает позицию, начи-ная с которой в строке S располагается подстрока SubS.
13. procedure SrtSet(var s:string;n,l:word;c:char). Устанавливает l символов строки s, начиная с позиции n, в значение с.

Дата отправки: 27.11.2012, 15:02
Вопрос задал: Посетитель - 395363 (Посетитель)
Всего ответов: 1
Страница онлайн-консультации »

Консультирует Сергей Бендер (Профессионал):

Здравствуйте, Посетитель - 395363!

Текст с комментариями приведён ниже.

Общие замечания
1) Вы не указали прямо надо ли создавать модуль или
реализовывать всё в одной программе. Т.к. второй путь уж больно
громоздок и несуразен, я сделал модуль str1.pas. К нему написана
головная программа str1main.pas, демонстрирующая использование string1.
2) InitStr производит только _начальную_ инициализацию. Чтобы
корректно и безопасно изменять физический размер требуется
отдельная процедура. Раз она не предусмотрена в списке, значит
исхожу из однократной инициальзации строки.
3) В я предполагаю, что вы знаете, как устроен стандартный
паскалевский string.
4) Поскольку string1 явно вводится, как аналог string, то и
поведение Delete, Insert и Copy я задал по аналогии. Т.е.
неверно заданные Index и Count не считаются ошибкой, а тихо
исправляются. Может быть надо было иначе.
5) В имени процедуры SrtSet вероятно есть о печатка. Но я
исправлять не стал.

str1.pas

Код :
unit str1;

interface

Const {определение исключительных ситуаций}
      STRING1_NO_ERROR = 0; // Нет ошибок
      STRING1_TOO_LONG = 1; // Запрос слишком большого количества памяти при инициализации
      STRING1_EXCEED_PASCAL_STRING = 2; // размер превышает пределы паскалевской строки
      STRING1_TOO_SHORT = 3; // Недостаточно выделеннной памяти

      maxN=65520; // максимальный размер выделяемой памяти

Type St=array[1..65520] of char;

String1=record
              p_st:^st;{указатель на строку}
              max:word;{максимальное количество символов в строке, определяется при инициализации}
              N:word {динамическая длина строки}
        End;


Procedure InitStr(var st:string1; n:word);
Procedure WriteToStr(var st:string1;s:string);
Procedure WriteFromStr(var s:string;st:string1);
Procedure InputStr(var st:string1);
Procedure OutputStr(const st:string1);
Function Comp(s1,s2:string1;var fl:shortint):boolean;
Procedure Delete(var S:String1;Index,Count:word);
Procedure Insert(Subs:String1;var S:String1;Index:word);
Procedure Concat( const S1, S2:string1;var srez:string1);
Procedure Copy(S:String1;Index,Count:Word; var Subs:string1);
Function Length(S: String1): word;
Function Pos(SubS, S: String1): word;
Var StrError: byte;{тип переменной ошибки}
procedure SrtSet(var s:string1;n,l:word;c:char);

implementation

Procedure InitStr(var st:string1; n:word);
begin
     if n>maxN  // если запрашивается слишком много памяти
     then StrError:=STRING1_TOO_LONG
     else begin
          GetMem(st.p_st,n*sizeof(char)); // выделяется память и инициализируются поля
          st.N:=0;
          st.max:=n;
          StrError:=STRING1_NO_ERROR;
     end;
end;

Procedure WriteToStr(var st:string1;s:string);
var i:byte;
begin
     if byte(s[0])>st.max  // если размер записываемой (паскалевской) строки превышает
     then StrError:=STRING1_TOO_SHORT  // выделенный объём памяти
     else if StrError=STRING1_NO_ERROR
     then begin
          st.N:=byte(s[0]);
          for i:=1 to st.N do  // поэлементное копирование
               st.p_st^[i]:=s[i];
     end;

end;

Procedure WriteFromStr(var s:string;st:string1);
var i:byte;
begin
     if st.N > 255
     then StrError:=STRING1_EXCEED_PASCAL_STRING
     else begin
          byte(s[0]):=st.N;
          for i:=1 to st.N do  // поэлементное копирование
               s[i]:=st.p_st^[i];
     end;
end;

Procedure InputStr(var st:string1);
var c:char;
begin
     st.N:=0; // сначала строка устанавливается пустой
     read(c); // чтение первого символа
     while (c<>#13) and (st.N<st.max) do
     begin  // пока не прочитали конец строки и не превысили максимальное количество символов
          inc(st.N); // увеличиваем динамический размер
          st.p_st^[st.N]:=c; // и вписываем символ
          read(c); // читаем следующий
     end;
end;

Procedure OutputStr(const st:string1);
var i:word;
begin
     for i:=1 to st.N do // поэлементный вывод на экран
          write(st.p_st^[i]);
end;

Function Comp(s1,s2:string1;var fl:shortint):boolean;
var i:word;
begin
     i:=1;
     // индекс пробегает по строкам пока не кончится одна из них
     // или не найдётся отличающаяся пара
     while (i<=s1.N) and (i<=s2.N) and (s1.p_st^[i]=s2.p_st^[i]) do
          inc(i);
     // индекс вышел сразу за оба размера, но различия не найдены
     // строки совпадают
     if  (i>s1.N) and (i>s2.N) then fl:=0;
     // индекс вышел только за размер s1 и различия не найдены
     // например, s1='qwe' s2='qwert'
     if  (i>s1.N) and (i<=s2.N) then fl:=-1;
     // обратная ситуация
     if  (i<=s1.N) and (i>s2.N) then fl:=1;
     // в i-м элементе найдено различие
     if  (i<=s1.N) and (i<=s2.N) then
          if s1.p_st^[i]<s2.p_st^[i]
          then fl:=-1
          else fl:=1;
     Comp:= fl=0;
end;

// Дополнительная утилита
// исправляет индекс если он подан вне диапазона строки
Procedure FixIndex(S:string1;var Index:word);
begin
     if Index>S.N
     then Index:=S.N+1;  // в конец строки
     if Index<1
     then Index:=1;  // в начало строки
end;

// Дополнительная утилита
// исправляет отступ от индекса выходит за диапазон строки
Procedure FixCount(S:string1;Index:word;var Count:word);
begin
     if Index+Count > S.N
     then Count:=S.N - Index + 1; // до конца строки
end;

Procedure Delete(var S:String1;Index,Count:word);
var i:word;
begin
     FixIndex(S,Index);
     FixCount(S,Index,Count);
     for i:=Index+Count to S.N do  // сдвигается часть строки после
          S.p_st^[i-Count]:=S.p_st^[i]; // удаляемого фрагмента
     dec(S.N,Count);  // уменьшается динамический размер
end;

Procedure Insert(Subs:String1;var S:String1;Index:word);
var i:word;
begin
     if S.N+Subs.N > S.max
     then StrError:=STRING1_TOO_SHORT
     else begin
          FixIndex(S,Index);
          S.N:=S.N+Subs.N;
          for i:=S.N downto Index+Subs.N do  // сдвигается часть строки после
               S.p_st^[i]:=S.p_st^[i-Subs.N]; // места вставки
          for i:=1 to Subs.N do               // сама вставка
               S.p_st^[Index+i-1]:=Subs.p_st^[i];
     end;
end;

Procedure Concat( const S1, S2:string1;var srez:string1);
var i:word;
begin
     if S1.N+S2.N>srez.max
     then StrError:=STRING1_TOO_SHORT
     else begin
          srez.N:=S1.N+S2.N;
          for i:=1 to S1.N do  // поэлементное копирование первой строки
               srez.p_st^[i]:=S1.p_st^[i];
          for i:=1 to S2.N do  // поэлементное копирование первой строки
               srez.p_st^[S1.N+i]:=S2.p_st^[i];
     end;
end;

Procedure Copy(S:String1;Index,Count:Word; var Subs:string1);
var i:word;
begin
     FixIndex(S,Index);
     FixCount(S,Index,Count);
     if Count>Subs.max
     then StrError:=STRING1_TOO_SHORT
     else begin
          for i:=1 to Count do  // поэлементное копирование фрагмпервой строки
               Subs.p_st^[i]:=S.p_st^[Index+i-1];
     end;
end;

Function Length(S: String1): word;
begin
     Length:=S.N;
end;

Function Pos(SubS, S: String1): word;
var i,j,p:word;
begin
     // реализован стандартный алгоритм линейного поиска в строке
     i:=1;p:=0;
     // перебираем позицию в строке S
     while (i<=S.N-Subs.N+1) and (p=0) do
     begin
          j:=1;
          // перебираем и сравниваем элементы в заданных строках
          // в Subs от начала, в S от i
          while (j<=Subs.N) and (Subs.p_st^[j]=S.p_st^[i+j-1]) do
               inc(j);
          if j>Subs.N  // индекс вышел за пределы строки Subs
          then p:=i;  // значит различий не найдено. i -- результат
          inc(i);
     end;
     Pos:=p;
end;

procedure SrtSet(var s:string1;n,l:word;c:char);
var i:word;
begin
     FixIndex(S,n);
     FixCount(S,n,l);
     for i:=n to n+l-1 do
          s.p_st^[i]:=c;
end;

end.


str1main.pas
Код :
uses str1;

var s1,s2,s3:string1;
     st:string;
     f:shortint;
     p:word;

begin
     writeln('>> Checking WriteToStr(s1,''qwertasd'') <<');
     InitStr(s1,10);
     WriteToStr(s1,'qwertasd');
     if StrError=0
     then begin
          write('s1: ');
          OutputStr(s1);
     end
     else write('Error');
     writeln;
     readln;

     writeln('>> Checking WriteFromStr(st,s1); <<');
     WriteFromStr(st,s1);
     write('s1: ');
     OutputStr(s1);
     writeln;
     write('st: ');
     writeln(st);
     readln;

     writeln('>> Checking InputStr(s2); <<');
     InitStr(s2,10);
     write('Enter some string:');
     InputStr(s2);
     readln;
     write('s2: ');
     OutputStr(s2);
     writeln;
     readln;

     writeln('>> Checking Comp(s1,s2,f) <<');
     write('s1: ');
     OutputStr(s1);
     writeln;
     write('s2: ');
     OutputStr(s2);
     writeln;
     if Comp(s1,s2,f)
     then writeln('s1 = s2')
     else if f<0
          then writeln('s1 < s2')
          else writeln('s1 > s2');
     readln;

     writeln('>> Checking Delete(s1,3,5); <<');
     write('s1: ');
     OutputStr(s1);
     writeln;
     Delete(s1,3,5);
     write('s1: ');
     OutputStr(s1);
     writeln;
     readln;

     writeln('>> Checking Insert(s1,s2,3); <<');
     write('s1: ');
     OutputStr(s1);
     writeln;
     write('s2: ');
     OutputStr(s2);
     writeln;
     Insert(s1,s2,3);
     write('s2: ');
     OutputStr(s2);
     writeln;
     readln;

     writeln('>> Checking Concat(s1,s2,s3); <<');
     InitStr(s3,20);
     write('s1: ');
     OutputStr(s1);
     writeln;
     write('s2: ');
     OutputStr(s2);
     writeln;
     Concat(s1,s2,s3);
     if StrError=0
     then begin
          write('s3: ');
          OutputStr(s3);
          writeln;
          write('Length(s3) = ',Length(s3));
     end
     else write('Error');
     writeln;
     readln;

     writeln('>> Checking Copy(s3,5,3,s1); <<');
     Copy(s3,5,3,s1);
     write('s3: ');
     OutputStr(s3);
     writeln;
     write('s1: ');
     OutputStr(s1);
     writeln;
     readln;

     writeln('>> Checking Pos(s1,s3); <<');
     p:=Pos(s1,s3);
     write('s1: ');
     OutputStr(s1);
     writeln;
     write('s3: ');
     OutputStr(s3);
     writeln;
     if p<>0
     then writeln('s1 is found at ',p,' position of s3')
     else writeln('s1 is not found in s3');
     writeln('>Changing s1');
     s1.p_st^[2]:='1';
     write('s1: ');
     OutputStr(s1);
     writeln;
     write('s3: ');
     OutputStr(s3);
     writeln;
     p:=Pos(s1,s3);
     if p<>0
     then writeln('s1 is found at ',p,' position of s3')
     else writeln('s1 is not found in s3');
     readln;

     writeln('>> Checking SrtSet(s3,3,6,''*''); <<');
     SrtSet(s3,3,6,'*');
     write('s3: ');
     OutputStr(s3);
     writeln;
     readln;
end.

Консультировал: Сергей Бендер (Профессионал)
Дата отправки: 03.12.2012, 19:06

5
нет комментария
-----
Дата оценки: 03.12.2012, 22:08
Рейтинг ответа:

НЕ одобряю 0 одобряю!

Оценить выпуск | Задать вопрос экспертам

главная страница  |  стать участником  |  получить консультацию
техническая поддержка  |  восстановить логин/пароль

Дорогой читатель!
Команда портала RFPRO.RU благодарит Вас за то, что Вы пользуетесь нашими услугами. Вы только что прочли очередной выпуск рассылки. Мы старались. Пожалуйста, оцените его. Если совет помог Вам, если Вам понравился ответ, Вы можете поблагодарить автора - для этого в каждом ответе есть специальные ссылки. Вы можете оставить отзыв о работе портале. Нам очень важно знать Ваше мнение. Вы можете поближе познакомиться с жизнью портала, посетив наш форум, почитав журнал, который издают наши эксперты. Если у Вас есть желание помочь людям, поделиться своими знаниями, Вы можете зарегистрироваться экспертом. Заходите - у нас интересно!
МЫ РАБОТАЕМ ДЛЯ ВАС!

© 2001-2012, Портал RFPRO.RU, Россия
Авторское право: ООО "Мастер-Эксперт Про"
Калашников О.А. | Гладенюк А.Г.
Хостинг: Компания "Московский хостер"
Версия системы: 2011.6.36 от 26.01.2012
В избранное