git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1818 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
		
			
				
	
	
		
			113 lines
		
	
	
		
			3.4 KiB
		
	
	
	
		
			OpenEdge ABL
		
	
	
	
	
	
			
		
		
	
	
			113 lines
		
	
	
		
			3.4 KiB
		
	
	
	
		
			OpenEdge ABL
		
	
	
	
	
	
| abolish_table_info :- at(compress/2).
 | |
| 
 | |
| time :- statistics(runtime,_), benchmark, fail;
 | |
|         statistics(runtime,[_,T]), write(T).
 | |
| 
 | |
| benchmark :- data(Data), compress(Data, _C).
 | |
| 
 | |
| test :-
 | |
|     data(Data), reinit,
 | |
|     cputime(T0),
 | |
|     compress(Data, C), write(C), write(' '),
 | |
|     cputime(T1), T is T1-T0, write(T), write(' msecs'), nl, fail.
 | |
| test.
 | |
| 
 | |
| %% data([a,a,b,a,a,b]).
 | |
| %% data([a,a,b,a,a,b,a,a,b]).
 | |
| %% data([a,a,a,a,a,a,a,a,a,a,a,a]).
 | |
| %% data([a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a]).
 | |
| %% data([a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a,a]).
 | |
| %% data(D) :- bigdata(D).
 | |
| %% data(D2) :- bigdata(D), append(D,D,D2).
 | |
| data(D4) :- bigdata(D), append(D,D,D2), append(D2,D2,D4).
 | |
| %% data(D8) :- bigdata(D), append(D,D,D2), append(D2,D2,D4), append(D4,D4,D8).
 | |
| %% data(D16) :- bigdata(D), append(D,D,D2), append(D2,D2,D4), append(D4,D4,D8), append(D8,D8,D16).
 | |
| 
 | |
| bigdata([x,c,a,a,b,a,a,b,a,a,b,c,c,a,d,a,d,c,a,a,b,a,a,b,a,a,b,c,c,a,d,a,d,y]).
 | |
| 
 | |
| %% ==================== VERSION USING ASSERT FOR TABLES ======================
 | |
| %% reinit :-
 | |
| %%	retractall(memo_compress(_, _)),
 | |
| %%	assert(memo_compress([C1], [C1])),
 | |
| %%	assert(memo_compress([C1,C2], [C1,C2])).
 | |
| %%
 | |
| %% compress(Initial, Compressed) :-
 | |
| %%	( memo_compress(Initial, Compressed) -> true
 | |
| %%	  mlength(Initial, LenInitial),
 | |
| %%	  CurrentBest = Initial,
 | |
| %%	  LenCurrentBest = LenInitial,
 | |
| %%	  compress4(Initial, CurrentBest, LenCurrentBest, Compressed)
 | |
| %%	  assert(memo_compress(Initial, Compressed))
 | |
| %%	).
 | |
| %% ===========================================================================
 | |
| 
 | |
| reinit :- abolish_all_tables.
 | |
| 
 | |
| :- table compress/2.
 | |
| 
 | |
| compress(Initial, Compressed) :-
 | |
| 	mlength(Initial, LenInitial),
 | |
| 	CurrentBest = Initial,
 | |
| 	LenCurrentBest = LenInitial,
 | |
| 	compress4(Initial, CurrentBest, LenCurrentBest, Compressed).
 | |
| 
 | |
| compress4(Initial, CurrentBest, LenCurrentBest, Compressed) :-
 | |
| 	( compress_with_bound(Initial, LenCurrentBest, NewBest) ->
 | |
| 	        mlength(NewBest, NewLenBest),
 | |
| 		compress4(Initial, NewBest, NewLenBest, Compressed)
 | |
| 	; Compressed = CurrentBest
 | |
| 	).
 | |
| 
 | |
| compress_with_bound(Initial, LenBound, Better) :-
 | |
| 	repetition_compress(Initial, LenBound, Better).
 | |
| compress_with_bound(Initial, LenBound, Better) :-
 | |
| 	two_price_compress(Initial, LenBound, Better).
 | |
| 
 | |
| repetition_compress(Initial, LenBound, Better) :-
 | |
| 	chopup(Initial, Piece, Repeated),
 | |
| 	( Piece = [C] ->
 | |
| 		Better = [C,Repeated]
 | |
| 	; compress(Piece, CompressedPiece),
 | |
| 	  append(['('|CompressedPiece], [')',Repeated], Better)
 | |
| 	),
 | |
| 	mlength(Better, LenBetter),
 | |
| 	LenBetter < LenBound.
 | |
| 
 | |
| two_price_compress(Initial, LenBound, Better) :-
 | |
| 	append(Piece1, Piece2, Initial),
 | |
| 	Piece1 \== [],
 | |
| 	Piece2 \== [],
 | |
| 	compress(Piece1, Compressed1),
 | |
| 	mlength(Compressed1, LenCompressed1),
 | |
| 	LenCompressed1 < LenBound,
 | |
| 	compress(Piece2, Compressed2),
 | |
| 	mlength(Compressed2, LenCompressed2),
 | |
| 	LenCompressed1 + LenCompressed2 < LenBound,
 | |
| 	append(Compressed1, Compressed2, Better).
 | |
| 
 | |
| chopup(List, Part, Repeated) :-
 | |
| 	append(Part, Rest, List),
 | |
| 	Part \== [],
 | |
| 	Rest \== [],
 | |
| 	count_parts(Rest, Part, 1, Repeated).
 | |
| 
 | |
| count_parts(Rest, Part, I, O) :-
 | |
| 	( Rest == [] -> I = O
 | |
| 	; append(Part, Rest1, Rest),
 | |
| 	  I1 is I+1,
 | |
| 	  count_parts(Rest1, Part, I1, O)
 | |
| 	).
 | |
| 
 | |
| %%----------------------------------------------------------------------------
 | |
| %% Utilities below
 | |
| %%----------------------------------------------------------------------------
 | |
| 
 | |
| append([],L,L).
 | |
| append([H|L1],L2,[H|L3]) :- append(L1,L2,L3).
 | |
| 
 | |
| mlength(L,N) :- mlength(L,0,N).
 | |
| 
 | |
| mlength([],N,N).
 | |
| mlength([_|R],N0,N) :- N1 is N0+1, mlength(R,N1,N).
 | |
| 
 |