Декодирование сообщения Опции

[Нике]

Пожалуйста, пожалуйста, помогите с решением...очень нужно, очень срочно..

Дан следующий алфавит и соответствующие буквам коды: пробел=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.
Так сообщение обладает меньшей избыточностью, но как в таком случае распознавать пробелы непонятно...

Блин, да мне хоть в каком виде....

Сообщение отредактировано: Нике - 15.11.2006 16:00

[Lapp]

Не совсем ясно. Коды разной длины.. ?
Ты ничего не путаешь? уточни условие.

Извиняюсь, кажется разобрался..

Сообщение отредактировано: lapp - 16.11.2006 14:32

[Lapp]

Извиняюсь, кажется разобрался..

Да, второе условие (в отличие от первого) действительно корректно и дает возможность все распознать и расшифровать.
Я немного попыхтел, делая прогу, но все получилось. Если еще есть интерес, можно обсудить.

[Нике]

Интерес? Конечно есть!! Мне в понедельник нужно всё это дело сдавать..

[Malice]

Я не понял суть проблемы Учитывая, что у тебя коды могут начинаться одинаково, нужно начинать сравнивать с самых длинных кодов..

[Lapp]

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

Ладно, ближе к делу.
Алгоритм примерно такой (грубо) :
- просматриваю код слева направо
- любой символ начинается с 1
- окончание символа по двум нулям отследить нельзя, так как некоторые символы оканчиваются на 3 и даже на 4 нуля.
- хорошо, правда, то, что символы различимы. Если бы восьмерка кодировалась 100000 (что, в общем-то, логично), комбинация а1 с пробелом была бы от нее неотличима.
- идем слева направа, пока не наткнемся на по крайней мере 2 нуля и с этого момента..
- .. начинаем считать вводимые нули до новой единицы.
- когда встречена единица или конец файла, отбрасываем накопленные нули тройками, считая пробелы.
- когда нулей остается не больше четырех, пытаемся распознать символ.
- если это удается, записываем в выходной файл символ и все посчитанные пробелы за ним.
- если нет - выводим сообщение об ошибке в исходном коде.

Усе, шеф, дело сделано, шеф.. ©

Твои соображения, Нике?.. И ваши, уважаемые коллеги..
Код выложу в следующем мессадже.

[klem4]

Вот это кто-нибудь объяснить может:

00 - признак конца символа

а5=100100

Выходит a5 = a1a1 ? Тогда различить это невозможно.

[volvo]

klem4, a5 = 10100, а не 100100...



Все ясно, я на первый вариант посмотрел (неверный который) ...klem4.

[Lapp]

Выходит 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]

Уфффф я вот тут тоже насочинял))))))))

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-ов сделать.

[Нике]

lapp, klem4, спасибо вам огромное!!
Мне сложно что-либо прокомментировать, т.к. пытаюсь разобраться в том, что вы написали - и это у меня тоже вызывает затруднение =(
А блок-схема получится огромная..

[Lapp]

А блок-схема получится огромная..

Согласен, немалая..
Я потом подумал, что мой способ не самый хороший - кажется, придумал попроще. Может, Klem4 так и сделал - посмотрю попозже..

[Нике]

Разобралась в программе, написанной klem4.
Правда функция Crypt в принципе не нужна. т.к. по условию не требуется кодирование сообщения.
А блок-схема получилась ого-го какая.
Еще раз всем спасибо за помощь! Что бы я без вас делала =)

Сообщение отредактировано: Нике - 19.11.2006 18:34

[klem4]

Правда функция Crypt в принципе не нужна. т.к. по условию не требуется кодирование сообщения.

Это я для удобства сделал чтобы не придумывать тесты

[FreeMan]

Чтото типа этого должно сработать. провереть не могу

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;

Сообщение отредактировано: FreeMan - 20.11.2006 10:30

[Lapp]

Чтото типа этого должно сработать. провереть не могу

Почему не можешь?.. Нет данных? Лови:
строка
100100011000001000010100000110000001000100000000001110011000101000
должна декодироваться в
a1a2a3 a4a5 a6 a2a4 a7a6a5 a8

[klem4]

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;