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
| program Kod_Fano;
const nmax=100;
type
Mn = set of char;
Zap = record
sim: char;
kol: byte;
v: real;
kod: string;
end;
mas = array [0..nmax] of zap;
var
f: text;
k, i: byte;
a: string
l: mas;
procedure Tekst(f: text; var a: string);
var s:string;
begin
assign(f, 'input.txt');
reset(f);
s:='';
while not eof(f) do
begin
readln(f, s);
a:=a+s;
end;
end;
procedure Simvol(a: string; var k: byte; var l: mas);
var
i, j: integer;
m: mn;
begin
k := 0;
m:=[];
for i := 1 to length(a) do
if (a[i] in m) then
begin
j := 1;
while l[j].sim <> a[i] do inc(j);
inc(l[j].kol);
end
else
begin
m := m + [a[i]];
inc(k);
l[k].sim := a[i];
l[k].kol := 1;
end;
end;
procedure Ver(k: integer; var l: mas);
var
i: integer;
begin
for i := 1 to k do l[i].v := l[i].kol / length(a);
end;
procedure Poryadok(var l: mas);
var
i, j: integer;
x: zap;
begin
for i := 1 to k - 1 do
for j := 1 to k - i do
if l[j].v > l[j+1].v then
begin
x := l[j];
l[j] := l[j+1];
l[j+1] := x;
end;
end;
function seredina(n, k: byte; s:real): byte;
var
i: byte;s1, s2: real;
begin
s1 := 0;
i := n-1;
while s1<(s / 2) do begin inc(i); s1 := s1 + l[i].v; end;
s2 := s-s1;
s1 := s1 - l[i].v; dec(i);
If s1>s2 then seredina := i else seredina := i+1;
end;
procedure fano(n, k: integer; s: real);
var
i, m: integer;
s1, s2: real;
begin
if k - n >= 1 then
if k - n = 1 then
begin
// к коду n-ой буквы алфавита приписать 0
//к коду k-ой буквы алфавита приписать 1
end
else
begin
m := seredina(n, k,s);
s1:=0;
// к кодам всех букв алфавита с n-ой по m-ую приписать 0
// в переменной s1 найти сумму вероятностей всех букв алфавита с n-ой по m-ую
s2:=0;
// к элементарным кодам всех букв алфавита с (m+1)-ой по k-ую приписать 1
// в переменной s2 найти сумму вероятностей всех букв алфавита с (m+1)-ой по k-ую
fano(n, m, s1);
fano(m + 1, k, s2);
end;
end;
begin
Tekst(f, a);
writeln(a);
Simvol(a, k, l);
Ver(k, l);
Poryadok(l);
for i := 1 to k do Write(l[i].sim:6); writeln;
for i := 1 to k do Write(l[i].kol:6); writeln;
for i := 1 to k do Write(l[i].v:6:3); writeln;
for i := 1 to k do l[i].kod := '';
fano(1, k, 1);
for i := 1 to k do Write(l[i].kod:6); writeln;
end. |
(
