Всё то-же кодирование текста

[Тузякин]

Честное слово, я уже не знаю, в чём тут проблема, просто когда тестил, получается, что он не сравнивает элементы строк
Задание:
Зашифровать данный текст, записанный с помощью русских букв и знаков препинания, заменив каждую букву, на букву, отстоящую от неё на n букв. Сдвиг производить по кругу. Исходный и результирующие тексты поместить в файлы.


Проблема в процедуре кодирования....в декодировании всё по аналогии....


Функция R работает как часы, спасибо, что в прошлый раз по поводу неё сказали, она считывает строку из файла с номером pos

заранее спасибо

alp=33{кол-во букв}

Procedure Coding(NStr:integer);
var
mas,b_mas,mas1,b_mas1:string[66];
f:text;
str:string; {кодируемая строка}
pos:integer; {номер строки на которой остановились при кодировке}
N,k,i,j:integer;
M:integer; {число смещения}
begin
pos:=0;
writeln('Введите N');
readln(N);
if N<>0 then
begin
mas:='абвгдеёжзийклмнопрстуфхцчшщъыьэюя';
b_mas:='АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ';
if N>32 then
M:=N-(N div alp)*alp
else
M:=N;
mas1:=mas;
b_mas1:=b_mas;
{сдвигаем буквы алфавита по кругу влево, например при М=1: абвг->бвга}
{--------------------------------------------------------------------}
for i:=1 to (alp-M) do
begin
mas1:=mas1[i+M];
b_mas1:=b_mas1[i+M];
end;
j:=1;
for i:=(alp-M+1) to alp do
begin
mas1:=mas[j];
b_mas1:=b_mas1[j];
j:=j+1;
end;
{--------------------------------------------------------------------}
writeln('Test :',mas1); {test}
readln;
if M=0 then
begin
writeln('Вы выбрали число, при котором будет происходить');
writeln(' круговое смещение и текст не будет закодирован');
readln;
end
else
{сравнивание посимвольно строк текста с несмещённым алфавитом,
при совпадении, текущему элементу присваивается символ из сме-
щенного алфавита}
{--------------------------------------------------------------------}
for i:=1 to NStr do
begin
str:=R(pos);
for j:=1 to length(str) do
begin
if (ord(str[j])>=128) and (ord(str[j])<=159) then
for k:=1 to alp do
if b_mas[k]=str[j] then
str[j]:=b_mas1[k];
if (ord(str[j])>=160) and (ord(str[j])<=175) and (k<>n)
or (ord(str[j])>=224) and (ord(str[j])<=239) and (k<>n) then
for k:=1 to alp do
if mas[k]=str[j] then
str[j]:=mas1[k];
end;
pos:=pos+1;
{$I-} {отключение контроля ошибок ввода\вывода}
assign(f,outp);
reset(f);
if IOResult<>0 then
rewrite(f)
else
append(f);
writeln(f,str);
close(f);
{$I+} {включение контроля ошибок ввода\вывода}

end;
end
else
begin
writeln('N=0, текст не будет закодирован');
readln;
end;
end;

[Хыиуду]

Ой! Узнаю свое задание по практике на 2 курсе! Шифр Цезаря-Августа!
Я бы сделал так:

-- всякие там ассигны-резеты-циклы

Код: Выделить всё

readln(fin,s);
s1='';
for i:=1 to length(s) do
 if pos(s[i],mas)<>0 then
   if M>0 {кодирование}
     then s1:=s1+mas[(pos(s[i],mas)+M) mod alp]
   else {Раскодирование}
     s1:=s1+mas[(pos(s[i],mas)-M+alp) mod alp]
else {не строчная буква}
 if pos(s[i],b_mas)<>0 then
   if M>0 {кодирование}
     then s1:=s1+b_mas[(pos(s[i],b_mas)+M) mod alp]
   else {Раскодирование}
     s1:=s1+b_mas[(pos(s[i],b_mas)-M+alp) mod alp];
 else s1:=s1+s[i]
writeln(fout,s1);

А вообще я обычно во всех программах кодирования просто игнорирую букву Ё, тогда эти массивы не нужны, а можно работать непосредственно с аски-таблицей. Хотя учитывая, что в ДОСе она кривая, лучше, конечно, через массив

ЗЫ: Тузякин, кто тебе в МАИ Паскаль преподает? Не Силаева, часом? Уж больно стиль программирования знакомый!

[Хыиуду]

Код: Выделить всё

if N>32 then
M:=N-(N div alp)*alp
else
M:=N;

Можно было просто написать M:=N mod alp. Правда, не совсем понимаю, почему тут стоит 32, а alp=33

Дальше. Допустим, mas и mas1 - 'абвгд', М=2, alp, соответственно, 5

Код: Выделить всё

for i:=1 to (alp-M) do
begin
    mas1[i]:=mas1[i+M];
    b_mas1[i]:=b_mas1[i+M];
end;

Здесь mas1='вгдгд'

Код: Выделить всё

j:=1;
for i:=(alp-M+1) to alp do
begin
    mas1[i]:=mas[j]; {mas1[4]:=mas1[1]; mas1[5]:=mas1[2]}
    b_mas1[i]:=b_mas1[j];
    j:=j+1;
end;

mas1='вгдвг'
Если уж хочется сделать строку типа 'вгдеёж....эюяаб' - проще всего так:
mas1=copy(mas,M+1,alp-M)+copy(mas,1,M)
Все! Это же у нас не просто массивы, это СТРОКИ!

Код: Выделить всё

for i:=1 to NStr do
begin
    str:=R(pos);
    {....}
    pos:=pos+1;
    {....}
end;

Зачем так усложнять? Не проще ли

Код: Выделить всё

for i:=1 to Nstr do
begin
   readln(fin,str)
   {....}
end;

Переменную pos использовать вообще не рекомендую - в этом случае могут возникнуть глюки с одноименной функцией. Как говорилось в одном анекдоте - "А вооот и онааа!"

Код: Выделить всё

if (ord(str[j])>=128) and (ord(str[j])<=159) then
   for k:=1 to alp do
    if b_mas[k]=str[j] then
       str[j]:=b_mas1[k];
if (ord(str[j])>=160) and (ord(str[j])<=175) and (k<>n)
 or (ord(str[j])>=224) and (ord(str[j])<=239) and (k<>n) then
    for k:=1 to alp do
       if mas[k]=str[j] then
           str[j]:=mas1[k];

То же самое, но намного проще:

Код: Выделить всё

if pos(str[j],b_mas)<>0 then
   str[j]:=b_mas1[pos(str[j],b_mas)];
if pos(str[j],mas)<>0 then
   str[j]:=mas1[pos(str[j],mas)];

Код: Выделить всё

{$I-} {отключение контроля ошибок ввода\вывода}
assign(f,outp);
reset(f);
if IOResult<>0 then
rewrite(f)

Мамма мия! Это что, типа "А мы тебя сейчас для чтения откроем! А если ты жив - еще и для записи!". В задании же сказано: исходный и результирующий тексты поместить в ФАЙЛЫ! А не в ФАЙЛ! В цикле считывать строку из файла, изменять ее и снова записывать в файл, используя при этом rewrite, который полностью удаляет содержимое файла - глупо.

[somewhere]

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

Если есть у нас алфавит и есть строка в которой надо заменить каждую букву на другую отстоящую от нее на N, то возможно самый простой путь - просто следовать словам задачи:

1. Найти позицию символа из строки в алфавите.
2. Взять символ, на N больше (N может быть и меньше 0)
3. И записать его обратно в строку.

А как организовать циклическое вращение спросите вы. А вот тут нужно пользоваться фактом того, что X mod K всегда лежит в диапазоне [0:K-1] при положительном X, и в диапазоне [-K+1:K-1] при отрицательном, т.е. если число получилось отрицательным, то нужно всего-то добавить 33.
Пусть N - число на которое сдвигаем, Р - позиция буквы, тогда новая позиция

P1 := (P + N) mod 33;
P1 := (P1 + 33) mod 33;
или в одну строку
P1 := ((P + N) mod 33 + 33) mod 33;

И никаких проверок, вот такой чисто математический трюк.
Только еще учесть надо что в стринге нумерация с 1 а не с 0.
Вот теперь, подумав, можно и задачу писать:

Код: Выделить всё

uses crt;

var testString : String;

function ShiftString(pString: String; pShift : Integer): string;
var 	mas, b_mas:String;
     	Res: String;
     	p1, p2, x:Integer;
begin
if length(pString) = 0 then exit;
mas:='абвгдеёжзийклмнопрстуфхцчшщъыьэюя';
b_mas:='АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯ';
Res := '';
for x := 1 to length(pString) do
	begin
	p1 := pos(pString[x], mas) - 1;
	p2 := pos(pString[x], b_mas) - 1;
	if p1 <> -1 then
		begin
		p1 := ((P1 + pShift) mod 33 + 33) mod 33;
		Res := Res + mas[p1+1];
		end else
	if p2 <> -1 then
		begin
		p2 := ((P2 + pShift) mod 33 + 33) mod 33;
		Res := Res + b_mas[p2+1];
		end else Res := Res + pString[x];
	end;
ShiftString := Res;
end;

begin
TestString := 'Мама мыла раму';
ClrScr;
Writeln(TestString);
Writeln(ShiftString(TestString, 4));
Writeln(ShiftString(TestString, -35));
Writeln(ShiftString(TestString, 10000));
end.

Давайте будем писать красивый код, где не надо вспоминать, что alp - это число букв в алфавите, где в процедурах и функциях учавствуют диалоги, ввод данных и т.д. Пишите код как сказку для своего ребенка, а не как рецепт пьяного врача, болеющего тремором. Если это процедура или функция - назовите ее нормально (Как корабль назовете ... ), определите число и формат параметров, если вариантов много - выберите самый оптимальный и по данным и по использованию. Это же ваше творение, вы должны знать как поведет себя любой узел, любая переменная или функция в вашем коде. Если что-то не получается - удаляйте все и пишите заново. И пусть что дольше - чистый и слегка ошибочный код всегда лучше работающего, замусоренного ненужным барахлом. Возлюбите свой код и он ответит вам взаимностью, ведь код, это как девушка - если за ней ухаживать, исправлять свои ошибки, уделять ей время, то никогда она не выдаст Runtime error в ресторане или Unhandled exception в постели.

[Absurd]

А обязательно ли выполнять по две операции с линейной сложностью для каждого символа?

[somewhere]

Насколько я знаю Pos он использует Rep scasb что по времени гораздо быстрее некоторых простых констукции в Паскале. Вообще данный алгоритм более универсален чем махинации с Ord, т.к. имеется возможность задавать любой набор символов, который является алфавитом. Количество операций для каждого символа не превышает 4-х. Можно конечно второй Pos в If засунуть, но тогда что-то можно недоглядеть. Время и память в подобного рода функциях вообще понятие не критичное. Здесь важна наглядность.

[Тузякин]

по поводу аски, у меня сначала было целиком через неё сделано, но код получился таким громоздким, и когда я его отлаживал, сам запутался, по этому решил сделать немного по-другому. А лектор у меня была Красовская, но дали мне больше Чечиков и Довыдкина

[Тузякин]

спасибки оооогромное за функцию, и я постараюсь последовать твоему совету в написании программ;-)