Newsgroups: comp.lang.prolog
Path: cantaloupe.srv.cs.cmu.edu!das-news2.harvard.edu!news2.near.net!howland.reston.ans.net!news.sprintlink.net!EU.net!sun4nl!tnofel!leeh7
From: leeh7@fel.tno.nl (Ed van Leeuwen)
Subject: Re: Anagrams in Prolog
Message-ID: <1995Mar13.111907.15784@fel.tno.nl>
Organization: TNO Physics and Electronics Laboratory
References: <3jf836$jhv@seralph9.essex.ac.uk> <1995Mar11.082436.1@leif>
Date: Mon, 13 Mar 1995 11:19:07 GMT
Lines: 266

Below is an attempt we've made. It is written in Quintus Prolog
and in Dutch (please figure out which is more natural to you ;-))

It takes a list of proper Dutch words as an input; this way we
obtain a proper anagram word or anagram sentence.

Should anyone have any comments, please feel free to contact me.



					(R)egards,

					Ed.

===============================================================================
Ed van Leeuwen                        |  Ed W.A. van Leeuwen
TNO Fysisch en Elektronisch           |  TNO Physics and Electronics Laboratory
    Laboratorium                      |
Den Haag                              |  The Hague, the Netherlands
-------------------------------------------------------------------------------
Ed.van.Leeuwen@fel.tno.nl             |  Oops! Sorry, I am only a referee...
===============================================================================
 /*
ADMINISTRATIE
-------------

Naam:		Anagramgenerator
Ontwerp:	Ed van Leeuwen
Datum:		1 november 1994
*/

versie('2.1').

/*
REVISIES
--------

1.0	(1 november 1994, Ed van Leeuwen)
---
Eerste poging.
Probleem: inlezen van ASCII-woordenlijst duurt veel te lang.

1.1	(10 november 1994, Ed van Leeuwen)
---
Tweede poging.
Woordenlijst als Prolog-gegevensbank meegecompileerd (met
dank aan Maarten).

1.2	(30 november 1994, Merel Geerlink)
---
Poging tot het afdrukken van de resultaten terwijl het 
programma nog draait

1.3	(5 december 1994, Merel Geerlink)
---
Aanpassing van het algoritme, zodat er niet zoveel
dubbel wordt gedaan (subseq/3 vervangen door midstring/4).
 
1.4	(8 december 1994, Ed van Leeuwen)
---
Permutaties gegroepeerd met 'setof', maar daarna weer weggehaald
vanwege geheugenproblemen bij lange woorden.

2.0	(8 december 1994, Ed van Leeuwen)
---
Permutatie op een hoger niveau getild.

2.1	(13 december 1994, Ed van Leeuwen)
---
Alleen nieuwe tussenresultaten afdrukken. 'setof' voor eindresultaat
hierdoor overbodig geworden.

*/ 


/*
KLAD
----
[graanma].
read_file(atjes).
listing.
clean.
*/

/*
	Foutafhandeling
*/

user:message_hook(A,error,_):-
	format(user_error, '~nO jee! Graanma struikelde over:~n~w.~n', [A]),
	halt.

:-use_module(library(foreach)).
:-use_module(library(basics)).
:-use_module(library(not)).

:-use_module(library(strings)).
:-use_module(library(ask),[ask/2, ask_file/3]).

/*
	Begin van Graanma
*/

runtime_entry(start):-
	unknown(_,fail),
	nl,nl,
	write('=== Graanma: een anagramgenerator (versie '),
	versie(Versie),
	write(Versie),
	write(') ==='),nl,nl,
	argumenten(Woord,Uit),
	(	Uit \= []
	->	tell(Uit)
	|	true
	),
	graanma(Woord),
	told,
	write('- Klaar.'),nl,
	halt.

runtime_entry(abort):-
	told,
	nl,write('- O jee! Graanma werd afgebroken.'),nl,
	halt.

:-use_module(library(ask),[ask_chars/4]).

argumenten(Woord,Uit):-
	unix(args([Woord, Uit])),
	!,
	write('> Woord:	'), write(Woord), write('.'), nl,
	write('> Uitvoer:	'), write(Uit), write('.'), nl.
argumenten(Woord,[]):-
	unix(args([Woord])),
	!,
	write('> Woord:	'), write(Woord), write('.'), nl,
	write('> Uitvoer naar standaarduitvoer.'), nl.
argumenten(Woord,Uit):-
	ask_chars('Welk woord', 1, 30, Chars),
	atom_chars(Woord, Chars),
	(	ask_file('Wat is de naam van het uitvoerbestand? ',write,Uit)
	->	true
	|	Uit = []
	).

/***************************
	Anagrammen
***************************/

:-use_module(library(lists),[subseq/3, permutation/2]).

graanma(Woord):-
	atom_chars(Woord, Chars),
	forall(	(	graanma_chars(Chars, Anagramchars),
			new_tuple(anagram(Anagramchars))
		),
	(	atom_chars(Anagram, Anagramchars),
		write(Anagram), nl
	)).

graanma_chars(Chars, Anagramchars):-
%% permuteer het woord:
	permutation(Chars, Permutatie),
	new_tuple(permutatie(Permutatie)),
	graanma_chars(Permutatie, Anagramchars, 1).

graanma_chars([], [], _Niveau).
graanma_chars(Woordc, Totaalc, Niveau):-
	atom_chars(Tempa, Woordc),
%% hak de permutatie op in twee delen, beginnend vanaf de eerste positie:
	midstring(Tempa, Eerstea, Tweedea, 0),
	Eerstea \= '',
	chars_atom(Onec, Eerstea),
%% verifieer deelwoord met woordenlijst, intern of extern:
	goede_permutatie(Onec),
%% probeer uit de rest een anagram te halen:
	chars_atom(Twoc, Tweedea),
	graanma_chars(Twoc, TweedeAnagram, Niveau+1),
%	!,
	garbage_collect,
	append(Onec, [32 | TweedeAnagram], Totaalc).

/***************************
	Proberen tijdwinst te pakken
***************************/

:-dynamic permutatie/1.
:-dynamic anagram/1.

new_tuple(Tuple):-
	call(Tuple),
	!,
	fail.
new_tuple(Tuple):-
	assert(Tuple).

:-dynamic goed_graanma_woord/1.
:-dynamic fout_graanma_woord/1.

goede_permutatie(Woord):-
	goed_graanma_woord(Woord),
	!.
goede_permutatie(Woord):-
	fout_graanma_woord(Woord),
	!,
	fail.
goede_permutatie(Woord):-
	(	atom_chars(Atom,Woord),
		woord(Atom)
	)
	->
	assert(goed_graanma_woord(Woord))
|	assert(fout_graanma_woord(Woord)),
	fail.

/***************************
	Administratie
***************************/

schrijf_spaties(Aantal):-
	Aantal=<0.

schrijf_spaties(Aantal):-
	Aantal>0,
	write('  '),
	New is Aantal-1,
	schrijf_spaties(New).

schrijf_totaal(Totaal, 1):-
	atom_chars(Tussen, Totaal),
	write('-->Totaal: '),
	write(Tussen), nl.
schrijf_totaal(_Totaal, Niveau):-
	Niveau>1.

schrijf_tussen(Een, Twee, N):-
	N>0,
	schrijf_spaties(N),
	write('Eerste: '), write(Een), nl,
	schrijf_spaties(N),
	write('Tweede: '), write(Twee), nl.

chars_atom(Chars, Atom):-
	name(Atom, Chars).

/***************************
	Lezen van bestand
***************************/

/*
:-use_module(library(lineio),[get_line/1]).

read_file(F):-
	write('- Inlezen van '), write(F), write('...'), nl,
	see(F),
	repeat,
	(	get_line(Chars),
		assert(woord(Chars))
	),
	at_end_of_file,
	!,
	seen.

*/
:-ensure_loaded(lijst).

