initial
This commit is contained in:
commit
9eb3aa151d
|
|
@ -0,0 +1,426 @@
|
||||||
|
program codage;
|
||||||
|
|
||||||
|
uses crt,dos,math;
|
||||||
|
|
||||||
|
type
|
||||||
|
anagramme=^cellule1;
|
||||||
|
cellule1=record
|
||||||
|
octet:byte;
|
||||||
|
prec:anagramme;
|
||||||
|
suiv:anagramme;
|
||||||
|
end;
|
||||||
|
decalage=array of anagramme;
|
||||||
|
catalogue=array[0..255] of byte;
|
||||||
|
fichier=array of byte;
|
||||||
|
bit=0..1;
|
||||||
|
liste=^cellule2;
|
||||||
|
cellule2=record
|
||||||
|
octet:byte;
|
||||||
|
freq:longword;
|
||||||
|
suiv:liste;
|
||||||
|
gauche:liste;
|
||||||
|
droite:liste;
|
||||||
|
end;
|
||||||
|
tableau=array[0..255] of liste;
|
||||||
|
sauvegarde=array of liste;
|
||||||
|
final=array[0..255] of array of bit;
|
||||||
|
|
||||||
|
var f:fichier;a:anagramme;d:decalage;taille,p:longword;l:liste;fin:final;longueur:byte;s:sauvegarde;chemin:string;
|
||||||
|
|
||||||
|
procedure importer(var p:anagramme; var taille:longword; var chemin:string);
|
||||||
|
var f:file;p1:anagramme;
|
||||||
|
begin
|
||||||
|
write('Chemin du fichier : ');
|
||||||
|
readln(chemin);
|
||||||
|
if chemin[length(chemin)]=' ' then delete(chemin,length(chemin),1);
|
||||||
|
assign(f,chemin);
|
||||||
|
reset(f,1);
|
||||||
|
new(p);
|
||||||
|
p1:=p;
|
||||||
|
writeln('Importation...');
|
||||||
|
while not eof(f) do
|
||||||
|
begin
|
||||||
|
new(p1^.suiv);
|
||||||
|
p1^.suiv^.prec:=p1;
|
||||||
|
p1:=p1^.suiv;
|
||||||
|
blockread(f,p1^.octet,1);
|
||||||
|
end;
|
||||||
|
taille:=filesize(f);
|
||||||
|
close(f);
|
||||||
|
p:=p^.suiv;
|
||||||
|
p1^.suiv:=p;
|
||||||
|
p^.prec:=p1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function EstSuperieur(p1,p2:anagramme;longueur:longword):boolean;
|
||||||
|
var pa,pb:anagramme;i:longword;
|
||||||
|
begin
|
||||||
|
i:=1;
|
||||||
|
pa:=p1;
|
||||||
|
pb:=p2;
|
||||||
|
while ((i<=longueur) and (pa^.octet=pb^.octet)) do
|
||||||
|
begin
|
||||||
|
pa:=pa^.suiv;
|
||||||
|
pb:=pb^.suiv;
|
||||||
|
i:=i+1;
|
||||||
|
end;
|
||||||
|
if pa^.octet>pb^.octet then EstSuperieur:=true else EstSuperieur:=false;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function inserer(p:anagramme;t:decalage;debut,fin,taille:longword):longword;
|
||||||
|
var milieu:longword;
|
||||||
|
begin
|
||||||
|
if fin-debut=0 then inserer:=debut
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
milieu:=(debut+fin) div 2;
|
||||||
|
if EstSuperieur(t[milieu],p,taille) then
|
||||||
|
inserer:=inserer(p,t,debut,milieu,taille)
|
||||||
|
else
|
||||||
|
inserer:=inserer(p,t,milieu+1,fin,taille);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure reindex(var t:decalage;p:anagramme;i,taille:longword; var position:longword);
|
||||||
|
var j,k:longword;
|
||||||
|
begin
|
||||||
|
j:=inserer(p,t,0,i,taille);
|
||||||
|
setlength(t,i+1);
|
||||||
|
if j<=position then position:=position+1;
|
||||||
|
for k:=i downto j do t[k+1]:=t[k];
|
||||||
|
t[j]:=p;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure tabler(var t:decalage; var p:anagramme;taille:longword; var position:longword);
|
||||||
|
var i:longword;x:byte;
|
||||||
|
begin
|
||||||
|
x:=1;
|
||||||
|
setlength(t,1);
|
||||||
|
t[0]:=p;
|
||||||
|
position:=0;
|
||||||
|
for i:=1 to taille-1 do
|
||||||
|
begin
|
||||||
|
p:=p^.suiv;
|
||||||
|
reindex(t,p,i,taille,position);
|
||||||
|
if ((i+1)*100) div taille >= x then
|
||||||
|
begin
|
||||||
|
writeln(x,'% des décalages indexés');
|
||||||
|
x:=x+1;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure prefixe(n:longword; var p:anagramme; var i:integer);
|
||||||
|
var p1:anagramme;
|
||||||
|
begin
|
||||||
|
i:=0;
|
||||||
|
new(p);
|
||||||
|
p1:=p;
|
||||||
|
repeat
|
||||||
|
begin
|
||||||
|
i:=i+1;
|
||||||
|
new(p1^.suiv);
|
||||||
|
p1^.suiv^.prec:=p1;
|
||||||
|
p1:=p1^.suiv;
|
||||||
|
p1^.octet:=((n-(trunc(power(2,7*i))*(n div trunc(power(2,7*i))))) div trunc(power(2,7*(i-1))))*2+1;
|
||||||
|
end;
|
||||||
|
until n div trunc(power(2,7*i))=0;
|
||||||
|
p:=p^.suiv;
|
||||||
|
p1^.suiv:=p;
|
||||||
|
p^.prec:=p1;
|
||||||
|
p^.octet:=p^.octet-1;
|
||||||
|
p:=p^.prec;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure dernier(var d:decalage);
|
||||||
|
var i:longword;
|
||||||
|
begin
|
||||||
|
for i:=0 to length(d)-1 do d[i]:=d[i]^.prec;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure transformer(n:longword;d:decalage;taille:longword;var f:fichier);
|
||||||
|
var i:longword;j:integer;p:anagramme;
|
||||||
|
begin
|
||||||
|
setlength(f,0);
|
||||||
|
prefixe(n,p,j);
|
||||||
|
writeln('Position du motif original fixée à ',n,', codée sur ',j,' octet(s)');
|
||||||
|
(*Écriture du préfixe...*)
|
||||||
|
setlength(f,j+taille);
|
||||||
|
for i:=0 to j-1 do
|
||||||
|
begin
|
||||||
|
f[i]:=p^.octet;
|
||||||
|
p:=p^.prec;
|
||||||
|
end;
|
||||||
|
writeln('Écriture de la séquence codée...');
|
||||||
|
dernier(d);
|
||||||
|
for i:=0 to taille-1 do
|
||||||
|
begin
|
||||||
|
f[i+j]:=d[i]^.octet;
|
||||||
|
dispose(d[i]);
|
||||||
|
end;
|
||||||
|
setlength(d,0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure coder(var p:fichier;taille:longword);
|
||||||
|
var ref,car:catalogue;i:longword;j,k,l:byte;f:fichier;
|
||||||
|
begin
|
||||||
|
setlength(f,taille);
|
||||||
|
for i:=0 to 255 do ref[i]:=i;
|
||||||
|
car:=ref;
|
||||||
|
for i:=0 to taille-1 do
|
||||||
|
begin
|
||||||
|
j:=p[i];
|
||||||
|
f[i]:=ref[j];
|
||||||
|
l:=car[ref[j]];
|
||||||
|
for k:=ref[j] downto 1 do
|
||||||
|
begin
|
||||||
|
car[k]:=car[k-1];
|
||||||
|
ref[car[k]]:=k;
|
||||||
|
end;
|
||||||
|
car[0]:=l;
|
||||||
|
ref[l]:=0;
|
||||||
|
end;
|
||||||
|
p:=f;
|
||||||
|
setlength(f,0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
procedure trier(var l:liste);
|
||||||
|
var l1,l2:liste;
|
||||||
|
begin
|
||||||
|
l1:=l;
|
||||||
|
if l<>nil then
|
||||||
|
begin
|
||||||
|
while l1^.suiv<>nil do
|
||||||
|
begin
|
||||||
|
if l1^.suiv^.freq<l^.freq then
|
||||||
|
begin
|
||||||
|
l2:=l1^.suiv;
|
||||||
|
l1^.suiv:=l2^.suiv;
|
||||||
|
l2^.suiv:=l;
|
||||||
|
l:=l2;
|
||||||
|
l1:=l;
|
||||||
|
end;
|
||||||
|
l1:=l1^.suiv;
|
||||||
|
end;
|
||||||
|
trier(l^.suiv);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function inserer2(var l:liste; var l1:liste):liste;
|
||||||
|
begin
|
||||||
|
if l=nil then
|
||||||
|
begin
|
||||||
|
l1^.suiv:=nil;
|
||||||
|
inserer2:=l1;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if l1^.freq<=l^.freq then
|
||||||
|
begin
|
||||||
|
l1^.suiv:=l;
|
||||||
|
inserer2:=l1;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
l^.suiv:=inserer2(l^.suiv,l1);
|
||||||
|
inserer2:=l;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure branche(var l:liste;b:bit;var fin:final);
|
||||||
|
var aux:array of bit;
|
||||||
|
begin
|
||||||
|
if ((l^.gauche=nil) and (l^.droite=nil)) then
|
||||||
|
begin
|
||||||
|
aux:=fin[l^.octet];
|
||||||
|
setlength(aux,length(aux)+1);
|
||||||
|
aux[length(aux)-1]:=b;
|
||||||
|
fin[l^.octet]:=aux;
|
||||||
|
setlength(aux,0);
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
branche(l^.gauche,b,fin);
|
||||||
|
branche(l^.droite,b,fin);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure arbre(var l:liste;var fin:final);
|
||||||
|
var l1:liste;
|
||||||
|
begin
|
||||||
|
if l^.suiv<>nil then
|
||||||
|
begin
|
||||||
|
new(l1);
|
||||||
|
l1^.gauche:=l;
|
||||||
|
l1^.droite:=l^.suiv;
|
||||||
|
l1^.freq:=l^.freq+l^.suiv^.freq;
|
||||||
|
branche(l1^.gauche,0,fin);
|
||||||
|
branche(l1^.droite,1,fin);
|
||||||
|
l:=inserer2(l^.suiv^.suiv,l1);
|
||||||
|
arbre(l,fin);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure nombrelong(n:longword; var nombre:fichier);
|
||||||
|
var i:longword;
|
||||||
|
begin
|
||||||
|
i:=1;
|
||||||
|
setlength(nombre,0);
|
||||||
|
repeat
|
||||||
|
begin
|
||||||
|
setlength(nombre,i);
|
||||||
|
nombre[i-1]:=((n-(trunc(power(2,7*i))*(n div trunc(power(2,7*i))))) div trunc(power(2,7*(i-1))))*2+1;
|
||||||
|
i:=i+1;
|
||||||
|
end;
|
||||||
|
until n div trunc(power(2,7*(i-1)))=0;
|
||||||
|
nombre[0]:=nombre[0]-1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function nouv_chemin(chemin:string):string;
|
||||||
|
var i:byte;s:string;
|
||||||
|
begin
|
||||||
|
s:=chemin;
|
||||||
|
i:=length(chemin);
|
||||||
|
while s[i]<>'.' do i:=i-1;
|
||||||
|
delete(s,i,length(chemin)-i+1);
|
||||||
|
nouv_chemin:=s+'.cmp'
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
|
procedure ecrire(fin:final;p:fichier;taille:longword;s:sauvegarde;longueur:byte;chemin:string);
|
||||||
|
var f:file;i,m:longword;j,k:byte;nombre:fichier;
|
||||||
|
begin
|
||||||
|
assign(f,nouv_chemin(chemin));
|
||||||
|
rewrite(f,1);
|
||||||
|
writeln('Écriture du dictionnaire...');
|
||||||
|
blockwrite(f,longueur,1);
|
||||||
|
for i:=high(s) downto 0 do
|
||||||
|
begin
|
||||||
|
blockwrite(f,s[i]^.octet,1);
|
||||||
|
nombrelong(s[i]^.freq,nombre);
|
||||||
|
for j:=length(nombre)-1 downto 0 do blockwrite(f,nombre[j],1);
|
||||||
|
end;
|
||||||
|
writeln('Recherche du point de départ des données...');
|
||||||
|
k:=0;
|
||||||
|
m:=0;
|
||||||
|
for i:=0 to high(s) do m:=length(fin[s[i]^.octet])*s[i]^.freq+m;
|
||||||
|
m:=(m-1) mod 8;
|
||||||
|
blockwrite(f,m,1);
|
||||||
|
writeln('Écriture des données...');
|
||||||
|
j:=0;
|
||||||
|
for i:=0 to taille-1 do
|
||||||
|
begin
|
||||||
|
for j:=high(fin[p[i]]) downto 0 do
|
||||||
|
begin
|
||||||
|
k:=(fin[p[i]][j])*trunc(power(2,m))+k;
|
||||||
|
if m=0 then
|
||||||
|
begin
|
||||||
|
blockwrite(f,k,1);
|
||||||
|
k:=0;
|
||||||
|
m:=7;
|
||||||
|
end
|
||||||
|
else m:=m-1;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure compter(p:fichier;taille:longword; var l:liste; var longueur:byte);
|
||||||
|
var i:longword;j:byte;l1:liste;t:tableau;
|
||||||
|
begin
|
||||||
|
writeln('Bilan des octets...');
|
||||||
|
j:=255;
|
||||||
|
longueur:=0;
|
||||||
|
for i:=0 to 255 do t[i]:=nil;
|
||||||
|
for i:=0 to taille-1 do
|
||||||
|
begin
|
||||||
|
if t[p[i]]=nil then
|
||||||
|
begin
|
||||||
|
longueur:=longueur+1;
|
||||||
|
new(t[p[i]]);
|
||||||
|
t[p[i]]^.freq:=0;
|
||||||
|
t[p[i]]^.octet:=p[i];
|
||||||
|
t[p[i]]^.gauche:=nil;
|
||||||
|
t[p[i]]^.droite:=nil;
|
||||||
|
t[p[i]]^.suiv:=nil;
|
||||||
|
if p[i]<j then j:=p[i];
|
||||||
|
end;
|
||||||
|
t[p[i]]^.freq:=t[p[i]]^.freq+1;
|
||||||
|
end;
|
||||||
|
l:=t[j];
|
||||||
|
l1:=l;
|
||||||
|
for i:=j+1 to 255 do
|
||||||
|
begin
|
||||||
|
if assigned(t[i]) then
|
||||||
|
begin
|
||||||
|
l1^.suiv:=t[i];
|
||||||
|
l1:=t[i];
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure verification(fin:final);
|
||||||
|
var i:byte;j:longword;
|
||||||
|
begin
|
||||||
|
writeln('Vérification');
|
||||||
|
for i:=0 to 255 do
|
||||||
|
begin
|
||||||
|
if length(fin[i])>0 then
|
||||||
|
begin
|
||||||
|
write(i,' ');
|
||||||
|
for j:=high(fin[i]) downto 0 do write(fin[i][j]);
|
||||||
|
writeln;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure verification2(l:liste);
|
||||||
|
begin
|
||||||
|
if l<>nil then
|
||||||
|
begin
|
||||||
|
writeln(l^.octet,': ',l^.freq);
|
||||||
|
verification2(l^.suiv);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function sauver(l:liste):sauvegarde;
|
||||||
|
var s:sauvegarde;
|
||||||
|
begin
|
||||||
|
setlength(s,0);
|
||||||
|
while l<>nil do
|
||||||
|
begin
|
||||||
|
setlength(s,length(s)+1);
|
||||||
|
s[length(s)-1]:=l;
|
||||||
|
l:=l^.suiv;
|
||||||
|
end;
|
||||||
|
sauver:=s;
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
writeln('Algorithme de Burrows-Weeler :');
|
||||||
|
importer(a,taille,chemin);
|
||||||
|
writeln('Création des décalages...');
|
||||||
|
tabler(d,a,taille,p);
|
||||||
|
transformer(p,d,taille,f);
|
||||||
|
writeln('Algorithme de Move-To-Front...');
|
||||||
|
taille:=length(f);
|
||||||
|
coder(f,taille);
|
||||||
|
writeln('Algorithme de Huffman :');
|
||||||
|
compter(f,taille,l,longueur);
|
||||||
|
writeln('Tri préliminaire...');
|
||||||
|
trier(l);
|
||||||
|
s:=sauver(l);
|
||||||
|
writeln('Création de l''arbre-dictionnaire...');
|
||||||
|
arbre(l,fin);
|
||||||
|
ecrire(fin,f,taille,s,longueur,chemin);
|
||||||
|
end.
|
||||||
|
|
@ -0,0 +1,251 @@
|
||||||
|
program decodage;
|
||||||
|
|
||||||
|
uses crt,dos,math;
|
||||||
|
|
||||||
|
type
|
||||||
|
liste=^cellule;
|
||||||
|
cellule=record
|
||||||
|
octet:byte;
|
||||||
|
freq:longword;
|
||||||
|
suiv:liste;
|
||||||
|
gauche:liste;
|
||||||
|
droite:liste;
|
||||||
|
end;
|
||||||
|
fichier=array of byte;
|
||||||
|
catalogue=array[0..255] of byte;
|
||||||
|
|
||||||
|
var p:fichier;l:liste;premier:byte;taille,index:longword;chemin:string;
|
||||||
|
|
||||||
|
function prefixe(ind:fichier):longword;
|
||||||
|
var s,i:longword;
|
||||||
|
begin
|
||||||
|
s:=0;
|
||||||
|
for i:=length(ind)-1 downto 0 do s:=(ind[i] div 2)*trunc(power(2,7*(length(ind)-1-i)))+s;
|
||||||
|
prefixe:=s;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure importer(var p:fichier; var l:liste; var premier:byte;var chemin:string);
|
||||||
|
var f:file;i:longword;j,longueur:byte;ind:fichier;l1,l2:liste;
|
||||||
|
begin
|
||||||
|
write('Chemin du fichier : ');
|
||||||
|
readln(chemin);
|
||||||
|
assign(f,chemin);
|
||||||
|
reset(f,1);
|
||||||
|
writeln('Importation...');
|
||||||
|
blockread(f,longueur,1);
|
||||||
|
(*Pour éviter les problèmes avec longueur=0, on fera une boucle de 0 à longueur-1*)
|
||||||
|
longueur:=longueur-1;
|
||||||
|
new(l);
|
||||||
|
l^.suiv:=nil;
|
||||||
|
setlength(ind,0);
|
||||||
|
for j:=0 to longueur do
|
||||||
|
begin
|
||||||
|
l^.gauche:=nil;
|
||||||
|
l^.droite:=nil;
|
||||||
|
blockread(f,l^.octet,1);
|
||||||
|
repeat
|
||||||
|
begin
|
||||||
|
setlength(ind,length(ind)+1);
|
||||||
|
blockread(f,ind[length(ind)-1],1);
|
||||||
|
end;
|
||||||
|
until ind[length(ind)-1] mod 2 = 0;
|
||||||
|
l^.freq:=prefixe(ind);
|
||||||
|
setlength(ind,0);
|
||||||
|
new(l1);
|
||||||
|
l1^.suiv:=l;
|
||||||
|
l:=l1;
|
||||||
|
end;
|
||||||
|
l2:=l;
|
||||||
|
l:=l^.suiv;
|
||||||
|
dispose(l2);
|
||||||
|
blockread(f,premier,1);
|
||||||
|
i:=0;
|
||||||
|
setlength(p,filesize(f)-filepos(f));
|
||||||
|
while not eof(f) do
|
||||||
|
begin
|
||||||
|
blockread(f,p[i],1);
|
||||||
|
i:=i+1;
|
||||||
|
end;
|
||||||
|
close(f);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function inserer(var l:liste; var l1:liste):liste;
|
||||||
|
begin
|
||||||
|
if l=nil then
|
||||||
|
begin
|
||||||
|
l1^.suiv:=nil;
|
||||||
|
inserer:=l1;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
if l1^.freq<=l^.freq then
|
||||||
|
begin
|
||||||
|
l1^.suiv:=l;
|
||||||
|
inserer:=l1;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
begin
|
||||||
|
l^.suiv:=inserer(l^.suiv,l1);
|
||||||
|
inserer:=l;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure arbre(var l:liste);
|
||||||
|
var l1:liste;
|
||||||
|
begin
|
||||||
|
if l^.suiv<>nil then
|
||||||
|
begin
|
||||||
|
new(l1);
|
||||||
|
l1^.gauche:=l;
|
||||||
|
l1^.droite:=l^.suiv;
|
||||||
|
l1^.freq:=l^.freq+l^.suiv^.freq;
|
||||||
|
l:=inserer(l^.suiv^.suiv,l1);
|
||||||
|
arbre(l);
|
||||||
|
end;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function bit(b,position:byte):byte;
|
||||||
|
begin
|
||||||
|
bit:=(b div trunc(power(2,position)))-(2*(b div trunc(power(2,position+1))));
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure interpreter(l:liste;var p:fichier;premier:byte);
|
||||||
|
var m:byte;l1:liste;f:fichier;i:longword;
|
||||||
|
begin
|
||||||
|
m:=premier;
|
||||||
|
l1:=l;
|
||||||
|
setlength(f,0);
|
||||||
|
for i:=0 to length(p)-1 do
|
||||||
|
begin
|
||||||
|
repeat
|
||||||
|
begin
|
||||||
|
if bit(p[i],m)=0 then l1:=l1^.gauche else l1:=l1^.droite;
|
||||||
|
if ((l1^.gauche=nil) and (l1^.droite=nil)) then
|
||||||
|
begin
|
||||||
|
setlength(f,length(f)+1);
|
||||||
|
f[length(f)-1]:=l1^.octet;
|
||||||
|
l1:=l;
|
||||||
|
end;
|
||||||
|
m:=m-1;
|
||||||
|
end;
|
||||||
|
until m=255;
|
||||||
|
m:=7;
|
||||||
|
end;
|
||||||
|
p:=f;
|
||||||
|
setlength(f,0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure coder(p:fichier;taille:longword);
|
||||||
|
var ref,car:catalogue;i:longword;j,k,l:byte;f:fichier;
|
||||||
|
begin
|
||||||
|
for i:=0 to 255 do ref[i]:=i;
|
||||||
|
car:=ref;
|
||||||
|
setlength(f,taille);
|
||||||
|
for i:=0 to taille-1 do
|
||||||
|
begin
|
||||||
|
j:=p[i];
|
||||||
|
f[i]:=car[j];
|
||||||
|
l:=car[j];
|
||||||
|
for k:=j downto 1 do
|
||||||
|
begin
|
||||||
|
car[k]:=car[k-1];
|
||||||
|
end;
|
||||||
|
car[0]:=l;
|
||||||
|
end;
|
||||||
|
p:=f;
|
||||||
|
setlength(f,0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function prefixe(ind:fichier;taille:longword):longword;
|
||||||
|
var s,i:longword;
|
||||||
|
begin
|
||||||
|
s:=0;
|
||||||
|
for i:=taille-1 downto 0 do s:=(ind[i] div 2)*trunc(power(2,7*(taille-1-i)))+s;
|
||||||
|
prefixe:=s;
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure preliminaire(var f:fichier;var index:longword);
|
||||||
|
var ind,p:fichier;i,j:longword;
|
||||||
|
begin
|
||||||
|
i:=0;
|
||||||
|
setlength(ind,0);
|
||||||
|
repeat
|
||||||
|
begin
|
||||||
|
setlength(ind,i+1);
|
||||||
|
ind[i]:=f[i];
|
||||||
|
i:=i+1;
|
||||||
|
end;
|
||||||
|
until ind[i-1] mod 2 = 0;
|
||||||
|
index:=prefixe(ind,i);
|
||||||
|
setlength(ind,0);
|
||||||
|
setlength(p,length(f)-i);
|
||||||
|
for j:=i to length(f)-1 do p[j-i]:=f[i];
|
||||||
|
f:=p;
|
||||||
|
setlength(p,0);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function decode(index,taille:longword;t:fichier):fichier;
|
||||||
|
var i,j,sum:longword;C,P:array of longword;S:fichier;
|
||||||
|
begin
|
||||||
|
setlength(C,256);
|
||||||
|
setlength(P,taille);
|
||||||
|
setlength(S,taille);
|
||||||
|
for i:=0 to 255 do C[i]:=0;
|
||||||
|
for i:=0 to taille-1 do
|
||||||
|
begin
|
||||||
|
P[i]:=C[t[i]];
|
||||||
|
C[t[i]]:=C[t[i]]+1;
|
||||||
|
end;
|
||||||
|
sum:=0;
|
||||||
|
for i:=0 to 255 do
|
||||||
|
begin
|
||||||
|
sum:=sum+C[i];
|
||||||
|
C[i]:=sum-C[i];
|
||||||
|
end;
|
||||||
|
i:=index;
|
||||||
|
for j:=taille-1 downto 0 do
|
||||||
|
begin
|
||||||
|
S[j]:=t[i];
|
||||||
|
i:=P[i]+C[t[i]];
|
||||||
|
end;
|
||||||
|
decode:=S;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function nouv_chemin(chemin,nom:string):string;
|
||||||
|
var i:byte;s:string;
|
||||||
|
begin
|
||||||
|
s:=chemin;
|
||||||
|
i:=length(chemin);
|
||||||
|
while s[i]<>'/' do i:=i-1;
|
||||||
|
delete(s,i,length(chemin)-i+1);
|
||||||
|
nouv_chemin:=s+'/'+nom
|
||||||
|
end;
|
||||||
|
|
||||||
|
procedure ecrire(d:fichier;taille:longword;chemin:string);
|
||||||
|
var f1:file;nom:string;i:longword;
|
||||||
|
begin
|
||||||
|
write('Nom du fichier : ');
|
||||||
|
readln(nom);
|
||||||
|
assign(f1,nouv_chemin(chemin,nom));
|
||||||
|
rewrite(f1,1);
|
||||||
|
writeln('Écriture de la séquence...');
|
||||||
|
for i:=0 to taille-1 do
|
||||||
|
begin
|
||||||
|
blockwrite(f1,d[i],1);
|
||||||
|
end;
|
||||||
|
close(f1);
|
||||||
|
end;
|
||||||
|
|
||||||
|
begin
|
||||||
|
importer(p,l,premier,chemin);
|
||||||
|
arbre(l);
|
||||||
|
interpreter(l,p,premier);
|
||||||
|
taille:=length(p);
|
||||||
|
coder(p,taille);
|
||||||
|
preliminaire(p,index);
|
||||||
|
taille:=length(p);
|
||||||
|
p:=decode(index,taille,p);
|
||||||
|
writeln('ok');
|
||||||
|
ecrire(p,taille,chemin);
|
||||||
|
end.
|
||||||
Loading…
Reference in New Issue