• Добро пожаловать на компьютерный форум Tehnari.ru. Здесь разбираемся с проблемами ПК и ноутбуков: Windows, драйверы, «железо», сборка и апгрейд, софт и безопасность. Форум работает много лет, сейчас он переехал на новый движок, но старые темы и аккаунты мы постарались сохранить максимально аккуратно.

    Форум не связан с магазинами и сервисами – мы ничего не продаём и не даём «рекламу под видом совета». Отвечают обычные участники и модераторы, которые следят за порядком и качеством подсказок.

    Если вы у нас впервые, загляните на страницу о проекте, чтобы узнать больше. Чтобы создавать темы и писать сообщения, сначала зарегистрируйтесь, а затем войдите под своим логином.

    Не знаете, с чего начать? Создайте тему с описанием проблемы – подскажем и при необходимости перенесём её в подходящий раздел.
    Задать вопрос Новые сообщения Как правильно спросить
    Если пришли по ссылке со старого Tehnari.ru – вы на нужном месте, просто продолжайте обсуждение.

Заполнение матрицы буквами

  • Автор темы Автор темы slav@
  • Дата начала Дата начала
S

slav@

Ученик
Регистрация
29 Сен 2012
Сообщения
5
Реакции
0
Баллы
0
Заполнение матрицы буквами

дан текст.вводится ключ с помощью которого осуществляется заполнение матрицы по строчкам.написать программу заполнения матрицы.вот пример задания
 

Вложения

  • Снимок.webp
    Снимок.webp
    43 KB · Просмотры: 293
Вам на Аде или Кобол сойдёт?
 
мне если можно,то на паскале......на бейсике еще можно
 
Ничего не понял: в таблице переставлены только строки в соответствии с ключом k1, ключ k2 не задействован. Это как?
 
А, нет - отбой, понял.
 
Ну вот Вам на Free Pascal. Сразу предупреждаю - на Pascal ABC не пойдет: этот ублюдочный продукт типизированных констант в упор не понимает.
Код: 
Const
 k1:Array[1..6] of Byte=(5,3,1,2,4,6);
 k2:Array[1..4] of Byte=(4,2,3,1);
 Coded_Text:String='ПСНОРЙЕРВАИК ЕАНФОИЕОТШВ';
Var
 Decoded_Text_1,Decoded_Text_2,S:String;
 i,j:Byte;
Begin
 Writeln(Coded_Text);
 Decoded_Text_1:='';
 For j:=1 to 4 do
  begin
   S:=Copy(Coded_Text,(k2[j]-1)*6+1,6);
   Decoded_Text_1:=Decoded_Text_1+S;
  end;
 Writeln(Decoded_Text_1);
 Decoded_Text_2:='';
 For i:=1 to 6 do
  For j:=1 to 4 do
   begin
    S:=Copy(Decoded_Text_1,(j-1)*6+k1[i],1);
    Decoded_Text_2:=Decoded_Text_2+S;
   end;
 Writeln(Decoded_Text_2);
 Readln;
End.
 

Вложения

  • FP01.webp
    FP01.webp
    4.7 KB · Просмотры: 117
coded_text не константа.мы вводим текст шифрование перестановкой,и на основе этого текста по ключам создаем матрицу.....вот у меня не получается ее создать((
 
slav@ написал(а):
coded_text не константа.мы вводим текст шифрование перестановкой,и на основе этого текста по ключам создаем матрицу.....вот у меня не получается ее создать((
Нажмите для раскрытия...
Пустяки - сейчас добавлю.
Но вот чего я не пойму, так это того, а что делать, если текст содержит НЕ 24 позиции? То есть меньше или больше. Ведь ключи подобраны именно под 24.
 
Ну пожалуйста, только вот нахрена тут эта матрица - хоть убей, не понимаю. Есть кодированный текст, есть ключи, и этого, на мой взгляд, вполне достаточно. А матрица - она так, похоже, просто для наглядности. Но хотите с матрицей - вот Вам с матрицей:
Код: 
Const
 k1:Array[1..6] of Byte=(5,3,1,2,4,6);
 k2:Array[1..4] of Byte=(4,2,3,1);
Var
 Coded_Text,Decoded_Text_1,Decoded_Text_2,S:String;
 Matrix:Array[1..6,1..4] of Char;
 i,j:Byte;
Begin
 Write('Enter the Coded_Text: ');
 Readln(Coded_Text);
 Writeln;
 For j:=1 to 4 do
  For i:=1 to 6 do
   Matrix[i,k2[j]]:=Coded_Text[(j-1)*6+i];
 Writeln('  k1\k2      1        2        3        4');
 For i:=1 to 6 do
  begin
   Write('    ',i,'    ');
   For j:=1 to 4 do
    write('    ',Matrix[i,j],'    ');
   Writeln;
  end;
 Writeln;
 Decoded_Text_1:='';
 For j:=1 to 4 do
  begin
   S:=Copy(Coded_Text,(k2[j]-1)*6+1,6);
   Decoded_Text_1:=Decoded_Text_1+S;
  end;
 Decoded_Text_2:='';
 For i:=1 to 6 do
  For j:=1 to 4 do
   begin
    S:=Copy(Decoded_Text_1,(j-1)*6+k1[i],1);
   Decoded_Text_2:=Decoded_Text_2+S;
  end;
 Writeln(Decoded_Text_2);
 Readln;
End.
 

Вложения

  • FP01A.webp
    FP01A.webp
    7.3 KB · Просмотры: 108
а если поменять второй ключ то расшифровка работает неправильно(((((((
 
slav@ написал(а):
а если поменять второй ключ то расшифровка работает неправильно(((((((
Нажмите для раскрытия...
Естественно. Потому что тогда надо применить еще правильную шифровку. Этого в программе просто нет. То есть если Вы хотите менять ключи, то программа должна:
1. По ИСХОДНОЙ фразе (в данном случае "ШИФРОВАНИЕ ПЕРЕСТАНОВКОЙ") создать кодированную ("ПСНОРЙЕРВАИК ЕАНФОИЕОТШВ").
2. По кодированной фразе восстановить исходную.
В данной программе первая часть отсутствует. Предлагаю Вам написать ее самостоятельно - это несложно. Удачи.
 
HTML: 
program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils,windows;
Var
 Text,Text_1,Text_2,text_3,S:String;
 Textmatr:Array[1..6,1..4] of Char;
 i,j,k,kolsimvolov:integer;
 key1:array[1..6] of Byte;
 key2:array[1..4] of Byte;
 p,t,m:Boolean;
Begin
  SetConsoleCP(1251);
  SetConsoleOutputCP(1251);
//-------------------------------------------------------------
  repeat
    Write('Введи текст для кодировки: ');
    Readln(Text);
    kolsimvolov:=Length(text);
    m:=True;
    if kolsimvolov>6*4 then m:=False;
     if not(m) then writeln('количество символов не должно превышать 24');
  until m;
 //-------------------------------------------------------------
  If (kolsimvolov mod 24)<> 0 then  //если кол-во символов текста не кратно кол-ву символов в блоке дополняем его пробелами
      begin
        text:=text+' ';
        Inc(kolsimvolov);
      end;
 //------------------------------------------------------------
  Repeat
    Writeln('Введите ключ1');
    for i:=1 to 6 do
    Readln(key1[i]);
    p:=true;
    for i:=1 to 5 do
    if (key1[i]=key1[i+1]) then p:=false;
     If Not(p) then writeln('Все символы должны быть различными!');
  Until  p;
 //------------------------------------------------------------- 
  Repeat
    Writeln('Введите ключ2');
    for i:=1 to 4 do
    Readln(key2[i]);
    t:=true;
    for i:=1 to 3 do
    if (key2[i]=key2[i+1]) then t:=false;
     If Not(t) then writeln('Все символы должны быть различными!');
  Until  t;
  Writeln;
 //------------------------------------------------------
 For i:=1 to 6 do
  For j:=1 to 4 do
   Textmatr[key1[i],j]:=Text[(i-1)*4+j];
   Writeln('  k1\k2      1        2        3        4');
 For i:=1 to 6 do
  begin
    Write('    ',i,'    ');
    For j:=1 to 4 do
    write('    ',textmatr[i,j],'    ');
    Writeln;
  end;
 //------------------------------------------------------
 Text_1:='';
 For j:=1 to 4 do
  for i:=1 to 6 do
  begin
    S:=textmatr[i,key2[j]];
    Text_1:=Text_1+S;
  end;
 Writeln('Закодированный текст:',' ',text_1);
 //-------------------------------------------------------
 Text_2:='';
 For j:=1 to 4 do
  begin
    S:=Copy(Text_1,(key2[j]-1)*6+1,6);
    Text_2:=Text_2+S;
  end;
 Text_3:='';
 For i:=1 to 6 do
  For j:=1 to 4 do
   begin
     S:=Copy(Text_2,(j-1)*6+key1[i],1);
     Text_3:=Text_3+S;
   end;
 Writeln('Раскодированный текст:',' ',Text_3);
//-------------------------------------------------------
 Writeln;
 Readln;
End.
вот программа.но видно я что-то напутала и не могу найти ошибку
 
slav@ написал(а):
вот программа.но видно я что-то напутала и не могу найти ошибку
Нажмите для раскрытия...
К сожалению, сходу не отвечу, надо это вспоминать, вникать, разбираться... Но для начала - мне не понравилась проверка на одинаковость цифр в коде: Вы тестируете только смежные, а надо все со всеми, т.е. тут необходим двойной цикл.
 
Поправил. С ума сойти - уникальная комбинация: ошибка не вылезла в первом варианте. Но теперь всё нормально. Заодно еще кое-где кое-что подчистил.
Код: 
program Project2;

{$APPTYPE CONSOLE}

uses
  SysUtils,windows;
Var
 Text,Text_1,Text_2,text_3,S:String;
 SS:Array[1..4] of String;
 Textmatr:Array[1..6,1..4] of Char;
 i,j,k,kolsimvolov,Code:integer;
 key1:array[1..6] of Byte;
 key2:array[1..4] of Byte;
 p:Boolean;
Begin 
  SetConsoleCP(1251);
  SetConsoleOutputCP(1251);
//-------------------------------------------------------------
  repeat
    Write('Введите текст для кодировки: ');
    Readln(Text);
    kolsimvolov:=Length(text);
    if kolsimvolov>6*4 then
      writeln('количество символов не должно превышать 24');
  until kolsimvolov<=6*4;
 //-------------------------------------------------------------
  If kolsimvolov<24 then  //если кол-во символов текста не кратно кол-ву символов в блоке дополняем его пробелами
      repeat
        text:=text+' ';
        Inc(kolsimvolov);
      until kolsimvolov=24;
 //------------------------------------------------------------
  Repeat
    Write('Введите ключ1 (6 цифр): ');
    Readln(S);
    for i:=1 to 6 do
     Val(S[i],key1[i],Code);
    p:=true;
    for i:=1 to 5 do
     for j:=i+1 to 6 do
      if (key1[i]=key1[j]) then p:=false;
    If Not(p) then writeln('Все символы должны быть различными!');
  Until  p;
 //-------------------------------------------------------------
  Repeat
    Write('Введите ключ2 (4 цифры): ');
    Readln(S);
    for i:=1 to 4 do
     Val(S[i],key2[i],Code);
    p:=true;
    for i:=1 to 3 do
     for j:=i+1 to 4 do
      if (key2[i]=key2[j]) then p:=false;
     If Not(p) then writeln('Все символы должны быть различными!');
  Until  p;
  Writeln;
 //------------------------------------------------------
 For i:=1 to 6 do
  For j:=1 to 4 do
   Textmatr[key1[i],j]:=Text[(i-1)*4+j];
   Writeln('  k1\k2      1        2        3        4');
 For i:=1 to 6 do
  begin
    Write('    ',i,'    ');
    For j:=1 to 4 do
    write('    ',textmatr[i,j],'    ');
    Writeln;
  end;
 //------------------------------------------------------
 Text_1:='';
 For j:=1 to 4 do
  for i:=1 to 6 do
  begin
    S:=textmatr[i,key2[j]];
    Text_1:=Text_1+S;
  end;
 Writeln('Закодированный текст: ',text_1);
 //-------------------------------------------------------
 Text_2:='';
 For j:=1 to 4 do
  SS[key2[j]]:=Copy(Text_1,(j-1)*6+1,6);
 For j:=1 to 4 do
  Text_2:=Text_2+SS[j];
 //-------------------------------------------------------
 Text_3:='';
 For i:=1 to 6 do
  For j:=1 to 4 do
   begin
     S:=Copy(Text_2,(j-1)*6+key1[i],1);
     Text_3:=Text_3+S;
   end;
 Writeln('Раскодированный текст: ',Text_3);
//-------------------------------------------------------
 Writeln;
 Readln;
End.
 

Вложения

  • CODE_1.webp
    CODE_1.webp
    21.2 KB · Просмотры: 56
Войдите или зарегистрируйтесь для ответа.
Назад
Сверху