0 / 0 / 0
Регистрация: 01.03.2012
Сообщений: 101
1

Написать программу, осуществляющую шифровку текста по алгоритму Фано

14.04.2014, 15:51. Показов 1514. Ответов 10
Метки нет (Все метки)

Написать программу, осуществляющую шифровку текста по алгоритму Фано.
__________________
Помощь в написании контрольных, курсовых и дипломных работ, диссертаций здесь
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
14.04.2014, 15:51
Ответы с готовыми решениями:

написать программу осуществляющую шифрование
1, программу, осуществляющую шифрование и расшифрование текста методом одиночной перестановки и...

Написать процедуру, осуществляющую ввод с клавиатуры текста, состоящего из неповторяющихся латинских букв
Добрый день!:) Проверьте пожалуйста решение задачи. Задание. Обязательным условием является...

Написать программу, осуществляющую заполнение массива элементами последовательности 1,3,5,7,...
Написать программу, осуществляющую заполнение и вывод на экран массива состоящего из 10 элементов...

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

10
1646 / 1075 / 1081
Регистрация: 03.07.2013
Сообщений: 4,507
14.04.2014, 17:03 2
Может Вы приведете здесь сам алгоритм, чтобы не ползать по просторам Инета?

P.S.: А еще можете попробовать поэкспериментировать с размером шрифта - опять получите "адекватный" ответ...
0
0 / 0 / 0
Регистрация: 01.03.2012
Сообщений: 101
14.04.2014, 17:05  [ТС] 3
Не хочешь не помогай!!!!!
0
1646 / 1075 / 1081
Регистрация: 03.07.2013
Сообщений: 4,507
14.04.2014, 17:10 4
Цитата Сообщение от скромница Посмотреть сообщение
Не хочешь не помогай!!!!!
Кардинальный ответ... но просьбу привести здесь алгоритм...
Адекватный ответ: Не хотите помощи - ну и не надо.
0
0 / 0 / 0
Регистрация: 01.03.2012
Сообщений: 101
14.04.2014, 17:12  [ТС] 5
не знаю алгоритма, не моя задача,попросили отправить на форум!Вот добрые дела делаю(помогаю другим)!
0
1646 / 1075 / 1081
Регистрация: 03.07.2013
Сообщений: 4,507
14.04.2014, 17:26 6
Раз уж Вы поленились найти алгоритм, я нашел его за Вас: http://ru.wikipedia.org/wiki/%... 4%E0%ED%EE

Добавлено через 1 минуту
Задача более-менее интересная, понадобится некоторое время...

Добавлено через 56 секунд
Кстати, по условию требуется шифровать... дешифровка не требуется?
0
3174 / 1933 / 312
Регистрация: 27.08.2010
Сообщений: 5,131
Записей в блоге: 1
14.04.2014, 17:31 7
Цитата Сообщение от скромница Посмотреть сообщение
шифровку
Уверены?
0
0 / 0 / 0
Регистрация: 01.03.2012
Сообщений: 101
14.04.2014, 17:45  [ТС] 8
спасибо огромное за алгоритм!Нет,дешифровка не нужна.
0
1646 / 1075 / 1081
Регистрация: 03.07.2013
Сообщений: 4,507
15.04.2014, 12:39 9
Вот, что-то похожее наваял (только я немного схитрил с алгоритмом распределения символов на дереве, но суть осталась почти та же):
Кликните здесь для просмотра всего текста
Pascal
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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
Type
  tM = Record
         Ch  : Char;
         Ss  : Longint;
         Cod : Byte;
       end;
Var
  i,j,N,k : Byte;
  m       : array [0..255] of tM;
  mm      : tM;
  St,Sb   : String;
  f       : Text;
  fb      : File of Byte;
 
Function IntToBin(A : Longint) : String;
Var
  S : String;
  n : Longint;
Begin
  S:=''; n:=A;
  While n>0 do
  Begin
    S:=Chr(Ord('0')+(n mod 2))+S;
    n:=n div 2;
  end;
  IntToBin:=S;
end;
 
Function k2(k : Byte) : Longint; { 2 в сетепени k }
Begin
  If k>0 then k2:=2*k2(k-1)
  else k2:=1;
end;
 
Function BinToInt(S : String) : Byte{Longint};
Begin
  If Length(S)>1 then
    BinToInt:=(Ord(S[1])-Ord('0'))*k2(Length(S)-1)+BinToInt(Copy(S,2,Length(S)-1))
  else
    BinToInt:=Ord(S[1])-Ord('0');
end;
 
Function BitExpand(bi : String; kk : Byte) : String;
Var bitS : String;
Begin
  bitS:=bi;
  While Length(bitS)<kk do bitS:='0'+bitS;
  BitExpand:=bitS;
End;
 
Function SearchCh(SChar : Char) : Byte;
Var nm : Byte;
Begin
  For nm:=0 to 255 do
    If m[nm].Ch=SChar then
    Begin
      SearchCh:=nm;
      Break;
    end;
end;
 
Begin
  { Readln(St);      }
  { или              }
  { St:=ParamStr(1); }
  { или              }
  {}St:='c:\RHDSetup.log';{}
  
  Assign(f,St);
  Assign(fb,'c:\RHDSetup.cod');
  
  For i:=0 to 255 do
  Begin
    m[i].Ch:=Chr(i);
    m[i].Ss:=0;
  End;
  
  Reset(f);
  While Not EOF(f) do
  Begin
    Readln(f,St);
    For i:=1 to Length(st) do Inc(m[Ord(St[i])].Ss);
  End;
  Close(f);
  
  For i:=0 to 254 do
   For j:=i+1 to 255 do
     If m[j].Ss>m[i].Ss then
     Begin
       mm:=m[j];
       m[j]:=m[i];
       m[i]:=mm;
     End;
  For N:=255 downto 0 do If m[n].Ss<>0 then Break;
  
{-temp- Writeln(ln(N)/ln(2)); -}
  k:=Trunc(ln(N)/ln(2));
  If (ln(N)/ln(2))-k>0.000001 then Inc(k);
{-temp- Writeln(k);           -}
  
  For i:=0 to N do m[i].Cod:=i;
  
  Reset(f);
  ReWrite(fb);
  sb:='';
  While not EOF(f) do
  Begin
    Readln(f,St);
    For i:=1 to Length(St) do
    Begin
      sb:=sb+BitExpand(IntToBin(m[SearchCh(St[i])].Cod),k);
      While Length(sb)>=8 do
      Begin
        Write(fb,BinToInt(Copy(sb,1,8)));
        Delete(sb,1,8);
      End;
    end;
  end;
  If Length(sb)>0 then Write(fb,BinToInt(sb));
  Close(fb);
  Close(f);
  
//  Writeln('Chastiy symbol: ',m[0].Ch,' - ',m[0].Ss);
//  For i:=0 to 255 do
//    If m[i].Ss>0 then Writeln(m[i].Ch,' - ',m[i].Ss)
End.
0
0 / 0 / 0
Регистрация: 01.03.2012
Сообщений: 101
15.04.2014, 12:42  [ТС] 10
спасибо огромное.
0
1646 / 1075 / 1081
Регистрация: 03.07.2013
Сообщений: 4,507
15.04.2014, 13:03 11
Немного переделал и на всякий случай добавил дешифровку:
Кликните здесь для просмотра всего текста
Pascal
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
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
Type
  tM = Record
         Ch  : Char;
         Ss  : Longint;
         Cod : Byte;
       end;
Var
  i,j,N,k : Byte;
  m       : array [0..255] of tM;
  mm      : tM;
  St,Sb   : String;
  f       : File of Char;
  fb      : File of Byte;
  CCh     : Char;
 
Function IntToBin(A : Longint) : String;
Var
  S : String;
  n : Longint;
Begin
  S:=''; n:=A;
  While n>0 do
  Begin
    S:=Chr(Ord('0')+(n mod 2))+S;
    n:=n div 2;
  end;
  IntToBin:=S;
end;
 
Function k2(k : Byte) : Longint; { 2 в сетепени k }
Begin
  If k>0 then k2:=2*k2(k-1)
  else k2:=1;
end;
 
Function BinToInt(S : String) : Byte{Longint};
Begin
  If Length(S)>1 then
    BinToInt:=(Ord(S[1])-Ord('0'))*k2(Length(S)-1)+BinToInt(Copy(S,2,Length(S)-1))
  else
    BinToInt:=Ord(S[1])-Ord('0');
end;
 
Function BitExpand(bi : String; kk : Byte) : String;
Var bitS : String;
Begin
  bitS:=bi;
  While Length(bitS)<kk do bitS:='0'+bitS;
  BitExpand:=bitS;
End;
 
Function SearchCh(SChar : Char) : Byte;
Var nm : Byte;
Begin
  For nm:=0 to 255 do
    If m[nm].Ch=SChar then
    Begin
      SearchCh:=nm;
      Break;
    end;
end;
 
Function SearchCod(SCod : Byte) : Byte;
Var nm : Byte;
Begin
  For nm:=0 to 255 do
    If m[nm].Cod=SCod then
    Begin
      SearchCod:=nm;
      Break;
    end;
end;
 
 
Begin
  { Readln(St);      }
  { или              }
  { St:=ParamStr(1); }
  { или              }
  {}St:='c:\RHDSetup.log';{}
  
  Assign(f,St);
  Assign(fb,'c:\RHDSetup.cod');
  
  For i:=0 to 255 do
  Begin
    m[i].Ch:=Chr(i);
    m[i].Ss:=0;
  End;
  
  Reset(f);
  While Not EOF(f) do
  Begin
    Read(f,CCh);
    Inc(m[Ord(CCh)].Ss);
  End;
  Close(f);
  
  For i:=0 to 254 do
   For j:=i+1 to 255 do
     If m[j].Ss>m[i].Ss then
     Begin
       mm:=m[j];
       m[j]:=m[i];
       m[i]:=mm;
     End;
  For N:=255 downto 0 do If m[n].Ss<>0 then Break;
  
{-temp- Writeln(ln(N)/ln(2)); -}
  k:=Trunc(ln(N)/ln(2));
  If (ln(N)/ln(2))-k>0.000001 then Inc(k);
{-temp- Writeln(k);           -}
  
  For i:=0 to N do m[i].Cod:=i;
  
  Reset(f);
  ReWrite(fb);
  sb:='';
  While not EOF(f) do
  Begin
    Read(f,CCh);
 
      sb:=sb+BitExpand(IntToBin(m[SearchCh(CCh)].Cod),k);
      While Length(sb)>=8 do
      Begin
        Write(fb,BinToInt(Copy(sb,1,8)));
        Delete(sb,1,8);
      end;
 
  end;
  If Length(sb)>0 then Write(fb,BinToInt(sb));
  Close(fb);
  Close(f);
  
  {--== DECODE ==--}
  Assign(f,'c:\RHDSetup.txt');
  ReWrite(f);
  Reset(fb);
  sb:='';
  While not EOF(fb) do
  Begin
    Read(fb,j);
    sb:=sb+BitExpand(IntToBin(j),8);
    While Length(sb)>=k do
      Begin
        Write(f,m[SearchCod(BinToInt(Copy(sb,1,k)))].Ch);
        Delete(sb,1,k);
      End;
      
  end;
  If Length(sb)>0 then Write(f,m[SearchCod(BinToInt(Copy(sb,1,k)))].Ch);
  Close(fb);
  Close(f);
  
  
//  Writeln('Chastiy symbol: ',m[0].Ch,' - ',m[0].Ss);
//  For i:=0 to 255 do
//    If m[i].Ss>0 then Writeln(m[i].Ch,' - ',m[i].Ss)
End.
1
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
15.04.2014, 13:03
Помогаю со студенческими работами здесь

Написать программу, осуществляющую сортировку файла по номеру телефона, по фамилии
Дан файл об абонентах телефонной станции: фамилия, имя, отчество, № телефона, содержащий номер АТС...

Построить разделимую префиксную схему алфавитного кодирования по алгоритму Фано
для заданных распределений вероятностей появления букв построить разделимую префиксную схему...

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

Написать программу, осуществляющую вычисление среднего балла каждого студента за все обучение
Условие: База данных студентов содержит ФИО и средние баллы за 5 сессий. Написать программу,...

Написать программу по алгоритму
напишите пожалуйста программу в вба по алгоритму: срочно! Public Sub SumColumn() Type Money...

Написать программу на С по алгоритму


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
11
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin
Copyright ©2000 - 2023, CyberForum.ru