Declaratieve Talen/oplossingHuffman

Dit lijkt te werken. Voel u vrij verbeteringen aan te brengen. Dit is ook absoluut niet de snelste oplossing. Zowat elke verbetering (freeze, difference list, accumulerende parameter, ...) kan hier wel ergens toegepast worden. Laat u gaan.

   decodeer(1,L,[0-L]) :- !.
   decodeer(N,L,Res) :-
       %genereer
       N2 is N - 1,
       append(L2,Tail,L),
       L2 \= [],
       Tail \= [],
       decodeer(N2,L2,Res2),
       append(Res2,[N2-Tail],Res),
       %test
       validCode(Res).
   
   %Controleert of een encodering een Huffmanencodering is
   validCode(C) :-
       findall(X,member(_-X,C),L),
       noPrefixes(L,L).
   
   %Controleert of geen enkel element van de eerste lijst een prefix is van
   %een element uit de tweede lijst
   noPrefixes([],_).
   noPrefixes([X|T],L) :-
       select(X,L,L2), %haal X zelf uit de lijst (delete werkt niet!)
       notPrefix(X,L2),
       noPrefixes(T,L).
   
   %Controleert of een gegeven lijst geen prefix is van elk element van een
   %andere lijst van lijsten.
   notPrefix(_,[]).
   notPrefix(X,[F|T]):-
       \+ append(X,_,F),
       notPrefix(X,T).
   
   beste(N,L,F,Res) :-
       findall(X,decodeer(N,L,X),Codes),
       besteCode(Codes,F,Res).
   
   besteCode([X|T],F,Res) :-
       zoekBetere(T,F,X,Res).
   
   %Dit zoekt een kortere encodering uit de lijst dan de encodering gegeven door Best.
   zoekBetere([],_,Best,Best).
   zoekBetere([X|T],F,Best,Res) :-
       berekenLengte(X,F,Len),
       berekenLengte(Best,F,BestLen),
       (Len < BestLen ->
           zoekBetere(T,F,X,Res)
       ;
           zoekBetere(T,F,Best,Res)
       ).
   
   berekenLengte([],_,0).
   berekenLengte([N-L|T],F,Len) :-
       zoekFreq(N,F,Aantal),
       length(L,LenL),
       Len2 is Aantal * LenL,
       berekenLengte(T,F,LenRest),
       Len is LenRest + Len2.
   
   zoekFreq(N,[N-Res|_],Res).
   zoekFreq(N,[_|T],Res) :-
       zoekFreq(N,T,Res).
  
  % Opm: delete werkt niet in noprefixes: 
  % delete(+List1, ?Elem, ?List2)
  % Delete all members of List1 that simultaneously unify with Elem and unify the result with List2.

Nog een andere oplossing:

decodeer(N, Code, Res):-
	partition(Code, N, Partitie), %Maak een willekeurige partitie van lengte N van de meegegeven code.
	geldigecode(Partitie), %Kijk na of deze partitie een geldige code is.
	nummer(Partitie, 0, Res). %"De codes staan in volgorde van index."


beste(N,Code,Freqs,Best):-
	%Zoek alle mogelijke encoderingen en geef ze een score
	findall(Encodering-Score, decodeerenrate(N, Code, Encodering, Freqs, Score), Scores),
	%Zonder de scores af
	getonlyscores(Scores, OnlyScores),
	%en zoek de kleinste score. De beste encodering heeft de kleinste score.
	min_list(OnlyScores, MinScore),
	%Zoek de encodering die past bij de beste score.
	member(Best-MinScore, Scores).

partition(List, N, Result) :-
	length(Result, N),
	append(Result, List),
	forall(member(X, Result), X \= []).

geldigecode(X) :- geldigecode(X,X).
geldigecode([], _).
geldigecode([Deel|Rest], Codes):-
	select(Deel, Codes, OverigeCodes),
	forall(member(X, OverigeCodes), \+prefix(Deel, X)),  %De code mag geen prefix zijn van een van de andere codes.
	geldigecode(Rest, Codes).

%score van een encodering = \sum freq_i*|encodering_i|
decodeerenrate(N, Code, Encodering, Freqs, Score):-
	decodeer(N, Code, Encodering),
	berekenscore(Encodering, Freqs, Score).

getonlyscores([], []).
getonlyscores([_Encodering-Score|Rest], [Score|OtherScores]):-
	getonlyscores(Rest, OtherScores).

%Berekent de score van een encodering, gegeven en frequentietabel.
%De score wordt bepaalt door sum freq_i*|encodering_i|.
berekenscore([], _, 0).
berekenscore([Symbool-Code|Rest], Freqs, Score):-
	length(Code, CodeLengte),
	member(Symbool-Freq, Freqs),
	TempScore is Freq*CodeLengte,
	berekenscore(Rest, Freqs, RestScore),
	Score is TempScore+RestScore.

%Zet de index van de elementen van een lijst voor de elementen.
%Start vanaf meegegeven N.
nummer([], _, []).
nummer([Code|Rest], N, Res):-
	Genummerd = N-Code,
	NewN is N+1,
	nummer(Rest, NewN, TempRes),
	Res = [Genummerd|TempRes].

--Harm.de.weirdt 12 jan 2012 14:25 (CET)