SWISH -- SWI-Prolog for SHaring

#!/usr/bin/env swipl --quiet

% All my gist code is licensed under the MIT license.

:- use_module(library(clpfd)).

% ORIGINAL LYRICS:
% Looking for
% Girls who want boys
% Who like boys to be girls
% Who do boys like they're girls
% Who do girls like they're boys
% Always should be someone you really love
%    - "Girls and Boys," Blur, 1994

% DSL CONVERSION:
% girls who like boys
% who like boys (who are girls)
% who like boys (who get done like they're girls)
% who like girls (who get done like they're boys)

% TREE STRUCTURE:
% group(female, none, none, group(
%   male, female, none, group(
%     male, none, female, group(
%       female, none, male, none)))).

% USAGE:
% 1. Get all possible lyrics up to a max depth:
%    ?- group_maxdepth(G, 4), group_string(G, S).
% 2. Get the tree structure of some lyrics (pass a max depth to avoid unbounded recursion):
%    ?- group_maxdepth(G, 4), group_string(G, 'boys who like girls').
% 3. Get the lyrics from a tree structure:
%    ?- group_string(group(male, none, none, group(female, none, none, none)), S).
% 4. Fill in the blanks with all possibilities:
%    ?- group_depth(G, 3),
%       phrase(group_sentence(G), Tokens),
%       append([[girls, who, like], X, [who, like], Y], Tokens),
%       atomic_list_concat(Tokens, ' ', S).

% Genders
gender(male).
gender(female).

% gender_altgender(G, G2)
% Valid relation between gender and alternative genders (isGender and
% PerformGender) in the same group.
gender_altgender(G, none) :-
  gender(G).
gender_altgender(G, G2) :-
  gender(G),
  gender(G2),
  dif(G, G2).

% Group(Gender, IsGender, PerformGender, LikeGroup).
% All arguments but Gender are optional.
% Represents a demographic that can like and can be a target of liking.
group(Gender, IsGender, PerformGender, none) :-
  gender(Gender),
  gender_altgender(Gender, IsGender),
  gender_altgender(Gender, PerformGender).
group(Gender, IsGender, PerformGender, group(Gender2, IsGender2, PerformGender2, Group)) :-
  group(Gender, IsGender, PerformGender, none),
  group(Gender2, IsGender2, PerformGender2, Group).

% DCG to produce a phrase from a group.
% Example:
% ?- phrase(group_sentence(group(male, none, none, group(female, none, none, group(male, none, none, group(male))))), Tokens).
% Tokens = [boys, who, like, girls, who, like, boys, who, like, boys].
group_sentence(group(Gender, IsGender, PerformGender, none)) -->
  { group(Gender, IsGender, PerformGender, none) },
  gender_phrase(Gender),
  group_info_phrase(IsGender, PerformGender).
group_sentence(group(Gender, IsGender, PerformGender, Group)) -->
  { dif(Group, none) },
  group_sentence(group(Gender, IsGender, PerformGender, none)),
  [who, like],
  group_sentence(Group).

gender_phrase(male)   --> [boys].
gender_phrase(female) --> [girls].

isgender_phrase(none) --> [].
isgender_phrase(Gender) --> [are], gender_phrase(Gender).

performgender_phrase(none) --> [].
performgender_phrase(Gender) --> [get, done, like, 'they\'re'], gender_phrase(Gender).

% Render isGender and PerformGender within parentheses.
group_info_phrase(none, none) --> [].
group_info_phrase(IsGender, none) --> 
  { dif(IsGender, none) },
  ['(', who], isgender_phrase(IsGender), [')'].
group_info_phrase(none, PerformGender) --> 
  { dif(PerformGender, none) },
  ['(', who], performgender_phrase(PerformGender), [')'].
group_info_phrase(IsGender, PerformGender) --> 
  { dif(IsGender, none), dif(PerformGender, none) },
  ['(', who], isgender_phrase(IsGender), ['and'], performgender_phrase(PerformGender), [')'].

% Relate group and string representation
% ?- group_string(group(male, none, none, group(female, none, none, group(male, none, none, group(male)))), S).
% S = 'boys who like girls who like boys who like boys'
group_string(group(Gender, IsGender, PerformGender, Group), String) :-
  phrase(group_sentence(group(Gender, IsGender, PerformGender, Group)), Tokens),
  atomic_list_concat(Tokens, ' ', String).

% Relate group and depth
%   - group(G0, IG, PG, none) has depth 0
%   - group(G0, IG, PG, group(...)) has depth 1
group_depth(group(Gender, IsGender, PerformGender, none), 0) :-
  group(Gender, IsGender, PerformGender, none).
group_depth(group(Gender, IsGender, PerformGender, Group), Depth) :-
  Depth #> 0,
  group(Gender, IsGender, PerformGender, none),
  Depth0 #= Depth - 1,
  group_depth(Group, Depth0).

% Relate group and all integers larger than its depth.
group_maxdepth(Group, MaxDepth) :-
  MaxDepth #>= Depth,
  Depth #>= 0,
  group_depth(Group, Depth).