Génère tous les mots de longueur N à partir d'un alphabet {a, b, c, d, e, f} où 4 lettres apparaissent deux fois et toutes les autres lettres apparaissent une fois ou n'apparaissent pas du tout.

J'ai trouvé ce code qui génère des mots à partir d'un alphabet

letter(X) :- member(X, [a, b, c, d, e, f]).

word(0, []).
word(N, [C|W]) :-
    N > 0,
    N1 is N-1,
    letter(C),
    word(N1, W).

words(N, L) :-
    findall(W, word(N, W), Ws),
    maplist(atomic_list_concat, Ws, L).

J'ai décidé d'aller tous les jeter et de choisir ceux qui correspondent à mes conditions en comptant les occurrences de lettres

count_occurrences(List, Occ):-
    findall([X,L], (bagof(true,member(X,List),Xs), length(Xs,L)), Occ).

Besoin de publier cette structure imbriquée,

2
Gor Danielyan 3 nov. 2020 à 22:47

3 réponses

Meilleure réponse

J'ai essayé de rendre cette solution aussi efficace que possible, au moins pour un petit puzzle en soirée. Les suggestions d'amélioration sont les bienvenues.

Génère tous les mots de longueur N à partir d'un alphabet {a, b, c, d, e, f} où 4 lettres apparaissent deux fois et toutes les autres lettres apparaissent une fois ou n'apparaissent pas du tout.

Ma lecture est que cela implique que toute solution aura une longueur de 8 à 10: 4 * 2 caractères doivent apparaître, et il y a jusqu'à deux autres caractères facultatifs. Ma solution est structurée comme la première construction d'un "mot de base" composé de ces caractères optionnels. Dans ce mot de base, nous insérons ensuite deux copies chacune de quatre autres caractères.

Donc, cette double insertion d'abord:

insert2(Xs, Y) -->
    [Y],
    insert(Xs, Y).
insert2([X | Xs], Y) -->
    [X],
    insert2(Xs, Y).

insert(Xs, Y) -->
    [Y],
    list(Xs).
insert([X | Xs], Y) -->
    [X],
    insert(Xs, Y).

list([]) -->
    [].
list([X | Xs]) -->
    [X],
    list(Xs).

Par exemple:

?- phrase(insert2([b], a), List).
List = [a, a, b] ;
List = [a, b, a] ;
List = [b, a, a].

Mais cela prend trop de temps, quelles autres solutions peut-on trouver?

Avec cela, les mots de base sont:

baseword([]).
baseword([_X]).
baseword([_X, _Y]).

Et le prédicat décrivant la structure de toutes les solutions possibles est:

puzzle_(CharacterPlaceholders) :-
    baseword(BaseWord),
    phrase(insert2(BaseWord, _A), WordWith2A),
    phrase(insert2(WordWith2A, _B), WordWith2A2B),
    phrase(insert2(WordWith2A2B, _C), WordWith2A2B2C),
    phrase(insert2(WordWith2A2B2C, _D), WordWith2A2B2C2D),
    CharacterPlaceholders = WordWith2A2B2C2D.

Par exemple:

?- puzzle_(List).
List = [_2278, _2278, _2230, _2230, _2194, _2194, _2170, _2170] ;
List = [_2278, _2230, _2278, _2230, _2194, _2194, _2170, _2170] ;
List = [_2278, _2230, _2230, _2278, _2194, _2194, _2170, _2170] ;
List = [_2278, _2230, _2230, _2194, _2278, _2194, _2170, _2170] ;
List = [_2278, _2230, _2230, _2194, _2194, _2278, _2170, _2170] ;
List = [_2278, _2230, _2230, _2194, _2194, _2170, _2278, _2170] .

Combien de temps faut-il pour énumérer toutes les variantes?

?- time((puzzle_(CharacterPlaceholders), false)).
% 845,559 inferences, 0.040 CPU in 0.040 seconds (100% CPU, 21324130 Lips)
false.

Cela semble raisonnable.

Compte tenu de ces structures, il reste à remplir les espaces réservés. Cela consiste à attribuer des lettres aux variables de la liste (n'attribuer chaque lettre qu'une seule fois, mais si la variable apparaît deux fois dans la liste, cela fera également apparaître la lettre deux fois):

label(CharacterPlaceholders) :-
    Letters = [a, b, c, d, e, f],
    label(CharacterPlaceholders, Letters).

label([], _Letters).
label([Var | MaybeVars], Letters) :-
    (   var(Var)
    ->  select(Var, Letters, RemainingLetters),
        label(MaybeVars, RemainingLetters)
    ;   label(MaybeVars, Letters) ).

Par exemple:

?- puzzle_(List), label(List).
List = [a, a, b, b, c, c, d, d] ;
List = [a, a, b, b, c, c, e, e] ;
List = [a, a, b, b, c, c, f, f] ;
List = [a, a, b, b, d, d, c, c] ;
List = [a, a, b, b, d, d, e, e] ;
List = [a, a, b, b, d, d, f, f] ;
List = [a, a, b, b, e, e, c, c] ;
List = [a, a, b, b, e, e, d, d] .

Quel est le coût de l'énumération de toutes les solutions de longueurs 8, 9 et 10, respectivement?

?- between(8, 10, Length), length(List, Length), time((puzzle_(List), label(List), false)).
% 7,306,838 inferences, 0.334 CPU in 0.334 seconds (100% CPU, 21869592 Lips)
% 128,616,758 inferences, 6.052 CPU in 6.052 seconds (100% CPU, 21252001 Lips)
% 918,924,038 inferences, 46.998 CPU in 46.999 seconds (100% CPU, 19552521 Lips)
false.
3
Isabelle Newbie 3 nov. 2020 à 22:39

Pour ce problème Vous voulez utiliser des "codes" Prolog pour représenter Votre mot et non Prolog "atomes". Les "codes" sont contenus entre guillemets et sont du sucre syntaxique pour une liste. La liste "codes" contient des éléments qui sont des nombres correspondant au numéro unicode de chaque caractère. L'énorme avantage des «codes» par rapport aux «atomes» est que vous pouvez utiliser toutes les fonctions disponibles pour les listes pour créer, inspecter, découper et couper les `em; dont notamment: le DCG.

:- system:set_prolog_flag(double_quotes,codes) .

:- [library(lists)] .

main(N0)
:-
main(N0,WORDz) ,
system:format('one possibility is "~s" .~n',[WORDz]) ,
fail ;
true
.

main(N0,WORDz)
:-
main("abcdef",N0,WORDz)
.

main(ALPHABETz0,N0,WORDz)
:-
constrain(N0,WORDz) ,
generate(ALPHABETz0,WORDz)
.

constrain(N0,WORDz0)
:-
prolog:length(WORDz0,N0)
.

generate(ALPHABETz0,WORDz)
:-
prolog:phrase(generate(ALPHABETz0),WORDz)
.

generate(ALPHABETz0)
-->
{
    lists:select(A,ALPHABETz0,ALPHABETz1) ,
    lists:select(B,ALPHABETz1,ALPHABETz2) ,
    lists:select(C,ALPHABETz2,ALPHABETz3) ,
    lists:select(D,ALPHABETz3,ALPHABETz4) ,
    lists:select(E,ALPHABETz4,ALPHABETz5) ,
    lists:select(F,ALPHABETz5,_LPHABETz6)
} ,
double(A) ,
double(B) ,
double(C) ,
double(D) ,
optional(E) ,
optional(F)
.

double(IT) --> [IT] , [IT] .

optional(IT) --> [IT] .

optional(_IT) --> [] .
/*
?- main(10) .
one possibility is "aabbccddef" .
one possibility is "aabbccddfe" .
one possibility is "aabbcceedf" .
one possibility is "aabbcceefd" .
one possibility is "aabbccffde" .
one possibility is "aabbccffed" .
one possibility is "aabbddccef" .
one possibility is "aabbddccfe" .
one possibility is "aabbddeecf" .
one possibility is "aabbddeefc" .
one possibility is "aabbddffce" .
one possibility is "aabbddffec" .
one possibility is "aabbeeccdf" .
one possibility is "aabbeeccfd" .
one possibility is "aabbeeddcf" .
one possibility is "aabbeeddfc" .
one possibility is "aabbeeffcd" .
one possibility is "aabbeeffdc" .
one possibility is "aabbffccde" .
one possibility is "aabbffcced" .
one possibility is "aabbffddce" .
one possibility is "aabbffddec" .
one possibility is "aabbffeecd" .
one possibility is "aabbffeedc" .
one possibility is "aaccbbddef" ...
...
.e.t.c
...
one possibility is "ffeeccddba" .
one possibility is "ffeeddaabc" .
one possibility is "ffeeddaacb" .
one possibility is "ffeeddbbac" .
one possibility is "ffeeddbbca" .
one possibility is "ffeeddccab" .
one possibility is "ffeeddccba" .
true .
*/
-1
Kintalken 4 nov. 2020 à 00:47

Même avec Prolog, la génération de force brute prendra beaucoup de temps lorsque N> 4. Bien sûr, les inférences Prolog sont plus lentes que le forçage brutal en «C».

La solution est de générer intelligemment:

  1. Générez uniquement les configurations souhaitées:
    • Sélectionnez 4 caractères en rupture de stock de 6 et laissez-les apparaître 2 fois
    • Du reste, laissez-les se produire 0 ou 1 fois
  2. Contraintes: vous aurez besoin de la bibliothèque CLP dans swi-prolog
      Notez que ceci est quelque peu soigneusement écrit pour éviter de laisser un point de choix à la fin (dans SWI-Prolog). Plus important encore, il est également écrit pour éviter les solutions en double; si vous implémentez une double insertion comme "insérer dans une liste, puis insérer dans ce résultat", vous obtiendrez des doublons, et dans un algorithme exponentiel, cela fera mal.

Sur la première solution, voici du code:

generate(N, O) :-
    getComponents(Xs),
    combineComponents(Xs, Ys),
    generateN(N, Ys, O).
    
getComponents([twice(A, B, C, D), zeroOrOne(X, Y)]) :-
    Ls = [a, b, c, d, e, f],
    member2(A, Ls, Rs), 
    member2(B, Rs, Ts), 
    member2(C, Ts, Ss), 
    member2(D, Ss, Xs),
    Xs = [X, Y].

member2(X, [X|Rs], Rs).
member2(X, [F|Rs], [F|Ts]) :- member2(X, Rs, Ts).

combineComponents([twice(A, B, C, D), zeroOrOne(X, Y)], Out6) :-
    twice(A, Out1, []),
    twice(B, Out2, Out1),
    twice(C, Out3, Out2),
    twice(D, Out4, Out3),
    zeroOrOne(X, Out5, Out4),
    zeroOrOne(Y, Out6, Out5).

generateN(N, Ys, A) :-
    append(A, _, Ys),
    length(A, N).

twice(A, [A, A|R], R).
zeroOrOne(A, R, R).
zeroOrOne(A, [A|R], R).

Il y a 3 étapes:

  1. getComponents / 1 renvoie les composants en deux parties, les lettres que vous pouvez utiliser deux fois et les lettres restantes qui apparaissent zéro ou une fois. member2 / 3 est similaire au membre traditionnel / 2, mais renvoie les éléments non utilisés de l'argument 2.

  2. combineComponents / 2 combine les lettres des nombres donnés, en utilisant les sous-prédicats zeroOrOne / 3 et deux fois / 3. Ici, j'utilise la méthode de la liste des différences pour éviter d'avoir à concaténer les composants résultants.

  3. generateN / 3, étant donné N et les composants dans leur multiplicité, génère une liste avec N membres.

    Quelques résultats: N = 8 [c, d, d, e, e, a, a, f] [b, d, d, e, e, a, a, f] ...

Vous n'avez rien dit sur l'ordre des lettres dans les résultats. Cette solution a des solutions répétitives, par ex. deux solutions dans un ordre différent telles que

[a,a,c,c,b,b,f,f]
[c,c,b,b,f,f,a,a]

Ce sera donc un exercice pour vous!

2
peter.cyc 3 nov. 2020 à 21:47