Версия для печати темы
Нажмите сюда для просмотра этой темы в обычном формате
Форум «Всё о Паскале» _ Задачи _ Декодирование сообщения
Автор: Нике 15.11.2006 19:59
Пожалуйста, пожалуйста, помогите с решением...очень нужно, очень срочно..
Дан следующий алфавит и соответствующие буквам коды: пробел=000, а1=100, а2=1100, а3=10100, а4=11100,
а5=100100, а6=110100, а7=101100,а8=111100.
Нужно написать программу и блок-схему, декодирующую сообщение, т.е. мы вводим код - программа выдает буквы.
00 - признак конца символа
00000 - пробел.
Вообще, нужно декодировать сообщение со следующими кодами, но мне кажется, это несколько усложняет задачу??
пробел=000, а1=100, а2=1000, а3=1100, а4=10000, а5=10100, а6=11000, а7=11100, а8=101000.
Так сообщение обладает меньшей избыточностью, но как в таком случае распознавать пробелы непонятно...
Блин, да мне хоть в каком виде....
Автор: lapp 16.11.2006 18:31
Не совсем ясно. Коды разной длины.. ?
Ты ничего не путаешь? уточни условие.
Извиняюсь, кажется разобрался..
Автор: lapp 17.11.2006 12:05
Извиняюсь, кажется разобрался..
Да, второе условие (в отличие от первого) действительно корректно и дает возможность все распознать и расшифровать.
Я немного попыхтел, делая прогу, но все получилось. Если еще есть интерес, можно обсудить.
Автор: Нике 17.11.2006 16:17
Интерес? Конечно есть!! Мне в понедельник нужно всё это дело сдавать..
Автор: Malice 17.11.2006 16:57
Я не понял суть проблемы 
Учитывая, что у тебя коды могут начинаться одинаково, нужно начинать сравнивать с самых длинных кодов..
Автор: lapp 17.11.2006 18:28
Задача, конечно, странная.. Хотел бы я посмотреть на того человека, который решил бы на деле применять такое кодирование . Надеюсь, что ты, Нике, ничего не напутала, а то получится, что все навороты из-за тривиальной ошибкт в условии, и все мои глубокие изыскания - коту под хвост..
Ладно, ближе к делу.
Алгоритм примерно такой (грубо) :
- просматриваю код слева направо
- любой символ начинается с 1
- окончание символа по двум нулям отследить нельзя, так как некоторые символы оканчиваются на 3 и даже на 4 нуля.
- хорошо, правда, то, что символы различимы. Если бы восьмерка кодировалась 100000 (что, в общем-то, логично), комбинация а1 с пробелом была бы от нее неотличима.
- идем слева направа, пока не наткнемся на по крайней мере 2 нуля и с этого момента..
- .. начинаем считать вводимые нули до новой единицы.
- когда встречена единица или конец файла, отбрасываем накопленные нули тройками, считая пробелы.
- когда нулей остается не больше четырех, пытаемся распознать символ.
- если это удается, записываем в выходной файл символ и все посчитанные пробелы за ним.
- если нет - выводим сообщение об ошибке в исходном коде.
Усе, шеф, дело сделано, шеф.. ©
Твои соображения, Нике?.. И ваши, уважаемые коллеги..
Код выложу в следующем мессадже.
Автор: klem4 17.11.2006 18:38
Вот это кто-нибудь объяснить может:
Выходит a5 = a1a1 ? Тогда различить это невозможно.
Автор: volvo 17.11.2006 18:53
klem4, a5 = 10100, а не 100100...
Все ясно, я на первый вариант посмотрел (неверный который) ...klem4.
Автор: lapp 17.11.2006 19:11
Выходит a5 = a1a1 ? Тогда различить это невозможно.
Итак, вот мой код. Только что сообразил, что он, скорее всего не сможет справиться с закодированным текстом, начинающемся с пробела (то есть 000). С остальными вроде работает.. Тестировалось в FPC при включенной совсместимости с TP.
Программа читает входной поток из файла nike.dat (ниже нсть пример его содержимого и прога, генерящая такие файлы).
{ for Nike }
{ Just another weird decoder }
const
N=8; { number of characters }
Abc:array[1..N]of byte=(1,2,3,4,5,6,7,10); { alphabet }
function Symb(x:byte):integer; { get a symbol by nomber }
var
i:integer;
begin
i:=1;
while (i<=N)and(Abc[i]<>x) do Inc(i);
Symb:=i
end;
function Legal(x:byte):boolean; { check if a combination is a symbol }
var
i:integer;
begin
i:=1;
while (i<=N)and(Abc[i]<>x) do Inc(i);
Legal:=i<=N
end;
var
F:file of byte;
i,z,p,Sp:integer;
x,b:byte;
Ok,done:boolean;
Tx:string;
begin
Assign(f,'nike.dat'); { input file }
Reset(F);
z:=0; { zeros counter }
x:=0; { a binary combination read from file }
p:=0; { input character counter }
Tx:=''; { output text }
Ok:=true; { error (reversed) }
while Ok and not EoF(F) do begin
Read(F,b); { read a symbol }
Inc(p); { increase input counter }
Sp:=0; { spaces counter }
repeat
done:=true; { if not Done, then repeat }
case b-48 of { b-48 is 0 or 1 }
0: begin
Inc(z);
if EoF(F) then begin
Done:=false;
b:=49
end
end;
1: case z of
0,1: begin
x:=x shl (z+1) +1;
z:=0
end;
2: if Legal(x) then begin
Tx:=Tx+Chr(Symb(x)+48);
for i:=1 to Sp do Tx:=Tx+' ';
x:=1;
z:=0
end
else Ok:=false;
3,4: begin
x:=x shl 1;
Dec(z);
done:=false
end;
else begin
Inc(Sp);
Dec(z,3);
done:=false
end
end
end
until done
end;
if Ok then WriteLn(Tx)
else WriteLn('Input error at pos ',p);
ReadLn
end.
Вот пример файла nike.dat :
10010001100000100001010000011000000100010000000000111001100010100000101000000000
0001000
- если строчка в браузере разделилась на две, слепи их в одну. В нем не должно быть никаких лишних символов типа переводов строки в конце..
А это прога, которая генерит входные файлы по строке, задаваемой константой s :
const
s='123 45 6 24 765 8 2';
const
N=8;
Font:array[1..N]of String=
('1','10','11','100','101','110','111','1010');
var
i:integer;
F:text;
t:char;
begin
Assign(F,'Nike.dat');
ReWrite(F);
for i:=1 to Length(s) do begin
t:=s[i];
if t=' ' then Write(F,'000') else Write(F,Font[Ord(t)-48],'00');
end;
Close(F)
end.
Вот, пожалуй, и все пока.
Вопросы?..
Автор: klem4 17.11.2006 20:44
Уфффф я вот тут тоже насочинял))))))))
uses crt;
function Crypt(const s: String): String;
var
i: Integer;
X, result: String;
begin
i := 1;
result := '';
while (i <= Length(s) - 1) do begin
if s[i] = ' ' then begin
X := ' ';
inc(i);
end else begin
X := Copy(s, i, 2);
inc(i, 2);
end;
if X = ' ' then result := result + '000'
else
if X = 'a1' then result := result + '100'
else
if X = 'a2' then result := result + '1000'
else
if X = 'a3' then result := result + '1100'
else
if X = 'a4' then result := result + '10000'
else
if X = 'a5' then result := result + '10100'
else
if X = 'a6' then result := result + '11000'
else
if X = 'a7' then result := result + '11100'
else
if X = 'a8' then result := result + '101000';
end;
Crypt := result;
end;
function Decrypt(const s: String): String;
var
X, result: String;
T, i: integer;
begin
result := '';
i := 1;
while (i <= Length(s)) do begin
X := Copy(s, i, 3);
if X = '000' then begin result := result + ' '; inc(i, 3); end else begin
if X = '100' then begin
T := Pos('1', Copy(s, i + 1, 255)); // кол-во пробелов до бл единицы
if T = 0 then
T := Length(s) - i
else
T := T - 1;
T := T - 3 * (T div 3);
case T of
2: begin
result := result + 'a1';
inc(i, 3);
end;
0: begin
result := result + 'a2';
inc(i, 4);
end;
1: begin
result := result + 'a4';
inc(i, 5);
end;
end;
end
else
if X = '110' then begin
T := Pos('1', Copy(s, i + 2, 255));
if T = 0 then
T := Length(s) - i - 1
else
T := T - 1;
T := T - 3 * (T div 3);
case T of
2: begin
result := result + 'a3';
inc(i, 4);
end;
0: begin
result := result + 'a6';
inc(i, 5);
end;
end;
end
else
if X = '101' then begin
T := Pos('1', Copy(s, i + 3, 255));
if T = 0 then
T := Length(s) - i - 2
else
T := T - 1;
T := T - 3 * (T div 3);
case T of
2: begin
result := result + 'a5';
inc(i, 5);
end;
0: begin
result := result + 'a8';
inc(i, 6);
end;
end;
end
else begin
result := result + 'a7';
inc(i, 5);
end;
end;
end;
Decrypt := result;
end;
begin
clrscr;
writeln(Decrypt(Crypt('a6a2a7a3 a8a5a5a8 a8a1a2 a4a6a1')));
readln;
end.
Много похожих частей кода, так что думаю можно сократить будет. Ну и в Crypt можно 2 массива вместо if-ов сделать.
Автор: Нике 18.11.2006 21:34
lapp, klem4, спасибо вам огромное!!
Мне сложно что-либо прокомментировать, т.к. пытаюсь разобраться в том, что вы написали - и это у меня тоже вызывает затруднение =(
А блок-схема получится огромная..
Автор: lapp 19.11.2006 18:06
Согласен, немалая..
Я потом подумал, что мой способ не самый хороший - кажется, придумал попроще. Может, Klem4 так и сделал - посмотрю попозже..
Автор: Нике 19.11.2006 22:33
Разобралась в программе, написанной klem4.
Правда функция Crypt в принципе не нужна. т.к. по условию не требуется кодирование сообщения.
А блок-схема получилась ого-го какая.
Еще раз всем спасибо за помощь! Что бы я без вас делала =)
Автор: klem4 19.11.2006 23:04
Это я для удобства сделал чтобы не придумывать тесты
Автор: FreeMan 20.11.2006 14:29
Чтото типа этого должно сработать. провереть не могу
procedure decr(s:string):string;
var
x:string;
i,w,f:word;
begin
w:=0;
f:=4096;
for i:=1 to lenght(s) do begin
if (s[i]=0) and (f<>4096) then
inc(w);
if (s[i]=1) then w:=0;
f:=(f shl 1)+ord(s[i])-3*16;
if w=2 then begin
w:=0;
f:=f shr 2;
x:=x+'a'+chr(f+16*3);
f:=4096;
end;
end;
decr:=x;
end;
Автор: lapp 20.11.2006 15:54
Чтото типа этого должно сработать. провереть не могу
Почему не можешь?.. Нет данных? Лови:
строка
100100011000001000010100000110000001000100000000001110011000101000
должна декодироваться в
a1a2a3 a4a5 a6 a2a4 a7a6a5 a8
Автор: klem4 20.11.2006 16:03
FreeMan, не правильно твоя процедура работает ... вот ее компилирующийся вариант
function decr(s:string):string;
var
x:string;
i,w,f:word;
begin
w:=0;
f:=4096;
for i:=1 to length(s) do begin
if (s[i]='0') and (f<>4096) then
inc(w);
if (s[i]='1') then w:=0;
f:=(f shl 1)+ord(s[i])-3*16;
if w=2 then begin
w:=0;
f:=f shr 2;
x:=x+'a'+chr(f+16*3);
f:=4096;
end;
end;
decr:=x;
end;