Форум программистов
 
О проблемах, например, с регистрацией пишите сюда - alarforum@yandex.ru, проверяйте папку спам! Обязательно пройдите активизацию e-mail, а тут можно восстановить пароль.

Вернуться   Форум программистов > Delphi > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Здесь нужно купить рекламу за 20 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru
Без учёта ботов - 20000 человек в день, 350000 в месяц.

Ответ
 
Опции темы
Старый 11.10.2008, 09:52   #1
Ketu
Пользователь
 
Регистрация: 15.03.2008
Сообщений: 20
По умолчанию Архивация методом Шеннона-Фано

У кого-нибудь есть такой исходник? Поделитесь, пожалуйста.
Ketu вне форума Ответить с цитированием
Старый 11.10.2008, 18:39   #2
Ketu
Пользователь
 
Регистрация: 15.03.2008
Сообщений: 20
По умолчанию

Пробовала решить:
Код:
uses crt;
var
   c:char;
   s,s1,s2:string;
   i,n,j,j1:byte;
   a:array [1..255] of byte;
   str:array [1..255] of string[9];
   st:array [1..255] of string[100];
   f,f1,f2:text;
begin clrscr;
assign(f,'Cod.txt');assign(f1,'Bukv.txt');assign(f2,'1&0.txt');
rewrite(f);rewrite(f1);rewrite(f2);
writeln('Введите строку');readln(s);
s2:=s;
while length(s) <> 0 do
begin
s1:=s1+s[1];
 for i:=1 to length(s) do
  if (s1[length(s1)] = s[i])and(pos(s1[length(s1)],s) <> 0) then
  begin
  inc(n);delete(s,pos(s1[length(s1)],s),1);dec(i);
  end;
a[length(s1)]:=n;n:=0;
end;
 for j:=1 to 10 do
  for i:=1 to length(s1) do
  begin
   if (a[i] > a[i-1])and(i<>1) then
   begin
   n:=a[i];a[i]:=a[i-1];a[i-1]:=n;
   c:=s1[i];s1[i]:=s1[i-1];s1[i-1]:=c;
   end;
    if (a[i] < a[i+1])and(i<>0) then
    begin
    n:=a[i];a[i]:=a[i+1];a[i+1]:=n;
    c:=s1[i];s1[i]:=s1[i+1];s1[i+1]:=c;
    end;
   end;
    for i:=1 to length(s1) do
    st[i]:=s1[i];
   i:=length(s1);
    while length(s1) <> length(st[1]) do
    begin
     for n:=1 to length(st[i]) do
     begin
     j:=pos(st[i][n],s1);
      if a[i] > a[i-1] then str[j]:='1'+str[j]
      else str[j]:='0'+str[j];
     end;
      for n:=1 to length(st[i-1]) do
      begin
      j:=pos(st[i-1][n],s1);
       if a[i] > a[i-1] then str[j]:='0'+str[j]
        else str[j]:='1'+str[j];
      end;
     a[i-1]:=a[i]+a[i-1];a[i]:=0;
     st[i-1]:=st[i-1]+st[i];st[i]:='';dec(i);
  for j1:=i downto 1 do
  begin
   if (a[j1] > a[j1-1])and((j1-1) <> 0) then
   begin
   n:=a[j1];a[j1]:=a[j1-1];a[j1-1]:=n;
   s:=st[j1];st[j1]:=st[j1-1];st[j1-1]:=s;
   end;
  end;
    end;
 for i:=1 to length(s2) do
 begin
 write(f2,str[pos(s2[i],s1)],' ');
 write(str[pos(s2[i],s1)],' ');
 end;
  for i:=1 to length(s1) do
  begin
  write(f1,s1[i],' ');
  write(f,str[i],' ');
  end;
close(f);close(f1);close(f2);
end.
Но заархивированный файл весит больше, чем архивируемый из-за того, что информация предствалена в байтовом виде, а не в битовом. Как сделать битовое представления я не знаю. К тому же заархивированный файл должен разархивирываться обратно.

Последний раз редактировалось Alex21; 12.10.2008 в 21:32.
Ketu вне форума Ответить с цитированием
Старый 13.10.2008, 18:42   #3
Ketu
Пользователь
 
Регистрация: 15.03.2008
Сообщений: 20
По умолчанию

Никто помочь не может?
Ketu вне форума Ответить с цитированием
Ответ

Здесь нужно купить рекламу за 20 тыс руб в месяц! ) пишите сюда - alarforum@yandex.ru
Без учёта ботов - 20000 человек в день, 350000 в месяц.

Опции темы


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Архивация БД ADO Alexsandr БД в Delphi 1 07.04.2008 17:42
Архивация БД dron-s БД в Delphi 0 10.03.2008 12:08
Архивация в программе FaTaL Общие вопросы Delphi 13 04.03.2008 19:37
Архивация Mitron Общие вопросы Delphi 10 14.02.2008 16:00


Проекты отопления, пеллетные котлы, бойлеры, радиаторы
интернет магазин respective.ru
Пеллетный котёл Emtas
котлы EMTAS