:- use_module(library(lists)).
:- use_module(library(timeout)).
:- use_module(library(random)).
:- use_module(library(clpfd)).
:- use_module(library(fdbg)).



% SEARCH TREE
%-----------------------------------------
search_tree :-
	X1 in 1..3,
	X2 in 1..3,
	X3 in 1..3,
	X1   #\= X2  , X1   #\= X3  , X2   #\= X3  ,
	X1   #\= X2+1, X1   #\= X3+2, X2+1 #\= X3+2,
	X1+2 #\= X2+1, X1+2 #\= X3  , X2+1 #\= X3  ,
	writeln(before),
	indomain(X1),
	indomain(X2),
	indomain(X3),
	writeln(sol(X1,X2,X3)),
	fail.

% ZEBRA
%-----------------------------------------
zebra :-
	Color   = [Red    ,Green   ,White   ,Yellow   ,Blue     ],
	Country = [English,Spaniard,Japanese,Italian  ,Norwegian],
	Animal  = [Dog    ,Snails  ,Fox     ,Horse    ,Zebra    ],
	Job     = [Painter,Sculptor,Diplomat,Violinist,Doctor   ],
	Drink   = [Tea    ,Coffee  ,Milk    ,Juice    ,Water    ],

	domain(Color  ,1,5),
	domain(Country,1,5),
	domain(Animal ,1,5),
	domain(Job    ,1,5),
	domain(Drink  ,1,5),

	all_distinct(Color),
	all_distinct(Country),
	all_distinct(Animal),
	all_distinct(Job),
	all_distinct(Drink),

	English = Red,			% the englishman lives in the red house
	Spaniard = Dog,			% the spaniard has a dog
	Japanese = Painter,		% the japanese is a painter
	Italian = Tea,			% the italian drinks tea
	Norwegian = 1,			% the norwegian lives in the first house on the left
	Green = Coffee,			% the owner of the gree house drinks coffee
	Green #= White + 1,		% the gree house is on the right of the white house
	Sculptor = Snails,		% the sculptor breeds snails
	Diplomat = Yellow,		% the diplomat lives in the yellow house
	Milk = 3,			% they drink milk in the middle house
	abs(Norwegian-Blue) #= 1,	% the norwegian lives next door to the blue house
	Violinist = Juice,		% the violinist drinks fruit juice
	abs(Fox-Doctor) #= 1,		% the fox is in the house next to the doctor's
	abs(Horse-Diplomat) #= 1,	% the horse is in the house next to the diplomat's

	labeling([leftmost,up],Color),
	labeling([leftmost,up],Country),
	labeling([leftmost,up],Animal),
	labeling([leftmost,up],Job),
	labeling([leftmost,up],Drink),

	writeln(sol(zebra(Zebra),water(Water))),
	fail.

% MAXIMUM
%-----------------------------------------
try_maximum :-
	M in 0..9,
	X in 1..2,
	Y in 2..3,
	Z in 1..4,
	maximum([X,Y,Z],M),
	labeling([leftmost,up],[X,Y,Z,M]),
	writeln(maximum([X,Y,Z],M)),
	fail.

maximum(List_vars,Max_var) :-
	build_max_term(List_vars,Term),
	call(Max_var #= Term).

build_max_term([Var],Var) :- !.
build_max_term([Var|Rest],max(Var,S)) :-
	build_max_term(Rest,S).


% PERT
%-----------------------------------------
pert :-
	Duration1 = 2,
	Duration2 = 1,
	Duration3 = 4,
	Duration4 = 2,
	Duration5 = 3,
	Duration6 = 1,
	Duration7 = 0,
	Total is Duration1+Duration2+Duration3+Duration4+Duration5+Duration6+Duration7,
	L = [Start1,Start2,Start3,Start4,Start5,Start6,Start7],
	domain(L,0,Total),
	Start1+Duration1 #=< Start2,
	Start1+Duration1 #=< Start3,
	Start1+Duration1 #=< Start4,
	Start2+Duration2 #=< Start5,
	Start3+Duration3 #=< Start6,
	Start4+Duration4 #=< Start5,
	Start5+Duration5 #=< Start7,
	Start6+Duration6 #=< Start7,
	fd_min(Start7,Earliest_end),
	writeln(earliest_end(Earliest_end)),
	Start7 = Earliest_end,
	writeln_vars(L).


% NQUEEN
%-----------------------------------------
queen(N) :-
	length(L,N),
	domain(L,1,N),
	build_queens_pos(L,1,P),
	ctr_queens(P),
	labeling([leftmost,up],L),
	writeln(sol(L)).

build_queens_pos([],_,[]).
build_queens_pos([V|R],I,[t(V,I)|S]) :-
	I1 is I+1,
	build_queens_pos(R,I1,S).

ctr_queens([_]).
ctr_queens([Q1,Q2|R]) :-
	ctr_queen([Q2|R],Q1),
	ctr_queens([Q2|R]).

ctr_queen([],_).
ctr_queen([t(Q2,I2)|R],t(Q1,I1)) :-
	Q2    #\= Q1,
	Q2-Q1 #\= I2-I1,
	Q2-Q1 #\= I1-I2,
	ctr_queen(R,t(Q1,I1)).

% ALIGNING STRINGS
%-----------------------------------------
% solution found corresponds to:
% 
%      301 230 30
%   20 301 2301
% 01201 0132 013
align_strings :-
	S1 = [0,1,2,0,1,0,1,3,2,0,1,3],
	S2 = [2,0,3,0,1,2,3,0,1],
	S3 = [3,0,1,2,3,0,3,0],
	length(S1,N1),
	length(S2,N2),
	length(S3,N3),
	length(L1,N1),
	length(L2,N2),
	length(L3,N3),
	M is N1+N2+N3,
	domain(L1,1,M),
	domain(L2,1,M),
	domain(L3,1,M),
	set_prec(L1),
	set_prec(L2),
	set_prec(L3),
	build_term_s(S1,L1,T1),
	build_term_s(S2,L2,T2),
	build_term_s(S3,L3,T3),
	differ_s(T1,T2),
	differ_s(T1,T3),
	differ_s(T2,T3),
	append(L1,L2,L12),
	append(L12,L3,L123),
	End in 1..M,
	maximum(L123,End),
	labeling([min,up,minimize(End)],L123),
	writeln(end(End)),
	writeln(s1(L1)),
	writeln(s2(L2)),
	writeln(s3(L3)).

set_prec([_]).
set_prec([V1,V2|R]) :-
	V1 #< V2,
	set_prec([V2|R]).

build_term_s([],[],[]).
build_term_s([S|Rs],[L|Rl],[t(S,L)|Rt]) :-
	build_term_s(Rs,Rl,Rt).

differ_s([],_).
differ_s([T|R],L) :-
	differs(L,T),
	differ_s(R,L).

differs([],_).
differs([t(I,V)|R],t(I,W)) :-
	!,
	differs(R,t(I,W)).
differs([t(I,V)|R],t(J,W)) :-
	V #\= W,
	differs(R,t(J,W)).

% QUEEN CENTER
%-----------------------------------------
queen_center(N) :-
	length(L,N),
	domain(L,1,N),
	build_queens_center_pos(L,1,P),
	ctr_queens_center(P),
	order_center(L,Lcenter),
	create_values(1,N,V),
	order_center(V,Vcenter),
%	label_center(Lcenter,Vcenter),
	labeling([ff,value(my_member(Vcenter))],Lcenter),
	writeln(sol(L)).

my_member(Vcenter,V,_,L,L) :-
	member(V,Vcenter).

label_center([],_).
label_center([V|R],Values) :-
	member(V,Values),
	label_center(R,Values).

create_values(N,N,[N]) :-
	!.
create_values(I,N,[I|R]) :-
	I < N,
	I1 is I+1,
	create_values(I1,N,R).

order_center(L,Lcenter) :-
	length(L,N),
	N1 is N // 2,
	N2 is N mod 2,
	remove_nfirst(N1,L,First1,After1),
	remove_nfirst(N2,After1,First2,After2),
	reverse(First1,Rfirst1),
	merge(Rfirst1,After2,RA),
	append(First2,RA,Lcenter).

remove_nfirst(0,L,[],L).
remove_nfirst(I,[V|R],[V|S],L) :-
	I > 0,
	I1 is I-1,
	remove_nfirst(I1,R,S,L).

merge([],[],[]).
merge([X|R],[Y|S],[X,Y|T]) :-
	merge(R,S,T).

build_queens_center_pos([],_,[]).
build_queens_center_pos([V|R],I,[t(V,I)|S]) :-
	I1 is I+1,
	build_queens_center_pos(R,I1,S).

ctr_queens_center([_]).
ctr_queens_center([Q1,Q2|R]) :-
	ctr_queen_center([Q2|R],Q1),
	ctr_queens_center([Q2|R]).

ctr_queen_center([],_).
ctr_queen_center([t(Q2,I2)|R],t(Q1,I1)) :-
	Q2    #\= Q1,
	Q2-Q1 #\= I2-I1,
	Q2-Q1 #\= I1-I2,
	ctr_queen_center(R,t(Q1,I1)).

% DISJUNCTION
%-----------------------------------------
disjunction :-
	Duration1 = 2,
	Duration2 = 1,
	Duration3 = 4,
	Duration4 = 2,
	Duration5 = 3,
	Duration6 = 1,
	Duration7 = 0,
	Total is Duration1+Duration2+Duration3+Duration4+Duration5+Duration6+Duration7,
	L = [Start1,Start2,Start3,Start4,Start5,Start6,Start7],
	domain(L,0,Total),
	Start1+Duration1 #=< Start2,
	Start1+Duration1 #=< Start3,
	Start1+Duration1 #=< Start4,
	Start2+Duration2 #=< Start5,
	Start3+Duration3 #=< Start6,
	Start4+Duration4 #=< Start5,
	Start5+Duration5 #=< Start7,
	Start6+Duration6 #=< Start7,
	order_disjunction(Start2,Duration2,Start3,Duration3),
	order_disjunction(Start5,Duration5,Start6,Duration6),
	fd_min(Start7,Earliest_end),
	writeln(earliest_end(Earliest_end)),
	Start7 = Earliest_end,
	writeln_vars(L),
	fail.

order_disjunction(S1,D1,S2,D2) :-
	S1 + D1 #=< S2.
order_disjunction(S1,D1,S2,D2) :-
	S2 + D2 #=< S1.

% POINT18
%-----------------------------------------
point18(N) :-
	length(L,N),
	M is 2*2*2*2*3*3*5*7*11*13*17,
	domain(L,1,M),
	point18(L,1,M,[0,M]),
	once(labeling([leftmost,up],L)),
	writeln(sol(L)).

point18([],_,_,_).
point18([V|R],N,M,L) :-
	insert(V,[],L,Lnew),
	D is M // N,
	Lnew = [_|Rnew],
	restrict(Rnew,1,D),
	N1 is N+1,
	point18(R,N1,M,Lnew).

insert(X,Lprev,[Y1,Y2|R],Lnew) :-
	Y1 #< X,
	X #< Y2,
	append(Lprev,[Y1,X,Y2|R],Lnew).
insert(X,Lprev,[Y1,Y2|R],Lnew) :-
	append(Lprev,[Y1],Lnewprev),
	insert(X,Lnewprev,[Y2|R],Lnew).

restrict([_],_,_) :- !.
restrict([X|R],Low,Inc) :-
	X #>= Low,
	Up is Low+Inc,
	X #< Up,
	restrict(R,Up,Inc).

% EARTH_MARS
%-----------------------------------------

earth_mars(MaxColor) :-
	L = [C1,C2,C3,C4,C5,C6,C7,C8,C9,C10,C11],
	domain(L,1,11),
	not_same_color(C1 ,[C10,C11, C2,C5,C6,C7,C8,C9]),
	not_same_color(C2 ,[C3,C9,C10,C6, C1,C7,C11,C8]),
	not_same_color(C3 ,[C2,C6,C7,C9, C8,C11,C10,C4]),
	not_same_color(C4 ,[C7,C6,C5,C8, C9,C3,C10,C11]),
	not_same_color(C5 ,[C6,C10,C8,C4, C9,C11,C7,C1]),
	not_same_color(C6 ,[C11,C5,C4,C7,C3,C2,C10, C9,C1,C8]),
	not_same_color(C7 ,[C6,C4,C8,C10,C9,C3, C5,C11,C2,C1]),
	not_same_color(C8 ,[C7,C4,C5,C10, C9,C6,C1,C2,C11,C3]),
	not_same_color(C9 ,[C2,C3,C7,C10, C4,C11,C5,C1,C6,C8]),
	not_same_color(C10,[C1,C6,C2,C9,C7,C8,C5, C11,C4,C3]),
	not_same_color(C11,[C6,C1, C9,C4,C10,C3,C8,C2,C7,C5]),
	M in 1..MaxColor,
	maximum(L,M),
%	labeling([leftmost,up],L),
	label_sym(L,1),
	writeln(sol(L)).

label_sym([],_).
label_sym([V|R],C) :-
writeln(1),
	V #< C,
	indomain(V),
	label_sym(R,C).
label_sym([V|R],C) :-
writeln(2),
	V = C,
	C1 is C+1,
	label_sym(R,C1).

not_same_color(V,[]).
not_same_color(V,[U|R]) :-
	V #\= U,
	not_same_color(V,R).

% NQUEEN ALLDIFFERENT
%-----------------------------------------
queen_alldiff(N) :-
	length(L,N),
	domain(L,1,N),
	build_auxiliary_vars(L,1,L1),
	reverse(L,Lr),
	build_auxiliary_vars(Lr,1,L2),
	all_distinct(L),
	all_distinct(L1),
	all_distinct(L2),
	labeling([leftmost,up],L),
	writeln(sol(L)).

build_auxiliary_vars([],_,[]).
build_auxiliary_vars([V|R],C,[U|S]) :-
	U #= V+C,
	C1 is C+1,
	build_auxiliary_vars(R,C1,S).

% MAGIC HEXAGON
%-----------------------------------------
magic_hexagon :-
	L = [V1,V2,V3,V4,V5,V6,V7,V8,V9,V10,V11,V12,V13,V14,V15,V16,V17,V18,V19],
	domain(L,1,19),
	all_distinct(L),
	Min is 1+2+3,
	Max is 19+18+17+16+15,
	Cst in Min..Max,
	Cst = 38,

	V8+V19+V18 #= Cst,
	V9+V7+V6+V17 #= Cst,
	V10+V2+V1+V5+V16 #= Cst,
	V11+V3+V4+V15 #= Cst,
	V12+V13+V14 #= Cst,

	V12+V11+V10 #= Cst,
	V13+V3+V2+V9 #= Cst,
	V14+V4+V1+V7+V8 #= Cst,
	V15+V5+V6+V19 #= Cst,
	V16+V17+V18 #= Cst,

	V16+V15+V14 #= Cst,
	V17+V5+V4+V13 #= Cst,
	V18+V6+V1+V3+V12 #= Cst,
	V19+V7+V2+V11 #= Cst,
	V8+V9+V10 #= Cst,

	labeling([ffc,bisect],L),
	writeln(cst_sol(Cst,L)),
	fail.

% RAMANUJAN
%-----------------------------------------
ramanujan :-
	build_cube_table(1,100,Cubes),
	X in 1..10000000,
	Y1 in 1..100, Y1_3 in 1..10000000,
	Y2 in 1..100, Y2_3 in 1..10000000,
	Z1 in 1..100, Z1_3 in 1..10000000,
	Z2 in 1..100, Z2_3 in 1..10000000,
	element(Y1,Cubes,Y1_3),
	element(Y2,Cubes,Y2_3),
	element(Z1,Cubes,Z1_3),
	element(Z2,Cubes,Z2_3),
	Y1 #< Y2,
	Z1 #< Z2,
	Y1 #< Z1,
	X #= Y1_3 + Y2_3,
	X #= Z1_3 + Z2_3,
	labeling([minimize(X)],[Y1,Y2,Z1,Z2]),
	writeln(sol(x(X),y(Y1,Y2),z(Z1,Z2))).
	
build_cube_table(I,Sup,[]) :-
	I > Sup.
build_cube_table(I,Sup,[J|R]) :-
	I =< Sup,
	J is I*I*I,
	I1 is I+1,
	build_cube_table(I1,Sup,R).

% ASSIGNMENT
%-----------------------------------------
assignment :-
	domain([P1,P2,P3],1,3),
	all_distinct([P1,P2,P3]),
	domain([C1,C2,C3],0,9),
	element(P1,[9,4,2],C1),
	element(P2,[1,0,6],C2),
	element(P3,[8,8,4],C3),
	MaxC is 9*3,
	C in 0..MaxC,
	C #= C1+C2+C3,
	labeling([],[P1,P2,P3]),
	writeln(sol(c(C),p(P1,P2,P3),c(C1,C2,C3))),
	fail.

% MAGIC SERIES
%-------------
magic(N) :-
	N1 is N + 1,
	length(L,N1),
	domain(L,0,N1),
	gen_val_occ(L,0,V_O),
	global_cardinality(L,V_O),
	labeling([],L),
	writeln(sol(L)),
	fail.

gen_val_occ([],_,[]).
gen_val_occ([V|R],I,[I-V|S]) :-
	I1 is I+1,
	gen_val_occ(R,I1,S).


% RELAXED ALLDIFFERENT
%---------------------
relaxe_alldiff(L) :-
	get_max_value(L,Max),
	gen_vocc(1,Max,Locc),
	length(L,N),
	V in 0..N,
	append([0-V],Locc,Locc0),
	writeln(Locc0),
	global_cardinality(L,Locc0).

get_max_value([V],Max) :-
	!,
	fd_max(V,Max).
get_max_value([V|R],Max) :-
	fd_max(V,Vmax),
	get_max_value(R,Rmax),
	Max is max(Vmax,Rmax).

gen_vocc(I,Sup,[]) :-
	I > Sup.
gen_vocc(I,Sup,[I-B|R]) :-
	I>0,
	I=<Sup,
	B in 0..1,
	I1 is I+1,
	gen_vocc(I1,Sup,R).

try_relax :-
	length(L,3),
	domain(L,0,3),
	relaxe_alldiff(L),
	labeling([],L),
	writeln(sol(L)),
	fail.

% PROJECT SCHEDULING
%-------------------
project :-
	Duration1 = 2,
	Duration2 = 1,
	Duration3 = 4,
	Duration4 = 2,
	Duration5 = 3,
	Duration6 = 1,
	Duration7 = 0,
	Total is Duration1+Duration2+Duration3+Duration4+Duration5+Duration6+Duration7,
	L = [Start1,Start2,Start3,Start4,Start5,Start6,Start7],
	domain(L,0,Total),
	Start1+Duration1 #=< Start2,
	Start1+Duration1 #=< Start3,
	Start1+Duration1 #=< Start4,
	Start2+Duration2 #=< Start5,
	Start3+Duration3 #=< Start6,
	Start4+Duration4 #=< Start5,
	Start5+Duration5 #=< Start7,
	Start6+Duration6 #=< Start7,
	Resource1 = 1,
	Resource2 = 3,
	Resource3 = 3,
	Resource4 = 2,
	Resource5 = 4,
	Resource6 = 6,
	cumulative([Start1   ,Start2   ,Start3   ,Start4   ,Start5   ,Start6   ],
	           [Duration1,Duration2,Duration3,Duration4,Duration5,Duration6],
	           [Resource1,Resource2,Resource3,Resource4,Resource5,Resource6],
	           7),
	labeling([minimize(Start7)],L),
	writeln(sol(Start7,L)).

% PROJECT SCHEDULING (LOAD)
%--------------------------
load :-
	set_prod(Duration1,Resource1, 1),
	set_prod(Duration2,Resource2, 3),
	set_prod(Duration3,Resource3,12),
	set_prod(Duration4,Resource4, 4),
	set_prod(Duration5,Resource5,12),
	set_prod(Duration6,Resource6, 6),
	Duration7 = 0,
	Total is 100000,
	L = [Start1,Start2,Start3,Start4,Start5,Start6,Start7],
	domain(L,0,Total),
	Start1+Duration1 #=< Start2,
	Start1+Duration1 #=< Start3,
	Start1+Duration1 #=< Start4,
	Start2+Duration2 #=< Start5,
	Start3+Duration3 #=< Start6,
	Start4+Duration4 #=< Start5,
	Start5+Duration5 #=< Start7,
	Start6+Duration6 #=< Start7,
	cumulative([Start1   ,Start2   ,Start3   ,Start4   ,Start5   ,Start6   ],
	           [Duration1,Duration2,Duration3,Duration4,Duration5,Duration6],
	           [Resource1,Resource2,Resource3,Resource4,Resource5,Resource6],
	           7),
	labeling([minimize(Start7)],L),
	writeln(sol(Start7,L)).

set_prod(X,Y,P) :-
	X in 0..P,
	Y in 0..P,
	X*Y #= P.

% PERFECT SQUARE
%---------------
square :-
	Size = 112,
	End is Size+1,
	S = [50,42,37,35,33,29,27,25,24,19,18,17,16,15,11,9,8,7,6,4,2],
	length(S,N),
	length(L,N),
	domain(L,1,Size),
	gen_prece(L,S,End),
	cumulative(L,S,S,Size,[edge_finder(true)]),
	label_min(L),
	writeln(sol(L)).

gen_prece([],[],_).
gen_prece([V|R],[S|T],End) :-
	V+S #=< End,
	gen_prece(R,T,End).

label_min([]).
label_min([V|R]) :-
	fd_min(V,Vmin),
	find_min(R,Vmin,Min),
	fix_min([V|R],Min,NewRest),
	label_min(NewRest).

find_min([],Min,Min).
find_min([V|R],PrevMin,Min) :-
	fd_min(V,Vmin),
	find_min(R,PrevMin,Rmin),
	Min is min(Vmin,Rmin).

fix_min([V|R],V,R).
fix_min([V|R],Min,[V|S]) :-
	V #> Min,
	fix_min(R,Min,S).

% SNAKE
%---------------
snake(0,_,_).
snake(N,Prev,Term) :-
	N > 0,
	arg(Prev,Term,Succ),
	indomain(Succ),
	N1 is N-1,
	snake(N1,Succ,Term).

try_snake :-
	N is 3,
	length(L,N),
	domain(L,1,N),
	circuit(L),
	append([t],L,Lt),
	T =.. Lt,
	snake(N,1,T),
	writeln(sol(L)),
	fail.

%---------------
writeln_vars([]).
writeln_vars([V|R]) :-
	writeln_var(V),
	writeln_vars(R).

writeln_var(V) :-
        fd_dom(V,D),
        writeln(D).

writeln(L) :-
        write(L),
        nl.




























teste :-
	A in 2..3,
	B in 1..2,
	C in 2..3,
	X in 1..2,
	Y in 1..3,
	Z in 1..2,
	U in 1..3,
	V in 1..3,
	W in 1..3,
	sorting([A,B,C],[U,V,W],[X,Y,Z]),
	writeln_var(A),
	writeln_var(B),
	writeln_var(C),
	writeln_var(X),
	writeln_var(Y),
	writeln_var(Z),
	labeling([leftmost,up],[A,B,C]),
	writeln(sol([A,B,C],[X,Y,Z])),
	fail.

t :-
	t1,
	t2,
	t3,
	t4.

% if L=U then global cardinality according to values in L
% 7,4 and 2 should occur at least one time
% removes values 0135689 (keep 2,4,7)
t1 :-
	X1 in 0..9,
	X2 in 0..9,
	X3 in 0..9,
	L = [2,4,7],
	U = [2,4,7],
	X = [X1,X2,X3],
	tt(X,L,U).

% global cardinality of higher common part of values in L and U
% and at least one variable take a value between the two next occ.
% and no value between largest value of first not common part and smallest value after

% 7 and 4 should occur at least one time
% at least one value between 1 and 2
% no value in 5..6
% removes values 035689 (keep 1..2,4,7)
t2 :-
	X1 in 0..9,
	X2 in 0..9,
	X3 in 0..9,
	L = [1,4,7],
	U = [2,4,7],
	X = [X1,X2,X3],
	tt(X,L,U).

% 7 should occur at least 2 times
% at least one value between 1 and 2
% no value in 3..6
% removes values 0345689 (keep 1..2,7)
t2_1 :-
	X1 in 0..9,
	X2 in 0..9,
	X3 in 0..9,
	L = [1,7,7],
	U = [2,7,7],
	X = [X1,X2,X3],
	tt(X,L,U).

% 7 should occur at least 1 time
% 4 should occur at least 1 time
% at least one value between 0..2
% no value in 3..3
% removes values 35689 (keep 0..2,4,7)
t3 :-
	X1 in 0..9,
	X2 in 0..9,
	X3 in 0..9,
	L = [0,4,7],
	U = [2,4,7],
	X = [X1,X2,X3],
	tt(X,L,U).

% 7 should occur at least 1 time
% at least one value between 3..4
% no value in 5..6
% removes value 5689 (keep 0..4,7)
t4 :-
	X1 in 0..9,
	X2 in 0..9,
	X3 in 0..9,
	L = [1,3,7],
	U = [2,4,7],
	X = [X1,X2,X3],
	tt(X,L,U).

% remove 689
t4_1 :-
	X1 in 0..9,
	X2 in 0..9,
	X3 in 0..9,
	L = [1,3,7],
	U = [2,5,7],
	X = [X1,X2,X3],
	tt(X,L,U).

% remove 0689  (why 0?) perhaps because next(3,7)=(7,7) which is bigger than (5,7)
t4_2 :-
	X1 in 0..9,
	X2 in 0..9,
	X3 in 0..9,
	X1 #\= 5, X1 #\= 4,
	X2 #\= 5, X2 #\= 4,
	X3 #\= 5, X3 #\= 4,
	L = [1,3,7],
	U = [2,5,7],
	X = [X1,X2,X3],
	tt(X,L,U).

% only remove 689 (and not 0!) perhaps because next(3,7)=(5,5) which is smaller than (7,7)
t4_3 :-
	X1 in 0..9,
	X2 in 0..9,
	X3 in 0..9,
	X1 #\= 3, X1 #\= 4,
	X2 #\= 3, X2 #\= 4,
	X3 #\= 3, X3 #\= 4,
	L = [1,3,7],
	U = [2,5,7],
	X = [X1,X2,X3],
	tt(X,L,U).

% remove 0689
t4_4 :-
	X1 in 0..9,
	X2 in 0..9,
	X3 in 0..9,
	X1 #\= 2, X1 #\= 4, X1 #\= 5,
	X2 #\= 2, X2 #\= 4, X2 #\= 5,
	X3 #\= 2, X3 #\= 4, X3 #\= 5,
	L = [1,3,7],
	U = [2,5,7],
	X = [X1,X2,X3],
	tt(X,L,U).

% at least one value between 7..8
% remove value 9
t5 :-
	X1 in 0..9,
	X2 in 0..9,
	X3 in 0..9,
	L = [1,3,7],
	U = [2,4,8],
	X = [X1,X2,X3],
	tt(X,L,U).

% special case: next(7,7,7)=(0,0,8)
% remove value 1234569 (keep 0,7,8)
% next(7,7) > 0,8
% <7 inter >0 = 123456
t6 :-
	X1 in 0..9,
	X2 in 0..9,
	X3 in 0..9,
	L = [7,7,7],
	U = [0,0,8],
	X = [X1,X2,X3],
	tt(X,L,U).

% remove 234569 (keep 0..1,7..8)
% next(7,7) > 2,8
% <7 inter > 1 = 2,3,4,5,6
t7 :-
	X1 in 0..9,
	X2 in 0..9,
	X3 in 0..9,
	L = [7,7,7],
	U = [0,1,8],
	X = [X1,X2,X3],
	tt(X,L,U).

% remove 239 (keep 0..1,4..8)
% next(7,7) > 1,8
% <4 inter >1 = 23
t8 :-
	X1 in 0..9,
	X2 in 0..9,
	X3 in 0..9,
	L = [4,7,7],
	U = [0,1,8],
	X = [X1,X2,X3],
	tt(X,L,U).

% remove 2349 (keep 0..1,5..8)
% next(7,7) > 2,8
% <5 inter >1 ? 234
t9 :-
	X1 in 0..9,
	X2 in 0..9,
	X3 in 0..9,
	L = [5,7,7],
	U = [0,1,8],
	X = [X1,X2,X3],
	tt(X,L,U).

% remove 9
t10 :-
	X1 in 0..9,
	X2 in 0..9,
	X3 in 0..9,
	L = [5,6,7],
	U = [0,1,8],
	X = [X1,X2,X3],
	tt(X,L,U).


% remove 349 (keep 0..2,5..8)
% 34 = <5 inter >2
% next(7,7) > 2,8
t11 :-
	X1 in 0..9,
	X2 in 0..9,
	X3 in 0..9,
	L = [5,7,7],
	U = [0,2,8],
	X = [X1,X2,X3],
	tt(X,L,U).

% remove 9
% <0 inter > 2 = empty
% next(7,7) > 2,8
t12 :-
	X1 in 0..9,
	X2 in 0..9,
	X3 in 0..9,
	L = [0,7,7],
	U = [1,2,8],
	X = [X1,X2,X3],
	tt(X,L,U).

% remove 9
% <3 inter > 5 = vide
% next(7,7) > 2,8
t13 :-
	X1 in 0..9,
	X2 in 0..9,
	X3 in 0..9,
	L = [3,7,7],
	U = [1,5,8],
	X = [X1,X2,X3],
	tt(X,L,U).

% remove 9
t14 :-
	X1 in 0..9,
	X2 in 0..9,
	X3 in 0..9,
	L = [5,2,7],
	U = [0,2,8],
	X = [X1,X2,X3],
	tt(X,L,U).

% remove 9
t15 :-
	X1 in 0..9,
	X2 in 0..9,
	X3 in 0..9,
	L = [1,5,7],
	U = [3,5,8],
	X = [X1,X2,X3],
	tt(X,L,U).

% remove 04679 keep 1,2,3,5,8
t16 :-
	X1 in 0..9,
	X2 in 0..9,
	X3 in 0..9,
	X4 in 0..9,
	L = [1,5,8,8],
	U = [3,5,8,8],
	X = [X1,X2,X3,X4],
	tt(X,L,U).

% remove 679
t17 :-
	X1 in 0..9,
	X2 in 0..9,
	X3 in 0..9,
	X4 in 0..9,
	L = [1,4,8,8],
	U = [3,5,8,8],
	X = [X1,X2,X3,X4],
	tt(X,L,U).

t19 :-
	X1 in 0..9,
	X2 in 0..9,
	X3 in 0..9,
	X4 in 0..9,
	L = [3,7,7,7],
	U = [1,1,1,8],
	X = [X1,X2,X3,X4],
	tt(X,L,U).


% remove 569
t18 :-
	X1 in 0..9,
	X2 in 0..9,
	X3 in 0..9,
	X1 #\= 7,
	X2 #\= 7,
	X3 #\= 7,
	L = [7,4,3],
	U = [8,4,1],
	X = [X1,X2,X3],
	mul_chain([L,X]),
	mul_chain([X,U]),
	labeling([leftmost,up],X),
	writeln(sol(X)),
	fail.


% remove 569
t20 :-
	X1 in 0..9,
	X2 in 0..9,
	X3 in 0..9,
	X4 in 0..9,
	X1 #\= 7,
	X2 #\= 7,
	X3 #\= 7,
	X4 #\= 7,
	X1 #=<X2,
	X2 #=<X3,
	X3 #=<X4,
	L = [7,4,3,0],
	U = [8,4,1,1],
	X = [X1,X2,X3,X4],
	mul_chain([L,X]),
	mul_chain([X,U]),
	labeling([leftmost,up],X),
	writeln(sol(X)),
	fail.

% remove 569
t21 :-
	X1 in 0..9,
	X2 in 0..9,
	X3 in 0..9,
	X4 in 0..9,
	X1 #\= 7,
	X2 #\= 7,
	X3 #\= 7,
	X4 #\= 7,
	X1 #=<X2,
	X2 #=<X3,
	X3 #=<X4,
	L = [7,3,3,0],
	U = [8,4,1,1],
	X = [X1,X2,X3,X4],
	mul_chain([L,X]),
	mul_chain([X,U]),
	labeling([leftmost,up],X),
	writeln(sol(X)),
	fail.

% remove 569
t22 :-
	X1 in 0..9,
	X2 in 0..9,
	X3 in 0..9,
	X4 in 0..9,
	X1 #\= 7,
	X2 #\= 7,
	X3 #\= 7,
	X4 #\= 7,
	X1 #=<X2,
	X2 #=<X3,
	X3 #=<X4,
	L = [7,5,3,0],
	U = [8,4,1,1],
	X = [X1,X2,X3,X4],
	mul_chain([L,X]),
	mul_chain([X,U]),
	labeling([leftmost,up],X),
	writeln(sol(X)),
	fail.

% remove 234569
t23 :-
	X1 in 0..9,
	X2 in 0..9,
	X3 in 0..9,
	X4 in 0..9,
	X1 #\= 7,
	X2 #\= 7,
	X3 #\= 7,
	X4 #\= 7,
	X1 #=<X2,
	X2 #=<X3,
	X3 #=<X4,
	L = [7,5,3,0],
	U = [8,1,1,1],
	X = [X1,X2,X3,X4],
	mul_chain([L,X]),
	mul_chain([X,U]),
	labeling([leftmost,up],X),
	writeln(sol(X)),
	fail.


tt(X,L,U) :-
	nl,
	writeln(tEST),
	writeln(lower(L)),
	writeln(upper(U)),
	writeln_vars(X),
	check(X,1,X,L,U).

check([],_,_,_,_).
check([V|R],I,X,L,U) :-
	nl,
	write(var(I)),
	checkv(V,I,X,L,U),
	I1 is I+1,
	check(R,I1,X,L,U).

checkv(V,I,X,L,U) :-
	indomain(V),
	checki(V,I,X,L,U),
	fail.
checkv(_,_,_,_,_).

checki(V,I,X,L,U) :-
	mul_chain([L,X]),
	mul_chain([X,U]),
	once(labeling([leftmost,up],X)),
	!.
checki(V,I,X,L,U) :-
	write(V).


mul_chain([X,Y]) :-
	length(X,Lx),
	length(Px,Lx),
	length(Sx,Lx),
	domain(Px,1,Lx),
	domain(Sx,0,100000),
	length(Y,Ly),
	length(Py,Ly),
	length(Sy,Ly),
	domain(Py,1,Ly),
	domain(Sy,0,100000),
	reverse(Sx,Rx),
	reverse(Sy,Ry),
	!,
	sorting(X,Px,Sx),
	sorting(Y,Py,Sy),
	lex_chain([Rx,Ry]).



% AC/TAA/TGAC/GA[CT]CA[CT]AGA[AT]C
% .       ..   .    .      .     .
try :-
	writeln(pb(try)),
	pattern(Rexp,"AC/TAA/TGAC/GA[CT]CA[CT]AGA[AT]C",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.

try1 :-
	writeln(pb(try1)),
	pattern(Rexp1,"AC/GA[CT]C",""),
	pattern(Rexp2,"GA[AT]C",""),
	writeln(rexp1(Rexp1)),
	writeln(rexp2(Rexp2)),
	solve([Rexp1,Rexp2]).

% problems not solved: 15, 27, 52, 84 in the first set

top :-
	top1,
	top2,
	top3,
	top4,
	top5,
	top6,
	top7,
	top8,
	top9,
	top10,
	top11,
	top12,
	top13,
	top14,
	top15,
	top16,
	top17,
	top18,
	top19,
	top20,
	top21,
	top22,
	top23,
	top24,
	top25,
	top26,
	top27,
	top28,
	top29,
	top30,
	top31,
	top32,
	top33,
	top34,
	top35,
	top36,
	top37,
	top38,
	top39,
	top40,
	top41,
	top42,
	top43,
	top44,
	top45,
	top46,
	top47,
	top48,
	top49,
	top50,
	top51,
	top52,
	top53,
	top54,
	top55,
	top56,
	top57,
	top58,
	top59,
	top60,
	top61,
	top62,
	top63,
	top64,
	top65,
	top66,
	top67,
	top68,
	top69,
	top70,
	top71,
	top72,
	top73,
	top74,
	top75,
	top76,
	top77,
	top78,
	top79,
	top80,
	top81,
	top82,
	top83,
	top84,
	top85,
	top86,
	top87,
	top88,
	top89,
	top90,
	top91.

toq :-
	toq1,
	toq2,
	toq3,
	toq4,
	toq5,
	toq6,
	toq7,
	toq8,
	toq9,
	toq10,
	toq11,
	toq12,
	toq13,
	toq14,
	toq15,
	toq16,
	toq17,
	toq18.

top1 :-
	writeln(pb(x1_SL1p14_PSO44R)),
	pattern(Rexp,"GTAC/TAGTGTGTACTTTG/CTGCCTTCGAGGGGAAAGAATGATGTGTAAAATCGGTGGGTGCTGTG",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top1.

top2 :-
	writeln(pb(x2_Eu11_3_Eus11)),
	pattern(Rexp,"GAGCC/ATTAGCTACTTTTCAGAATTGAAGGAGAAAATGCATTATGTGGACTGAACCGACT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top2.

top3 :-
	writeln(pb(x3_pUC19_fiktiva_SNPar)),
	pattern(Rexp,"GTT/GGTAAAA/CCGACGGCCAGTGAATT/CCGAGCTCGGTA",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top3.

top4 :-
	writeln(pb(x4_Eu8_Eus8_fitkiva_SNPar)),
	pattern(Rexp,"CACCA/GTGGACAGC/AAGCAGCTGGGCCTGG/CCTATCAGCCCTGCCCTGGGCCA",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top4.

top5 :-
	writeln(pb(x5_BE4PN_NUSPT_fiktiva_SNPar)),
	pattern(Rexp,"C/GTAAAGGTGCACCATGACTGGGGTTACAGT/ACATC",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top5.

top6 :-
	writeln(pb(x6_BE4PN_MR035RS_fiktiva_SNPar)),
	pattern(Rexp,"GT/ACATC",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top6.

top7 :-
	writeln(pb(x7_Eu1p8_Eus8)),
	pattern(Rexp,"CACCA/GTGGACAGCAGCAGCTGGGCCTGGCTATCAGCCCTGCCCTGGGCCACTAGCAGGCCC",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top7.

top8 :-
	writeln(pb(x8_SL1p2_PSO28F)),
	pattern(Rexp,"G/ACCCTTGCCCTGCTGGCTCTGCCAGGTATCTTGTACATCAAGTGCTTTGGGTGTGAGATGCAGGCCATGCTGCCGTATGA",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top8.

top9 :-
	writeln(pb(x9_460R_PSO147)),
	pattern(Rexp,"AGCC/TAAACCTCAGAAAGCCAATCAGATGGTTTCAGAACAGCAGCC",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top9.

top10 :-
	writeln(pb(x10_468R_MR008RS)),
	pattern(Rexp,"GACAGCAAGTGA",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top10.

top11 :-
	writeln(pb(x11_Eu1p3_MR002RS)),
	pattern(Rexp,"CCCCCCGACGCAGGGAGACA/GGGCAGATCCTTGTACTGCAGGTAGTACTGTATATGGCCC",""),	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top11.

top12 :-
	writeln(pb(x12_CYP2D6A2637Del_A028_2RS)),
	pattern(Rexp,"TCC[T]GTGCTCAG",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top12.

top13 :-
	writeln(pb(x13_SL1p15_PSO40R)),
	pattern(Rexp,"AT/GGAATGAA/C/G/TCGGTACAGATTTTCCTGTA",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top13.

top14 :-
	writeln(pb(x14_AB5_PSO255FS)),
	pattern(Rexp,"TYGTAACTGCAT[C]ACAAAAATGAGCAGCTCCTAGGCACATAACAAACTA",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top14.

top15 :-
	writeln(pb(x15_Sl1p4_PSO32F)),
	pattern(Rexp,"C/GA/TGTGGACCAACCAACAAGCCCCA",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top15.

top16 :-
	writeln(pb(x16_PKCI_PSO260RS)),
	pattern(Rexp,"A[CTT]CTTCAGACAACATATATTATTCAGGTAGAAAAGAAACTTTATCTT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top16.

top17 :-
	writeln(pb(x17_PKCI_PSO260RS)),
	pattern(Rexp,"ACTT[CTT]CAGACAACATATATTATTCAGGTAGAAAAGAAACTTTATCTT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top17.

top18 :-
	writeln(pb(x18_Eu1p7_Eus7)),
	pattern(Rexp,"T/CGGCCGGGTCACGAG/TGCCCTATTTATAGCTGAGGGGTGGGGATGGAGCTGTTCCCAGGCTGCCTGTGCACAGGTGGA",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top18.

top19 :-
	writeln(pb(x19_Eu1p6_Eus6)),
	pattern(Rexp,"CTTT/CGTCAGCTTCATCATCCAGTTCCAGTTCCACGAGGCACTGTGCCAGGCAGCTGGCCA",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top19.

top20 :-
	writeln(pb(x20_BE4PNG_C_NUSPT)),
	pattern(Rexp,"CG/CAAAGGTGCACCATGACTGGGGTT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top20.

top21 :-
	writeln(pb(x21_BE4PNT_del_NUSPT)),
	pattern(Rexp,"C[T]AAAGGTGCACCATGACTGGGGTT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top21.

top22 :-
	writeln(pb(x22_BE4PNT_G_C_NUSPT)),
	pattern(Rexp,"CT/C/GAAAGGTGCACCATGACTGGGGTT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top22.

top23 :-
	writeln(pb(x23_BE4PNT_A_G_C_NUSPT)),
	pattern(Rexp,"CT/C/G/AAAAGGTGCACCATGACTGGGGTT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top23.

top24 :-
	writeln(pb(x24_Eu1p3_Eus3)),
	pattern(Rexp,"A/GGGCAGATCCTTGTACTGCAGGTAGTACTGTATATGGCCCATCTCATGGTGCACTGTGGA",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top24.

top25 :-
	writeln(pb(x25_SL1p1_PSO29F)),
	pattern(Rexp,"G/ACTAGATGGACCAGCACTTCTGCACAACACTCCTGGAGAAGAAC",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top25.

top26 :-
	writeln(pb(x26_470R_PSO157)),
	pattern(Rexp,"TC/ATCTGGTGGAGAACCAGAACTTCTGGCCTGTGGGTAGGGGCAGCTGCTTCCAAGA",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top26.

top27 :-
	writeln(pb(x27_461R_MR006RS)),
	pattern(Rexp,"GCAAGTCCAATC/TTGCAGA",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top27.

top28 :-
	writeln(pb(x28_468R_MR010RS)),
	pattern(Rexp,"CCTCCCGGGCAACAAGCAAAAG/TAAGTCC",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top28.

top29 :-
	writeln(pb(x29_PAI_A114SR)),
	pattern(Rexp,"[C]ACGTGTCCAGACTCTCTCTGTGCCCCTGAGGGCTCTCTGTGTCAACAACCTTGTCTGGCTGAGGTTG",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top29.

top30 :-
	writeln(pb(x30_SL1p11_PSO42F)),
	pattern(Rexp,"AC/TTGGGTACAAGCAATG/AATTATCGATTTAGACACAGCACCCACCGATTTTACACATCATTCTTTCCCCTCGAAGGC",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top30.

top31 :-
	writeln(pb(x31_D_loop_PSO249RS)),
	pattern(Rexp,"GRRATTTACTTAAATATTTTAACGATTGAAACAAAAATGTCAAGAT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top31.

top32 :-
	writeln(pb(x32_PKCI_PSO259RS)),
	pattern(Rexp,"ACTA[CTT]CTTCAGACAACATATATTATTCAGGTAGAAAAGAAACTTTATCTT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top32.

top33 :-
	writeln(pb(x33_PKCI_PSO259RS)),
	pattern(Rexp,"ACTACTT[CTT]CAGACAACATATATTATTCAGGTAGAAAAGAAACTTTATCTT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top33.

top34 :-
	writeln(pb(x34_SL1p5_PSO33F)),
	pattern(Rexp,"TCCC/AAAGATCCTCCTGGCAAACTTCTTGTCCCAGGTGGAGGCCTCG",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top34.

top35 :-
	writeln(pb(x35_Eu1p4_Eus4)),
	pattern(Rexp,"A/GCTGCCTGCCCAGGAGCTGGAGGAGGTGTGTGGCTCGCAAGGTACAGGGAGAGGGGAATCCTGGGGCAGT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top35.

top36 :-
	writeln(pb(x36_Eu1p4_MR004FS)),
	pattern(Rexp,"CCTAGAACGGGCAGCA/GCTGCCTGCCCAGGAGCTGGAGGAGGTGTGTGGCTCGCAAGGTACAGGGAGA",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top36.

top37 :-
	writeln(pb(x37_SL1p10_PSO36F)),
	pattern(Rexp,"CA/TAGGGACACACTACTTGGGGGCTCTGAAATCTGGAGAGACATTGATTTT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top37.

top38 :-
	writeln(pb(x38_SL1p10_MR015FS)),
	pattern(Rexp,"TGGATGCATTATTACGTGTCA/TAGGGACACACTACTTGGGGGCTCTGAAATCTGGAGAGA",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top38.

top39 :-
	writeln(pb(x39_461R_PSO148)),
	pattern(Rexp,"C/TTGCAGAGTGGCCAAATGAGCAGTCCCCACCCAGCCAAACCTCAGAAAGCCAATC",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top39.

top40 :-
	writeln(pb(x40_468R_PSO154)),
	pattern(Rexp,"G/TAAGTCCGGTTCGATAAGTAAGATTCAAGGCGCTTAGTTACTACCGCCCGAAAGGTGGAA",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top40.

top41 :-
	writeln(pb(x41_468R_MR009RS)),
	pattern(Rexp,"GGGCAACAAGCAAAAG/TAAGTCC",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top41.

top42 :-
	writeln(pb(x42_CYP2D6A2637Del_MR016RS)),
	pattern(Rexp,"CAGGTCATCC[T]GTGCTCAG",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top42.

top43 :-
	writeln(pb(x43_Eu1p3_Eus3)),
	pattern(Rexp,"A/GGGCAGATCCTTGTACTGCAGGTAGTACTGTATATGGCCCATCTCATGGTGCACTGTGGA",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top43.

top44 :-
	writeln(pb(x44_Eu1p3_Eus3_fiktiv_SNP1)),
	pattern(Rexp,"GGGC/TAGATCCTTGTACTGCAGGTAGTACTG",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top44.

top45 :-
	writeln(pb(x45_Eu1p3_Eus3_fiktiv_SNP2)),
	pattern(Rexp,"GGGCAG/TATCCTTGTACTGCAGGTAGTACTG",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top45.

top46 :-
	writeln(pb(x46_Eu1p3_Eus3_fiktiv_SNP3)),
	pattern(Rexp,"GGGCAGAT/GCCTTGTACTGCAGGTAGTACTG",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top46.

top47 :-
	writeln(pb(x47_Eu1p3_Eus3_fiktiv_SNP4)),
	pattern(Rexp,"GGGCAGATCCT/ATGTACTGCAGGTAGTACTG",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top47.

top48 :-
	writeln(pb(x48_Eu1p3_Eus3_fiktiv_SNP5)),
	pattern(Rexp,"GGGCAGATCCTTGTAC/GTGCAGGTAGTACTG",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top48.

top49 :-
	writeln(pb(x49_Eu1p3_Eus3_fiktiv_SNP6)),
	pattern(Rexp,"GGGCAGATCCTTGTACTGCAG/CGTAGTACTG",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top49.

top50 :-
	writeln(pb(x50_Eu1p8_Eus8_fiktiv_SNP1)),
	pattern(Rexp,"C/AACCGTGGACAGCAGCAGCTGGGCCTGGCT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top50.

top51 :-
	writeln(pb(x51_Eu1p8_Eus8_fiktiv_SNP2)),
	pattern(Rexp,"CACC/GGTGGACAGCAGCAGCTGGGCCTGGCT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top51.

top52 :-
	writeln(pb(x52_Eu1p8_Eus8_fiktiv_SNP3)),
	pattern(Rexp,"CACCGT/GGGACAGCAGCAGCTGGGCCTGGCT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top52.

top53 :-
	writeln(pb(x53_Eu1p8_Eus8_fiktiv_SNP4)),
	pattern(Rexp,"CACCGTGG/AACAGCAGCAGCTGGGCCTGGCT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top53.

top54 :-
	writeln(pb(x54_Eu1p8_Eus8_fiktiv_SNP5)),
	pattern(Rexp,"CACCGTGGACA/GGCAGCAGCTGGGCCTGGCT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top54.

top55 :-
	writeln(pb(x55_Eu1p8_Eus8_fiktiv_SNP6)),
	pattern(Rexp,"CACCGTGGACAGCAGC/AAGCTGGGCCTGGCT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top55.

top56 :-
	writeln(pb(x56_Eu1p8_Eus8_fiktiv_SNP7)),
	pattern(Rexp,"CACCGTGGACAGCAGCAGCTG/TGGCCTGGCT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top56.

top57 :-
	writeln(pb(x57_PSO39_40_NUSPT)),
	pattern(Rexp,"GCC/TAGCACCATGACT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top57.

top58 :-
	writeln(pb(x58_PSO41_42_NUSPT)),
	pattern(Rexp,"GCCC/TAGCACCATGACT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top58.

top59 :-
	writeln(pb(x59_PSO43_44_NUSPT)),
	pattern(Rexp,"GCCCC/TAGCACCATGACT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top59.

top60 :-
	writeln(pb(x60_PSO44_45_NUSPT)),
	pattern(Rexp,"GCCCCC/TAGCACCATGACT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top60.

top61 :-
	writeln(pb(x61_PSO53_54_NUSPT)),
	pattern(Rexp,"GCCCCC/TTTAGCACCATGACT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top61.

top62 :-
	writeln(pb(x62_BE4PNT_A_NUSPT)),
	pattern(Rexp,"CT/AAAAGGTGCACCATGACTGGGGTTACAGTCATC",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top62.

top63 :-
	writeln(pb(x63_BE4PNT_C_NUSPT)),
	pattern(Rexp,"CT/CAAAGGTGCACCATGACTGGGGTTACAGTCATC",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top63.

top64 :-
	writeln(pb(x64_BE4PNG_A_NUSPT)),
	pattern(Rexp,"CG/AAAAGGTGCACCATGACTGGGGTTACAGTCATC",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top64.

top65 :-
	writeln(pb(x65_FaktorV_PSO83)),
	pattern(Rexp,"AGGCG/AAGGAATACAGGTATTTTGTCCTTGAAGTAACCTTTCAGAAATTCT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top65.

top66 :-
	writeln(pb(x66_Prothrombin_A009RS)),
	pattern(Rexp,"GCTC/TGCTGAGAGTCACTTTTATTGGGAACCATAGTTTTAGAAACACAAAAATAATTCTTT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top66.

top67 :-
	writeln(pb(x67_468R_A160RS)),
	pattern(Rexp,"AG/TAAGTCCGGTTCGATAAGTAAGATTCAAGGCGCTTAGTTACTACCGCCCGAAAGGTGGAA",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top67.

top68 :-
	writeln(pb(x68_CYP2D6_A182FS)),
	pattern(Rexp,"CAG[T]GGGTGACCGAGGAGGCCGCCTGCCTTTGTGCCGCCTTCGCCAACCACTCCGGTGGGTGATGGGCAGAA",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top68.

top69 :-
	writeln(pb(x69_CYP2D6_A183FS)),
	pattern(Rexp,"AG/AGACGCCCCTTTCGCCCCAACGGTCTCTTGGACAAAGCCGTGAGCAACGTGATCGCCTCCCTCACCTGCGGGCGCC",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top69.

top70 :-
	writeln(pb(x70_Eu1p3_A094RS)),
	pattern(Rexp,"AGACA/GGGCAGATCCTTGTACTGCAGGTAGTACTG",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top70.

top71 :-
	writeln(pb(x71_Eu1p6_A063FS)),
	pattern(Rexp,"ACTTC/TGTCAGCTTCATCATCCAGTTCCAGTTCCACGAGGCACTGTGCCAGG",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top71.

top72 :-
	writeln(pb(x72_Eu1p10_Eus10)),
	pattern(Rexp,"T/CCCGATAGGGCTGGGCCTGACCAAAAATATACTGGGTTTCCTGTTTCCTTTTCTGATCATT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top72.

top73 :-
	writeln(pb(x73_MR025_26_NUSPT)),
	pattern(Rexp,"TC/GGGATGCTC/GGATGCAG",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top73.

top74 :-
	writeln(pb(x74_BE4PN_NUSPT_fiktiv_SNP)),
	pattern(Rexp,"C/TC/TAAAGGTGCACCATGACTGGGGTTACAGTCATC",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top74.

top75 :-
	writeln(pb(x75_Eu1p1_Eus1)),
	pattern(Rexp,"A/TGAAGATGGGGACCCGGCAGTTTGCCGGAACACCCGAGCCTGCCCACCGTGCGGCCGCG",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top75.

top76 :-
	writeln(pb(x76_Eu1p3_MR001RS)),
	pattern(Rexp,"GCAGGCAGACA/GGGCAGATCCTTGTACTGCAGGTAGTACTGTATATGGCCCATCTCATGGTGCACTGTGGA",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top76.

top77 :-
	writeln(pb(x77_Eu1p3_MR002RS)),
	pattern(Rexp,"CCCCCCGACGCAGGGAGACA/GGGCAGATCCTTGTACTGCAGGTAGTACTGTATATGGCCC",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top77.

top78 :-
	writeln(pb(x78_Eu1p4_MR003RS)),
	pattern(Rexp,"AACGGGCAGCA/GCTGCCTGCCCAGGAGCTGGAGGAGGTGTG",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top78.

top79 :-
	writeln(pb(x79_Eu1p4_MR004RS)),
	pattern(Rexp,"CCTAGAACGGGCAGCA/GCTGCCTGCCCAGGAGCTGGAGGAGGTGTGTGGCTCGCAAGGTACAGGGAGA",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top79.

top80 :-
	writeln(pb(x80_Eu1p4_MR005RS)),
	pattern(Rexp,"TCAGGACCTAGAACGGGCAGCA/GCTGCCTGCCCAGGAGCTGGAGGAGGTGTG",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top80.

top81 :-
	writeln(pb(x81_SL1p10_MR013FS)),
	pattern(Rexp,"TTACGTGTCA/TAGGGACACACTACTTGGGGGCTCTGAAA",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top81.

top82 :-
	writeln(pb(x82_SL1p10_MR014FS)),
	pattern(Rexp,"GCATTATTACGTGTCA/TAGGGACACACTACTTGGGGGCTCTGAAA",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top82.

top83 :-
	writeln(pb(x83_CYP2D6_MR017RS)),
	pattern(Rexp,"GGGCTGGGTCCCAGGTCATCC[T]GTGCTCAG",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top83.

top84 :-
	writeln(pb(x84_D_loop_PSO252RS)),
	pattern(Rexp,"TRGAYGTGTYGTTTGTTGAATGRGGGGAAGATGGAGGGGGGT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top84.

top85 :-
	writeln(pb(x85_PKCI_PSO261RS)),
	pattern(Rexp,"C[TT]TATCTTACCATGCAAAGCTTAGAAAATCTTTGAGCTTGATGTTTTT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top85.

top86 :-
	writeln(pb(x86_AB5_PSO256FS)),
	pattern(Rexp,"AT[C]ACAAAAATGAGCAGCTCCTAGGCACATAACAAACTA",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top86.

top87 :-
	writeln(pb(x87_SL1p10_PSO36F)),
	pattern(Rexp,"CA/TAGGGACACACTACTTGGGGGCTCTGAAATCTGGAGAGACATTGATTTT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top87.

top88 :-
	writeln(pb(x88_458F_PSO144)),
	pattern(Rexp,"C/TGACGACATGATCCCCGCCCAGAAGTAGGCGCCTGCCCACCTGCCACCGACTGCTGGAACCC",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top88.

top89 :-
	writeln(pb(x89_465R_PSO151)),
	pattern(Rexp,"C/TGTTCCACCTCCCTCCAAGTCCCAAGAAAGTGGGAGGCAGTGTT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top89.

top90 :-
	writeln(pb(x90_SL1p2_PSO28F)),
	pattern(Rexp,"G/ACCCTTGCCCTGCTGGCTCTGCCAGGTATCTTGTACATCAAGTGCTTTGGGTGTGAGATGCAGGCCATGCTGCCGTATGA",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top90.

top91 :-
	writeln(pb(x91_SL1p3_PSO31F)),
	pattern(Rexp,"G/ACCGCTTTGCTGCCTACTCCCAGCAGGGTGACATGAAGTCCAAT",""),
	solve([Rexp]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
top91.

toq1 :-
	writeln(pb(y1_Triplex_376_377_453)),
	pattern(Rexp1,"TCCC/TGGGAAATAATC",""),
	pattern(Rexp2,"ATC/TCAGGGGGTGCTT",""),
	pattern(Rexp3,"GCTTCAA/GTGGA",""),
	solve([Rexp1,Rexp2,Rexp3]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
toq1.

toq2 :-
	writeln(pb(y2_Eu1p4_Eu1p8)),
	pattern(Rexp1,"A/GCTGCCTGCCCAGGAGCTGG",""),
	pattern(Rexp2,"CACCA/GTGGACAGCAGCAGCT",""),
	solve([Rexp1,Rexp2]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
toq2.

toq3 :-
	writeln(pb(y3_Faktor_V_PAI)),
	pattern(Rexp1,"AGGCG/AAGGAATACAGGTA",""),
	pattern(Rexp2,"[C]ACGTGTCCAGACTCTCTC",""),
	solve([Rexp1,Rexp2]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
toq3.

toq4 :-
	writeln(pb(y4_T1795Del_G1934A)),
	pattern(Rexp1,"CAG[T]GGGTGACCGAGGAG",""),
	pattern(Rexp2,"AG/AGACGCCCCTTTCGCCC",""),
	solve([Rexp1,Rexp2]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
toq4.

toq5 :-
	writeln(pb(y5_Faktor_V_Pro_PAI)),
	pattern(Rexp1,"AGGCG/AAGGAATACAGGTA",""),
	pattern(Rexp2,"GCTC/TGCTGAGAGTCACTTT",""),
	pattern(Rexp3,"[C]ACGTGTCCAGACTCTCTC",""),
	solve([Rexp1,Rexp2,Rexp3]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
toq5.

toq6 :-
	writeln(pb(y6_461R_468R)),
	pattern(Rexp1,"T/CTGCAGAGTGGCCAAA",""),
	pattern(Rexp2,"ACG/TCGTTCACTCAATATCATT",""),
	solve([Rexp1,Rexp2]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
toq6.

toq7 :-
	writeln(pb(y7_Eu3_Eu9)),
	pattern(Rexp1,"A/GGGCAGATCCTTGTACTGCAGGTAGTACTGTATATGGCCC",""),
	pattern(Rexp2,"TGAT/CGGGAGCCAGTGTGGACAGCACCCT",""),
	solve([Rexp1,Rexp2]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
toq7.

toq8 :-
	writeln(pb(y8_461R_481R)),
	pattern(Rexp1,"T/CTGCAGAGTGGCCAAATGAGCAGTCCCCACCCAGCCAAAC",""),
	pattern(Rexp2,"ACG/TCGTTCACTCAATATCATTACACATATG",""),
	pattern(Rexp3,"",""),
	solve([Rexp1,Rexp2]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
toq8.

toq9 :-
	writeln(pb(y9_483R_489R)),
	pattern(Rexp1,"T/CAGTCTGTGACCAGGAGCCAGGCTCAGT",""),
	pattern(Rexp2,"AC/TAGGCTCTGCTTTGAGGAGCTCAGTCCAGT",""),
	solve([Rexp1,Rexp2]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
toq9.

toq10 :-
	writeln(pb(y10_Eu1p6_Eu1p11)),
	pattern(Rexp1,"ACTTC/TGTCAGCTTCATCATCCAGTTCCAGTT",""),
	pattern(Rexp2,"GAGCA/CTTAGCTACTTTTCAGAATTGAAGGAGAAAATGC",""),
	solve([Rexp1,Rexp2]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
toq10.

toq11 :-
	writeln(pb(y11_Eu1p1_Eu1p8)),
	pattern(Rexp1,"A/TGAAGATGGGGACCCGGCAGTTTGCCGGAA",""),
	pattern(Rexp2,"CACCA/GTGGACAGCAGCAGCTGGGCCTGGC",""),
	solve([Rexp1,Rexp2]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
toq11.

toq12 :-
	writeln(pb(y12_465R_466F)),
	pattern(Rexp1,"C/TGTTCCACCTCCCTCCAAGTCCCAAGAAAG",""),
	pattern(Rexp2,"AC/TAAGGTTGTCCTGCCCGGATGATCCTCAGT",""),
	solve([Rexp1,Rexp2]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
toq12.

toq13 :-
	writeln(pb(y13_Eu1p3_Eu1p8)),
	pattern(Rexp1,"A/GGGCAGATCCTTGTACTGCAGGTAGTACTGTATATGGCCC",""),
	pattern(Rexp2,"CACCA/GTGGACAGCAGCAGCTGGGCCTGGCT",""),
	solve([Rexp1,Rexp2]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
toq13.

toq14 :-
	writeln(pb(y14_Faktor_v_Pro)),
	pattern(Rexp1,"AGGCG/AAGGAATACAGGTA",""),
	pattern(Rexp2,"GCTC/TGCTGAGAGTCACTTT",""),
	solve([Rexp1,Rexp2]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
toq14.

toq15 :-
	writeln(pb(y15_Pro_PAI)),
	pattern(Rexp1,"GCTC/TGCTGAGAGTCACTTT",""),
	pattern(Rexp2,"[C]ACGTGTCCAGACTCTCTC",""),
	solve([Rexp1,Rexp2]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
toq15.

toq16 :-
	writeln(pb(y16_Faktor_V_Pro_PAI)),
	pattern(Rexp1,"AGGCG/AAGGAATACAGGTA",""),
	pattern(Rexp2,"GCTC/TGCTGAGAGTCACTTT",""),
	pattern(Rexp3,"[C]ACGTGTCCAGACTCTCTC",""),
	solve([Rexp1,Rexp2,Rexp3]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
toq16.

toq17 :-
	writeln(pb(y17_Eu1p3_Eu1p6_Eu1p10)),
	pattern(Rexp1,"AGACA/GGGCAGATCCTTGTACTGCAGGTAGTACTG",""),
	pattern(Rexp2,"ACTTC/TGTCAGCTTCATCATCCAGTTCCAGTTCCACGAGGCA",""),
	pattern(Rexp3,"T/CCCGATAGGGCTGGGCCTGACCAAAAATAT",""),
	solve([Rexp1,Rexp2,Rexp3]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
toq17.

toq18 :-
	writeln(pb(y18_Eu1p7_Eu1p8_Eu1p11)),
	pattern(Rexp1,"T/CGGCCGGGTCACGAG/TGCCCTATTTATAGCT",""),
	pattern(Rexp2,"CACCA/GTGGACAGCAGCAGCTGGGCCTGGCT",""),
	pattern(Rexp3,"GAGCC/ATTAGCTACTTTTCAGAATTGAAGG",""),
	solve([Rexp1,Rexp2,Rexp3]),
	writeln(----------------------------------------------------------------------------------------------------------),
	fail.
toq18.

% SOLVER
%---------------------------------------------------------------------------------------------------
solve(Rexps):-
%	writeln(collect_variables),
	collect_cycle_vars_in_regular_expressions(Rexps,0,Cycle_vars,Poly_vars),
%	writeln(create_domains),
	length(Cycle_vars,Ncycle_vars),
	domain(Cycle_vars,1,Ncycle_vars),
	length(Key_vars,Ncycle_vars),
	domain(Key_vars,0,4),
	!,
	create_end_ctr(Cycle_vars,Key_vars,Ncycle_vars,Key_last_significant_pos),
	create_adjacent_key_ctr(Key_vars),
	create_poly_ctr(Poly_vars,Poly_last_significant_pos),
	create_use_all_values_ctr(Cycle_vars,Ncycle_vars,Key_last_significant_pos),
%	writeln(create_adjacent_nucleotid_ctr_in_regular_expressions),
	create_adjacent_nucleotid_ctr_in_regular_expressions(Rexps,0,Key_vars,Poly_last_significant_pos),
	fd_min(Poly_last_significant_pos,Poly_last_significant_pos_min),
%	writeln(normalization_peak_ctr),
	set_normalization_peak_ctr(Rexps,Ncycle_vars),
	writeln(lower_bound(Poly_last_significant_pos_min)),
	writeln(labeling(Key_vars)),
	append(Key_vars,[Poly_last_significant_pos],Label_vars),
	minimize(labeling([leftmost,up],Label_vars),Poly_last_significant_pos),
	writeln(poly_last_significant_pos(Poly_last_significant_pos)),
	convert_solution(Key_vars,Solution),
	writeln(sol(Solution)),
	!,
	true.

% FOR EACH REGULAR EXPRESSION COLLECT CYCLE VARIABLES FROM THE OTHER REGULAR EXPRESSIONS
% AND ENFORCE THE OCCURRENCE OF AT LEAST ONE NORMALIZATION PEACK
%---------------------------------------------------------------------------------------------------
set_normalization_peak_ctr(Rexps,Ncycle_vars) :-
	get_potential_norm_peaks_in_regular_expressions(Rexps,Potential_peaks),
	collect_cycle_vars_of_each_regular_expressions(Rexps,Cycle_vars_rexps),
	collect_poly_vars_of_each_regular_expressions(Rexps,Poly_vars_rexps),
	skip_its_own_cycle_variables(Cycle_vars_rexps,[],Cycle_vars_other_rexps),
	set_peak_ctr_for_each_regular_expression(Potential_peaks,Poly_vars_rexps,Cycle_vars_other_rexps,Ncycle_vars).

set_peak_ctr_for_each_regular_expression([],_,_,_).
set_peak_ctr_for_each_regular_expression([Potential_peaks|Rpotential_peaks],
	                                 [Poly_vars_rexps|Rpoly_vars_rexps],
	                                 [Cycle_vars_other_rexps|Rcycle_vars_other_rexp],Ncycle_vars) :-
	create_tasks_peak(Potential_peaks,0,Ncycle_vars,Tasks_potential_peaks,High_tasks_potential_peaks),
	create_tasks_peak(Poly_vars_rexps,1,1,Tasks_poly_vars_rexps,H1),
	create_tasks_peak(Cycle_vars_other_rexps,1,1,Tasks_cycle_vars_other_rexps,H2),
	append(Tasks_potential_peaks,Tasks_poly_vars_rexps,Tasks1),
	append(Tasks1,Tasks_cycle_vars_other_rexps,Tasks),
	cumulatives(Tasks,[machine(1,Ncycle_vars)],[bound(upper)]),
	gen_list_val_nocc(1,Ncycle_vars,Val_occ),
	global_cardinality(High_tasks_potential_peaks,Val_occ),
	set_peak_ctr_for_each_regular_expression(Rpotential_peaks,Rpoly_vars_rexps,Rcycle_vars_other_rexp,Ncycle_vars).

gen_list_val_nocc(I,I,[I-Occ]) :-
	Occ in 1..100000.
gen_list_val_nocc(I,J,[I-Occ|R]) :-
	Occ in 0..100000,
	I1 is I+1,
	gen_list_val_nocc(I1,J,R).

create_tasks_peak([],_,_,[],[]).
create_tasks_peak([n(_,_,V)|Rest],Min_high,Max_high,[task(V,1,End,High,1)|Rest_task],[High|Rest_high]) :-
	End in 1..100000,
	High in Min_high..Max_high,
	create_tasks_peak(Rest,Min_high,Max_high,Rest_task,Rest_high).

%---------------------------------------------------------------------------------------------------
collect_poly_vars_of_each_regular_expressions([],[]).
collect_poly_vars_of_each_regular_expressions([Rexp|Rrexp],[Pexp|Prexp]) :-
	collect_poly_vars_of_a_regular_expression(Rexp,Pexp),
	collect_poly_vars_of_each_regular_expressions(Rrexp,Prexp).

collect_poly_vars_of_a_regular_expression([],[]).
collect_poly_vars_of_a_regular_expression([Term|Rterm],Result) :-
	collect_poly_vars_of_a_term(Term,Result1),
	collect_poly_vars_of_a_regular_expression(Rterm,Result2),
	append(Result1,Result2,Result).

collect_poly_vars_of_a_term([],[]).
collect_poly_vars_of_a_term(n(O,L,T),[]).
collect_poly_vars_of_a_term(id(Rexp),Rexp).
collect_poly_vars_of_a_term(or(Rexps),Result) :-
	collect_cycle_vars_of_each_regular_expressions_flat(Rexps,Result).

%---------------------------------------------------------------------------------------------------
collect_cycle_vars_of_each_regular_expressions([],[]).
collect_cycle_vars_of_each_regular_expressions([Rexp|Rrexp],[Cexp|Crexp]) :-
	collect_cycle_vars_of_a_regular_expression(Rexp,Cexp),
	collect_cycle_vars_of_each_regular_expressions(Rrexp,Crexp).

collect_cycle_vars_of_each_regular_expressions_flat([],[]).
collect_cycle_vars_of_each_regular_expressions_flat([Rexp|Rrexp],Result) :-
	collect_cycle_vars_of_a_regular_expression(Rexp,Cexp),
	collect_cycle_vars_of_each_regular_expressions_flat(Rrexp,Crexp),
	append(Cexp,Crexp,Result).

collect_cycle_vars_of_a_regular_expression([],[]).
collect_cycle_vars_of_a_regular_expression([Term|Rterm],Result) :-
	collect_cycle_vars_of_a_term(Term,Result1),
	collect_cycle_vars_of_a_regular_expression(Rterm,Result2),
	append(Result1,Result2,Result).

collect_cycle_vars_of_a_term([],[]).
collect_cycle_vars_of_a_term(n(O,L,T),[n(O,L,T)]).
collect_cycle_vars_of_a_term(id(Rexp),Result) :-
	collect_cycle_vars_of_a_regular_expression(Rexp,Result).
collect_cycle_vars_of_a_term(or(Rexps),Result) :-
	collect_cycle_vars_of_each_regular_expressions_flat(Rexps,Result).

% COMPUTE CYCLES WHICH CAN POTENTIALLY BE TAKEN HAS A NORMALIZATION PEAK:
% CYCLES WHICH CANT BE PART OF A POLYMORPHISM AND WHERE THE NUCLEOTID OCCURS LESS THAN 4 TIMES
%---------------------------------------------------------------------------------------------------
get_potential_norm_peaks_in_regular_expressions([],[]).
get_potential_norm_peaks_in_regular_expressions([Rexp|Rrexp],[Potential_peaks|Rpotential_peaks]) :-
	compute_first_possible_letters_after(Rexp,Rexp_after),
	reverse_regular_expression(Rexp,Rexp_reverse),
	compute_first_possible_letters_after(Rexp_reverse,Rexp_before1),
	reverse(Rexp_before1,Rexp_before),
	get_potential_norm_peaks_in_regular_expression(Rexp,Rexp_after,Rexp_before,Potential_peaks),
	get_potential_norm_peaks_in_regular_expressions(Rrexp,Rpotential_peaks).

get_potential_norm_peaks_in_regular_expression([],[],[],[]) :- !.
get_potential_norm_peaks_in_regular_expression([n(L,O,V)|Rterm],[A|Ra],[B|Rb],[n(L,O,V)|Rpeaks]) :-
	O =< 3,
	convert_nucleotide_to_int(L,I),
	diff(A,I),
	diff(B,I),
	!,
	get_potential_norm_peaks_in_regular_expression(Rterm,Ra,Rb,Rpeaks).
get_potential_norm_peaks_in_regular_expression([_|Rterm],[_|Ra],[_|Rb],Rpeaks) :-
	get_potential_norm_peaks_in_regular_expression(Rterm,Ra,Rb,Rpeaks).

compute_first_possible_letters_after([],[]).
compute_first_possible_letters_after([Term|Rterm],[Possible|Rpossible]) :-
	compute_first_possible_letters(Rterm,Possible),
	compute_first_possible_letters_after(Rterm,Rpossible).

compute_first_possible_letters([],[]).
compute_first_possible_letters([n(L,O,V)|_],[n(L,O,V)]).
compute_first_possible_letters([id(Rexp)|Rterm],Possible) :-
	get_first_letters_in_regular_expression(Rexp,Possible1),
	compute_first_possible_letters(Rterm,Possible2),
	append(Possible1,Possible2,Possible).
compute_first_possible_letters([or(Rexps)|_],Possible) :-
	get_first_letters_in_regular_expressions(Rexps,Possible).

reverse_regular_expressions([],[]).
reverse_regular_expressions([Rexp|Rrexp],Result) :-
	reverse_regular_expression(Rexp,Rexp_reverse),
	reverse_regular_expressions(Rrexp,Rrexp_reverse),
	append(Rrexp_reverse,[Rexp_reverse],Result).

reverse_regular_expression([],[]).
reverse_regular_expression([n(L,O,V)|Rterm],Result) :-
	reverse_regular_expression(Rterm,Rterm_reverse),
	append(Rterm_reverse,[n(L,O,V)],Result).
reverse_regular_expression([id(Rexp)|Rterm],Result) :-
	reverse_regular_expression(Rexp,Rexp_reverse),
	reverse_regular_expression(Rterm,Rterm_reverse),
	append(Rterm_reverse,[id(Rexp_reverse)],Result).
reverse_regular_expression([or(Rexps)|Rterm],Result) :-
	reverse_regular_expressions(Rexps,Rexps_reverse),
	reverse_regular_expression(Rterm,Rterm_reverse),
	append(Rterm_reverse,[or(Rexps_reverse)],Result).

diff([],_).
diff([n(L1,_,_)|R],I2) :-
	convert_nucleotide_to_int(L1,I1),
	I1 =\= I2,
	diff(R,I2).

% CREATE ADJACENT NUCLEOTID CONSTRAINTS
%---------------------------------------------------------------------------------------------------
create_adjacent_nucleotid_ctr_in_regular_expressions([],_,_,_).
create_adjacent_nucleotid_ctr_in_regular_expressions([Rexp|Rrexp],0,Key_vars,Poly_last_significant_pos) :-
%	writeln(create_adjacent_nucleotid_ctr_in_regular_expression),
%	writeln(Rexp),
	get_first_letters_in_regular_expression(Rexp,Letters),
	create_adjacent_nucleotid_ctr_between_letters([n(z,0,0)],Letters,Key_vars),
	create_adjacent_nucleotid_ctr_in_regular_expression(Rexp,0,Key_vars,Poly_last_significant_pos),
	create_adjacent_nucleotid_ctr_in_regular_expressions(Rrexp,0,Key_vars,Poly_last_significant_pos).
create_adjacent_nucleotid_ctr_in_regular_expressions([Rexp|Rrexp],Level,Key_vars,Poly_last_significant_pos) :-
	Level > 0,
	create_adjacent_nucleotid_ctr_in_regular_expression(Rexp,Level,Key_vars,Poly_last_significant_pos),
	create_adjacent_nucleotid_ctr_in_regular_expressions(Rrexp,Level,Key_vars,Poly_last_significant_pos).

create_adjacent_nucleotid_ctr_in_regular_expression([],_,_,_).
create_adjacent_nucleotid_ctr_in_regular_expression([n(_,_,_)],_,_,_).
create_adjacent_nucleotid_ctr_in_regular_expression([id(Rexp)],Level,Key_vars,Poly_last_significant_pos) :-
	Level1 is Level+1,
	create_adjacent_nucleotid_ctr_in_regular_expression(Rexp,Level1,Key_vars,Poly_last_significant_pos).
create_adjacent_nucleotid_ctr_in_regular_expression([or(Rexps)],Level,Key_vars,Poly_last_significant_pos) :-
	Level1 is Level+1,
	create_adjacent_nucleotid_ctr_in_regular_expressions(Rexps,Level1,Key_vars,Poly_last_significant_pos).
create_adjacent_nucleotid_ctr_in_regular_expression([Term1,Term2|Rterm],Level,Key_vars,Poly_last_significant_pos) :-
	create_adjacent_nucleotid_ctr_between_consecutive_terms(Term1,Term2,Level,Key_vars,Poly_last_significant_pos),
	create_adjacent_nucleotid_ctr_in_regular_expression([Term2|Rterm],Level,Key_vars,Poly_last_significant_pos).
create_adjacent_nucleotid_ctr_between_consecutive_terms(n(L1,N1,C1),n(L2,N2,C2),_,Key_vars,Poly_last_significant_pos) :-
	create_adjacent_nucleotid_ctr_between_letters([n(L1,N1,C1)],[n(L2,N2,C2)],Key_vars).
create_adjacent_nucleotid_ctr_between_consecutive_terms(n(L1,N1,C1),id(Rexp2),_,Key_vars,Poly_last_significant_pos) :-
	get_first_letters_in_regular_expression(Rexp2,Letters_rexp2),
	create_adjacent_nucleotid_ctr_between_letters([n(L1,N1,C1)],Letters_rexp2,Key_vars).
create_adjacent_nucleotid_ctr_between_consecutive_terms(id(Rexp1),n(L2,N2,C2),Level,Key_vars,Poly_last_significant_pos) :-
	get_last_letters_in_regular_expression(Rexp1,Letters_rexp1),
	create_adjacent_nucleotid_ctr_between_letters(Letters_rexp1,[n(L2,N2,C2)],Key_vars),
	Level1 is Level+1,
	create_adjacent_nucleotid_ctr_in_regular_expression(Rexp1,Level1,Key_vars,Poly_last_significant_pos).
create_adjacent_nucleotid_ctr_between_consecutive_terms(n(L1,N1,C1),or(Rexps2),_,Key_vars,Poly_last_significant_pos) :-
	get_first_letters_in_regular_expressions(Rexps2,Letters_rexps2),
	create_adjacent_nucleotid_ctr_between_letters([n(L1,N1,C1)],Letters_rexps2,Key_vars),
	create_redundant_prec_ctr(n(L1,N1,C1),Letters_rexps2,Poly_last_significant_pos).
create_adjacent_nucleotid_ctr_between_consecutive_terms(or(Rexps1),n(L2,N2,C2),Level,Key_vars,Poly_last_significant_pos) :-
	get_last_letters_in_regular_expressions(Rexps1,Letters_rexps1),
	create_adjacent_nucleotid_ctr_between_letters(Letters_rexps1,[n(L2,N2,C2)],Key_vars),
	create_redundant_prec_ctr(Letters_rexps1,n(L2,N2,C2),Poly_last_significant_pos),
	Level1 is Level+1,
	create_adjacent_nucleotid_ctr_in_regular_expressions(Rexps1,Level1,Key_vars,Poly_last_significant_pos).

create_adjacent_nucleotid_ctr_between_letters([],_,_).
create_adjacent_nucleotid_ctr_between_letters([Letter1|Rletter1],Letters2,Key_vars) :-
	create_adjacent_nucleotid_ctr_between_letters1(Letter1,Letters2,Key_vars),
	create_adjacent_nucleotid_ctr_between_letters(Rletter1,Letters2,Key_vars).

create_adjacent_nucleotid_ctr_between_letters1(_,[],_).
create_adjacent_nucleotid_ctr_between_letters1(Letter1,[Letter2|Rletter2],Key_vars) :-
	create_adjacent_nucleotid_ctr_between_letter(Letter1,Letter2,Key_vars),
	create_adjacent_nucleotid_ctr_between_letters1(Letter1,Rletter2,Key_vars).

create_adjacent_nucleotid_ctr_between_letter(n(L1,O1,V1),n(L2,O2,V2),_) :-
	L1 = L2,
	!,
%	writeln(eq(n(L1,O1,V1),n(L2,O2,V2))),
	V1 = V2.
create_adjacent_nucleotid_ctr_between_letter(n(L1,O1,V1),n(L2,O2,V2),Key_vars) :-
	convert_nucleotide_to_int(L2,I2),
%	writeln(less(n(L1,O1,V1),n(L2,O2,V2))),
	pos_after_pos_of_occ(V1,V2,Key_vars,I2).

% GET FIRST AND LAST POTENTIAL LETTERS OF A SET OF REGULAR EXPRESSIONS
%---------------------------------------------------------------------------------------------------
get_first_letters_in_regular_expressions([],[]).
get_first_letters_in_regular_expressions([Rexp|Rrexp],Letters) :-
	get_first_letters_in_regular_expression(Rexp,Letters1),
	get_first_letters_in_regular_expressions(Rrexp,Letters2),
	append(Letters1,Letters2,Letters).

get_first_letters_in_regular_expression([],[]).
get_first_letters_in_regular_expression([Term|_],Letters) :-
	get_first_letters_in_term(Term,Letters).

get_first_letters_in_term(n(L,O,V),[n(L,O,V)]).
get_first_letters_in_term(id(Rexp),Letters) :-
	get_first_letters_in_regular_expression(Rexp,Letters).
get_first_letters_in_term(or(Rexps),Letters) :-
	get_first_letters_in_regular_expressions(Rexps,Letters).

get_last_letters_in_regular_expressions([],[]).
get_last_letters_in_regular_expressions([Rexp|Rrexp],Letters) :-
	get_last_letters_in_regular_expression(Rexp,Letters1),
	get_last_letters_in_regular_expressions(Rrexp,Letters2),
	append(Letters1,Letters2,Letters).

get_last_letters_in_regular_expression([],[]).
get_last_letters_in_regular_expression([Term],Letters) :-
	get_last_letters_in_term(Term,Letters).
get_last_letters_in_regular_expression([_,Term2|Rterm],Letters) :-
	get_last_letters_in_regular_expression([Term2|Rterm],Letters).

get_last_letters_in_term(n(L,O,V),[n(L,O,V)]).
get_last_letters_in_term(id(Rexp),Letters) :-
	get_last_letters_in_regular_expression(Rexp,Letters).
get_last_letters_in_term(or(Rexps),Letters) :-
	get_last_letters_in_regular_expressions(Rexps,Letters).

% CREATE A REDUNDANT CONSTRAINT ACCORDING TO THE FACT THAT A CYCLE VARIABLE HAS TO FOLLOW
% OR PRECEDE A SET OF CYCLES VARIABLES WHICH ARE PAIRWISE DISTINCT
%---------------------------------------------------------------------------------------------------
create_redundant_prec_ctr(Letters_before,n(L,_,V),Poly_last_significant_pos) :-
	compute_distinct_letters(Letters_before,L,Letters_surly_before),
	Min in 0..100000,
	minimum(Min,Letters_surly_before),
	length(Letters_surly_before,N),
	Min + N #=< V,
	Min + N #=< Poly_last_significant_pos + 1.
create_redundant_prec_ctr(n(L,_,V),Letters_after,_) :-
	compute_distinct_letters(Letters_after,L,Letters_surly_after),
	Max in 0..100000,
	maximum1(Max,Letters_surly_after),
	length(Letters_surly_after,N),
	V + N #=< Max.

compute_distinct_letters([],_,[]).
compute_distinct_letters([n(L,_,V)|R],L,S) :-
	!,
	compute_distinct_letters(R,L,S).
compute_distinct_letters([n(_,_,V)|R],L,[V|S]) :-
	compute_distinct_letters(R,L,S).

% ALL VALUES BETWEEN 1 AND Key_last_significant_pos SHOULD BE USED IN THE CYCLE VARIABLES
%---------------------------------------------------------------------------------------------------
create_use_all_values_ctr(Cycle_vars,Ncycle_vars,Key_last_significant_pos) :-
%	writeln(create_use_all_values_ctr),
	Ncycle_vars1 is Ncycle_vars+1,
	Key_last_significant_pos1 in 1..Ncycle_vars1,
	create_tasks(Cycle_vars,Tasks,Ncycle_vars1),
	append([task(1,Key_last_significant_pos,Key_last_significant_pos1,0,1)],Tasks,Tasks1),
	cumulatives(Tasks1,[machine(1,1)]).

create_tasks([],[],_).
create_tasks([Origin|Rest_origin],[task(Origin,1,End,1,1)|Rest_task],Ncycle_vars1) :-
	End in 1..Ncycle_vars1,
	create_tasks(Rest_origin,Rest_task,Ncycle_vars1).

% CREATE CONSTRAINT ON POLY.VARIABLES
% .they should be located within the first 50 cycles,
% .their pic should not coincide
%---------------------------------------------------------------------------------------------------
create_poly_ctr(Poly_vars,Poly_last_significant_pos) :-
%	writeln(create_poly_ctr),
	Poly_last_significant_pos in 0..50,
	maximum1(Poly_last_significant_pos,Poly_vars),
	all_distinct(Poly_vars).

% CREATE CONSTRAINT ON ADJACENT VARIABLES IN THE KEY:
% valid adjacent pairs of values are (0,0) (1,{0,2,3,4}) (2,{0,1,3,4}) (3,{0,1,2,4}) (4,{0,1,2,3})
%---------------------------------------------------------------------------------------------------
create_adjacent_key_ctr(Key_vars) :-
	build_adjacent_pairs(Key_vars,Adjacent_pairs),
	case(t(U,V),Adjacent_pairs,
	     [node(0,U,[(0..0)-1,(1..1)-2,(2..2)-3,(3..3)-4,(4..4)-5]),
	      node(1,V,[(0..0)]),
	      node(2,V,[(0..0),(2..4)]),
	      node(3,V,[(0..1),(3..4)]),
	      node(4,V,[(0..2),(4..4)]),
	      node(5,V,[(0..3)])],
	     [on(dom(U)),on(dom(V)),prune(dom(U)),prune(dom(V))]).

build_adjacent_pairs([],[]).
build_adjacent_pairs([_],[]).
build_adjacent_pairs([K1,K2|Rest_key_vars],[t(K1,K2)|Rest_adjacent]):-
	build_adjacent_pairs([K2|Rest_key_vars],Rest_adjacent).

% CREATE END CONSTRAINT: LAST SIGNIFICATIVE KEY POSITION IS THE MAXIMUM OF THE CYCLES VARIABLES
%---------------------------------------------------------------------------------------------------
create_end_ctr(Cycle_vars,Key_vars,Ncycle_vars,Key_last_significant_pos) :-
%	writeln(create_end_ctr),
	Key_last_significant_pos in 1..Ncycle_vars,
	last_pos_greater0(Key_last_significant_pos,Key_vars),
	maximum1(Key_last_significant_pos,Cycle_vars).

% COLLECT VARIABLES IN ALL THE REGULAR EXPRESSIONS AS WELL AS POLY.VARIABLES
%---------------------------------------------------------------------------------------------------
collect_cycle_vars_in_regular_expressions([],_,[],[]).
collect_cycle_vars_in_regular_expressions([Rexp|Rrexp],Level,Cycle_vars,Poly_vars) :-
	collect_cycle_vars_in_regular_expression(Rexp,Level,Cycle_vars1,Poly_vars1),
	collect_cycle_vars_in_regular_expressions(Rrexp,Level,Cycle_vars2,Poly_vars2),
	append(Cycle_vars1,Cycle_vars2,Cycle_vars),
	append(Poly_vars1,Poly_vars2,Poly_vars).

collect_cycle_vars_in_regular_expression([],_,[],[]).
collect_cycle_vars_in_regular_expression([Term|Rterm],Level,Cycle_vars,Poly_vars) :-
	collect_cycle_vars_in_term(Term,Level,Cycle_vars1,Poly_vars1),
	collect_cycle_vars_in_regular_expression(Rterm,Level,Cycle_vars2,Poly_vars2),
	append(Cycle_vars1,Cycle_vars2,Cycle_vars),
	append(Poly_vars1,Poly_vars2,Poly_vars).

collect_cycle_vars_in_term(n(_,_,Cycle_var),0,[Cycle_var],[]).
collect_cycle_vars_in_term(n(_,_,Cycle_var),Level,[Cycle_var],[Cycle_var]) :-
	Level > 0.
collect_cycle_vars_in_term(id(Rexp),Level,Cycle_vars,Poly_vars) :-
	Level1 is Level + 1,
	collect_cycle_vars_in_regular_expression(Rexp,Level1,Cycle_vars,Poly_vars).
collect_cycle_vars_in_term(or(Rexps),Level,Cycle_vars,Poly_vars) :-
	Level1 is Level + 1,
	collect_cycle_vars_in_regular_expressions(Rexps,Level1,Cycle_vars,Poly_vars).

% SIMULATED CONSTRAINTS
%---------------------------------------------------------------------------------------------------

% last_pos_greater0(End,[V1,V2,...Vn])
%...................................................................................................
% all arguments are dvar
% Vi=0          ==> End< i
% Vi<>0         ==> End>=i
% i =< min(End) ==> Vi<>0
% i  > max(End) ==> Vi=0
last_pos_greater0(End, Vs) :-
        on(Vs, dom, Susp, []),
        fd_global(last_pos_greater0(End,Vs), [],
                  [minmax(End)|Susp],
                  [idempotent(false)]).

clpfd:dispatch_global(last_pos_greater0(End,Vs), [], [], Actions) :-
        last_pos_greater0_solver(End, Vs, Actions).

last_pos_greater0_solver(End, Vs, Actions) :-
        fd_min(End, EndMin),
        fd_max(End, EndMax),
        last_pos_scan(Vs, 0, End, EndMin, EndMax, Actions, []).

last_pos_scan([], _, _, _, _) --> [].
last_pos_scan([Vj|Vs], I, End, EndMin, EndMax) -->
        {J is I+1},
        (   {J =< EndMin} -> [Vj in 1..sup]
        ;   {J  > EndMax} -> [Vj=0]
        ;   {Vj==0} ->       [End in 0..I]
        ;   {fd_min(Vj, Vmin), Vmin>0} -> [End in J..sup]
        ;   []
        ),
        last_pos_scan(Vs, J, End, EndMin, EndMax).

% pos_after_pos_of_occ(V1,V2,[U1,U2,...,Un],Key)
%...................................................................................................
% all arguments are dvar except Key which is an integer
% V1<V2 
% element(V2,[U1,U2,...,Un],Key)
% Ui=Key & i>max(V1)    ==> V2 =< i
% i<min(V2) & i>max(V1) ==> Ui <> Key
pos_after_pos_of_occ(V1, V2, Us, Key) :-
        V1 #< V2,
        element(V2, Us, Key),
        on(Us, val, Susp, []),
        fd_global(pos_after_pos_aux(V1,V2,Us,Key), [],
                  [max(V1),min(V2)|Susp]).

clpfd:dispatch_global(pos_after_pos_aux(V1,V2,Us,Key), [], [], Actions) :-
        pos_after_pos_aux_solver(V1, V2, Us, Key, Actions).

pos_after_pos_aux_solver(V1, V2, Us, Key, Actions) :-
        fd_max(V1, V1Max),
        fd_min(V2, V2Min),
        pos_after_pos_scan(Us, 0, V2, Key, V1Max, V2Min, Actions, []).

pos_after_pos_scan([],      _, _,  _,   _,     _) --> [].
pos_after_pos_scan([Uj|Us], I, V2, Key, V1Max, V2Min) -->
        {J is I+1},
        (   {J =< V1Max}  -> []
        ;   {Uj==Key}     -> [V2 in 1..J]
        ;   {J  < V2Min}  -> [Uj in \{Key}]
        ;   []
        ),
        pos_after_pos_scan(Us, J, V2, Key, V1Max, V2Min).

on([], _) --> [].
on([X|Xs], Event) --> [Y],
        {Y =.. [Event,X]},
        on(Xs, Event).

% minimum(Max,[V1,V2,...Vn]) and maximum(Max,[V1,V2,...Vn])
%...................................................................................................
% all arguments are dvar

minimum(Min_var,List_vars) :-
	build_min_term(List_vars,Term),
	call(Min_var #= Term).

build_min_term([],100000).
build_min_term([Var|Rest],min(Var,S)) :-
	build_min_term(Rest,S).

maximum1(Max_var,List_vars) :-
	build_max_term1(List_vars,Term),
	call(Max_var #= Term).

build_max_term1([],0).
build_max_term1([Var|Rest],max(Var,S)) :-
	build_max_term1(Rest,S).

% ABSTRACT SYNTAX
%---------------------------------------------------------------------------------------------------
% Pattern ::= [Elt,Elt,...]             /* concatenation of the Elts         */
% Elt     ::= n(Nuc,Int,_)              /* a stretch of Int same nucleotides */
%          |  or([Pattern,Pattern,...]) /* alternative                       */
%          |  id(Pattern)               /* insdel, i.e. Pattern or empty     */
% Nuc     ::= a | c | g | t

pattern([]) --> "".
pattern([Elt|Pat]) -->
        elt(Elt),
        pattern(Pat).

elt(id(Pattern)) -->
        "[", pattern(Pattern), "]".
elt(Elt) -->
        nuc(N1), "/", nuc(N2),
        or_rest([N1,N2|Rest], Rest, Elt).
elt(Nuc) -->
        nuc(N),
        nuc_rest(N, 1, Nuc).
elt(Elt) -->
        iupac(Nucs),
        {nucs_term(Nucs, Elt)}.

nuc_rest(N, I, Nuc) -->
        nuc(N),
        noslash, !,
        {J is I+1},
        nuc_rest(N, J, Nuc).
nuc_rest(N, I, Nuc) -->
        {poly_nuc(N, I, Nuc)}.

noslash --> "/", !, {fail}.
noslash --> "".

or_rest(Nucs, [], Elt) -->
        {nucs_term(Nucs, Elt)}.
or_rest(Nucs, [N|Rest], Elt) -->
        "/", nuc(N),
        or_rest(Nucs, Rest, Elt).

nuc(a) --> "A".
nuc(c) --> "C".
nuc(g) --> "G".
nuc(t) --> "T".

iupac([a,g]) --> "R".
iupac([c,t]) --> "Y".
iupac([g,t]) --> "K".
iupac([a,c]) --> "M".
iupac([g,c]) --> "S".
iupac([a,t]) --> "W".
iupac([c,g,t]) --> "B".
iupac([a,g,t]) --> "D".
iupac([a,c,t]) --> "H".
iupac([a,g,c]) --> "V".
iupac([a,c,g,t]) --> "N".

poly_nuc(N, I, n(N,I,_)).

nucs_term(Nucs, or(L)) :-
        monos(Nucs, L).

monos([], []).
monos([N|Ns], [[M]|Ms]) :-
        poly_nuc(N, 1, M),
        monos(Ns, Ms).

% UTILITY FUNCTIONS
%---------------------------------------------------------------------------------------------------
% input : [[1,2,3],[4,5],[6]]
% output: [[4,5,6],
%          [1,2,3,6],
%          [1,2,3,4,5]]
skip_its_own_cycle_variables([_],Before,[Before]).
skip_its_own_cycle_variables([L|R],Before,[Current|S]) :-
	flat(R,Flat_r),
	append(Before,Flat_r,Current),
	append(Before,L,New_before),
	skip_its_own_cycle_variables(R,New_before,S).

flat([],[]).
flat([X|R],S) :-
	flat(R,T),
	append(X,T,S).

convert_solution([],[]).
convert_solution([0|_],[]).
convert_solution([X|R],[Y|S]) :-
	convert_nucleotide_to_int(Y,X),
	convert_solution(R,S).

convert_nucleotide_to_int(z,0). % dummy one
convert_nucleotide_to_int(a,1).
convert_nucleotide_to_int(c,2).
convert_nucleotide_to_int(g,3).
convert_nucleotide_to_int(t,4).

