From 9eb3aa151de2ac057ed6f536d0081065ee37b81c Mon Sep 17 00:00:00 2001
From: raspbeguy <raspbeguy@hashtagueule.fr>
Date: Mon, 7 Mar 2016 17:51:00 +0100
Subject: [PATCH] initial

---
 README.md    |   0
 codage.pas   | 426 +++++++++++++++++++++++++++++++++++++++++++++++++++
 decodage.pas | 251 ++++++++++++++++++++++++++++++
 3 files changed, 677 insertions(+)
 create mode 100644 README.md
 create mode 100644 codage.pas
 create mode 100644 decodage.pas

diff --git a/README.md b/README.md
new file mode 100644
index 0000000..e69de29
diff --git a/codage.pas b/codage.pas
new file mode 100644
index 0000000..5fbc724
--- /dev/null
+++ b/codage.pas
@@ -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.
\ No newline at end of file
diff --git a/decodage.pas b/decodage.pas
new file mode 100644
index 0000000..be9b674
--- /dev/null
+++ b/decodage.pas
@@ -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.
\ No newline at end of file