cuboid(D1,D2,D3) :-
	W is D1 * 50,
	H is D2 * 50,
	D is D3 * 50,

	new(C, window(cuboid)),

	% compute the size of the window
	Width is W + ceiling(sqrt(H * 48)) + 50,
	Height is H +  ceiling(sqrt(H * 48)) + 50,
	send(C, size, new(_,size(Width,Height))),

	%compute the top-left corner of the front face of the cuboid
	PX is 25,
	PY is 25 + ceiling(sqrt(H * 48)),

	% colors of the faces
	new(C1, colour(@default, 65535, 0, 0)),
	new(C2, colour(@default, 0, 65535, 0)),
	new(C3, colour(@default, 0, 0, 65535)),

	% the front face
	new(B1, box(W, H)),
	send(B1, fill_pattern, C1),
	send(C, display,B1, point(PX, PY)),

	% the top face
	new(B2, hpara(point(PX,PY), W, D, C2)),
	send(C, display, B2),

	% the left face
	PX1 is PX + W,
	new(B3, vpara(point(PX1,PY), H, D, C3)),
	send(C, display, B3),

	send(C, open).

:- pce_begin_class(hpara, path, "drawing of a horizontal parallelogram").

initialise(P, Pos, Width, Height, Color) :->
	send(P, send_super, initialise),
	send(P, append, Pos),
	H is ceiling(sqrt(Height * 48)),
	get(Pos, x, X),
	get(Pos, y, Y),
	X1 is X + H,
	Y1 is Y - H,
	send(P, append, point(X1, Y1)),
	X2 is X1 + Width,
	send(P, append, point(X2, Y1)),
	X3 is X2 - H,
	send(P, append, point(X3, Pos?y)),
	send(P, append, Pos),
	send(P, fill_pattern, Color).

:- pce_end_class.

:- pce_begin_class(vpara, path, "drawing of a vertical parallelogram").

initialise(P, Pos, Height, Depth, Color) :->
	send(P, send_super, initialise),
	send(P, append, Pos),
	H is ceiling(sqrt(Depth * 48)),
	get(Pos, x, X),
	get(Pos, y, Y),
	X1 is X + H,
	Y1 is Y - H,
	send(P, append, point(X1, Y1)),
	Y2 is Y1 + Height,
	send(P, append, point(X1, Y2)),
	Y3 is Y2 + H,
	send(P, append, point(X, Y3)),
	send(P, append, Pos),
	send(P, fill_pattern, Color).

:- pce_end_class.

The code generates a 2x3x4 cuboid, either graphically or in ASCII art, depending on the language capabilities. It ensures three faces are visible to meet the cuboid criteria, and supports both static and rotational projection. The code is compatible with SWI-Prolog and XPCE.


:- use_module(library(ctypes)).

runtime_entry(start) :-
	prompt(_, ''),
	rot13.

rot13 :-
	get0(Ch),
	(   is_endfile(Ch) ->
		true
	;   rot13_char(Ch, Rot),
	    put(Rot),
	    rot13
	).

rot13_char(Ch, Rot) :-
	(   is_alpha(Ch) ->
		to_upper(Ch, Up),
		Letter is Up - 0'A,
		Rot is Ch + ((Letter + 13) mod 26) - Letter
	;   Rot = Ch
	).

rot13(Str, SR) :-
	maplist(rot, Str, Str1),
	string_to_list(SR, Str1).

rot(C, C1) :-
	(   member(C, "abcdefghijklmABCDEFGHIJKLM") -> C1 is C+13;
	    (	member(C, "nopqrstuvwxyzNOPQRSTUVWXYZ") -> C1 is C-13; C1 = C)).

 ?- rot13("The Quick Brown Fox Jumped Over The Lazy Dog!", SR).
SR = "Gur Dhvpx Oebja Sbk Whzcrq Bire Gur Ynml Qbt!".

The code implements a ROT-13 function that replaces each letter of the ASCII alphabet with the letter 13 characters away in the 26 letter alphabet, preserving case and passing non-alphabetic characters without alteration. This function can be optionally wrapped in a utility program similar to UNIX utility, performing line-by-line ROT-13 encoding of input from each file listed on its command line or acting as a filter on its standard input. The function is compatible with Quintus Prolog and SWI-Prolog.


example :-
    between(1,5,I), nl, between(1,I,_J),
    write('*'), fail.
example.
?- example.

*
**
***
****
*****
true.

demonstrate how to use nested 'for' loops to print a specific pattern. The number of iterations in the inner loop is controlled by the outer loop. The pattern printed consists of an increasing number of asterisks on each line. In Prolog, the 'between' function is used as an equivalent to a 'for' loop.


mymap(key1,value1).
mymap(key2,value2).

?- mymap(key1,V).
   V = value1

"Create an associative array, dictionary, map, or hash using a facts table."


halve(X,Y) :- Y is X // 2.
double(X,Y) :- Y is 2*X.
is_even(X) :- 0 is X mod 2.

% columns(First,Second,Left,Right) is true if integers First and Second
% expand into the columns Left and Right, respectively
columns(1,Second,[1],[Second]).
columns(First,Second,[First|Left],[Second|Right]) :-
    halve(First,Halved),
    double(Second,Doubled),
    columns(Halved,Doubled,Left,Right).

% contribution(Left,Right,Amount) is true if integers Left and Right,
% from their respective columns contribute Amount to the final sum.
contribution(Left,_Right,0) :-
    is_even(Left).
contribution(Left,Right,Right) :-
    \+ is_even(Left).

ethiopian(First,Second,Product) :-
    columns(First,Second,Left,Right),
    maplist(contribution,Left,Right,Contributions),
    sumlist(Contributions,Product).

:- use_module(library(func)).

% halve/2, double/2, is_even/2 definitions go here

ethiopian(First,Second,Product) :-
    ethiopian(First,Second,0,Product).

ethiopian(1,Second,Sum0,Sum) :-
    Sum is Sum0 + Second.
ethiopian(First,Second,Sum0,Sum) :-
    Sum1 is Sum0 + Second*(First mod 2),
    ethiopian(halve $ First, double $ Second, Sum1, Sum).

:- module(ethiopia, [test/0, mul/3]).

:- use_module(library(chr)).

:- chr_constraint mul/3, halve/2, double/2, even/1, add_odd/4.

mul(1, Y, S) <=>          S = Y.
mul(X, Y, S) <=> X \= 1 | halve(X, X1),
                          double(Y, Y1),
                          mul(X1, Y1, S1),
                          add_odd(X, Y, S1, S).

halve(X, Y) <=> Y is X // 2.

double(X, Y) <=> Y is X * 2.

even(X) <=> 0 is X mod 2 | true.
even(X) <=> 1 is X mod 2 | false.

add_odd(X, _, A, S) <=> even(X)    | S is A.
add_odd(X, Y, A, S) <=> \+ even(X) | S is A + Y.

test :-
    mul(17, 34, Z), !,
    writeln(Z).
Note that the task statement is what makes the halve and double constraints required.  Their use is highly artificial and a more realistic implementation would look like this:
:- module(ethiopia, [test/0, mul/3]).

:- use_module(library(chr)).

:- chr_constraint mul/3, even/1, add_if_odd/4.

mul(1, Y, S) <=>          S = Y.
mul(X, Y, S) <=> X \= 1 | X1 is X // 2,
                          Y1 is Y * 2,
                          mul(X1, Y1, S1),
                          add_if_odd(X, Y, S1, S).

even(X) <=> 0 is X mod 2 | true.
even(X) <=> 1 is X mod 2 | false.

add_if_odd(X, _, A, S) <=> even(X)    | S is A.
add_if_odd(X, Y, A, S) <=> \+ even(X) | S is A + Y.

test :-
    mul(17, 34, Z),
    writeln(Z).
Even this is more verbose than what a more native solution would look like.

The code defines three functions to halve an integer, double an integer, and check if an integer is even. These functions are then used to implement the Ethiopian multiplication method, which multiplies two integers using only addition, doubling, and halving operations. The multiplication process involves creating a table, discarding rows with even numbers in the left column, and summing the remaining values in the right column. The solution is implemented in Prolog language.


play24(Len, Range, Goal) :-
	game(Len, Range, Goal, L, S),
	maplist(my_write, L),
	format(': ~w~n', [S]).

game(Len, Range, Value, L, S) :-
	length(L, Len),
	maplist(choose(Range), L),
	compute(L, Value, [], S).

choose(Range, V) :-
	V is random(Range) + 1.

write_tree([M], [M]).

write_tree([+, M, N], S) :-
	write_tree(M, MS),
	write_tree(N, NS),
	append(MS, [+ | NS], S).

write_tree([-, M, N], S) :-
	write_tree(M, MS),
	write_tree(N, NS),
	(   is_add(N) -> append(MS, [-, '(' | NS], Temp), append(Temp, ')', S)
	;   append(MS, [- | NS], S)).

write_tree([Op, M, N], S) :-
	member(Op, [*, /]),
	write_tree(M, MS),
	write_tree(N, NS),
	(   is_add(M) -> append(['(' | MS], [')'], TempM)
	;  TempM = MS),
	(   is_add(N) -> append(['(' | NS], [')'], TempN)
	;   TempN = NS),
	append(TempM, [Op | TempN], S).

is_add([Op, _, _]) :-
	member(Op, [+, -]).

compute([Value], Value, [[_R-S1]], S) :-
	write_tree(S1, S2),
	with_output_to(atom(S), maplist(write, S2)).

compute(L, Value, CS, S) :-
	select(M, L, L1),
	select(N, L1, L2),
	next_value(M, N, R, CS, Expr),
	compute([R|L2], Value, Expr, S).

next_value(M, N, R, CS,[[R - [+, M1, N1]] | CS2]) :-
	R is M+N,
	(   member([M-ExprM], CS) -> select([M-ExprM], CS, CS1), M1 = ExprM
	;   M1 = [M], CS1 = CS
	),
	(   member([N-ExprN], CS1) -> select([N-ExprN], CS1, CS2), N1 = ExprN
	;   N1 = [N], CS2 = CS1
	).

next_value(M, N, R, CS,[[R - [-, M1, N1]] | CS2]) :-
	R is M-N,
	(   member([M-ExprM], CS) -> select([M-ExprM], CS, CS1), M1 = ExprM
	;   M1 = [M], CS1 = CS
	),
	(   member([N-ExprN], CS1) -> select([N-ExprN], CS1, CS2), N1 = ExprN
	;   N1 = [N], CS2 = CS1
	).

next_value(M, N, R, CS,[[R - [*, M1, N1]] | CS2]) :-
	R is M*N,
	(   member([M-ExprM], CS) -> select([M-ExprM], CS, CS1), M1 = ExprM
	;   M1 = [M], CS1 = CS
	),
	(   member([N-ExprN], CS1) -> select([N-ExprN], CS1, CS2), N1 = ExprN
	;   N1 = [N], CS2 = CS1
	).

next_value(M, N, R, CS,[[R - [/, M1, N1]] | CS2]) :-
	N \= 0,
	R is rdiv(M,N),
	(   member([M-ExprM], CS) -> select([M-ExprM], CS, CS1), M1 = ExprM
	;   M1 = [M], CS1 = CS
	),
	(   member([N-ExprN], CS1) -> select([N-ExprN], CS1, CS2), N1 = ExprN
	;   N1 = [N], CS2 = CS1
	).

my_write(V) :-
	format('~w ', [V]).

The code takes four digits as input, either from the user or randomly generated, and calculates arithmetic expressions according to the rules of the 24 game. It can also work with different goals and number ranges, not just 24 and 1-9. It uses rdiv/2 instead of //2 to solve complex cases and makes efforts to remove duplicates. Examples of solutions are also provided. Compatible with SWI-Prolog.


Works with: SWI Prolog
fact(X, 1) :- X<2.
fact(X, F) :- Y is X-1, fact(Y,Z), F is Z*X.
fact(N, NF) :-
	fact(1, N, 1, NF).

fact(X, X, F, F) :- !.
fact(X, N, FX, F) :-
	X1 is X + 1,
	FX1 is FX * X1,
	fact(X1, N, FX1, F).

% foldl(Pred, Init, List, R).
%
foldl(_Pred, Val, [], Val).
foldl(Pred, Val, [H | T], Res) :-
	call(Pred, Val, H, Val1),
	foldl(Pred, Val1, T, Res).

% factorial
p(X, Y, Z) :- Z is X * Y).

fact(X, F) :-
	numlist(2, X, L),
	foldl(p, 1, L, F).

:- use_module(lambda).

% foldl(Pred, Init, List, R).
%
foldl(_Pred, Val, [], Val).
foldl(Pred, Val, [H | T], Res) :-
	call(Pred, Val, H, Val1),
	foldl(Pred, Val1, T, Res).

fact(N, F) :-
	numlist(2, N, L),
	foldl(\X^Y^Z^(Z is X * Y), 1, L, F).

:- use_module(lambda).

fact(N, FN) :-
	cont_fact(N, FN, \X^Y^(Y = X)).

cont_fact(N, F, Pred) :-
	(   N = 0 ->
	    call(Pred, 1, F)
	;   N1 is N - 1,

	    P =  \Z^T^(T is Z * N),
	    cont_fact(N1, FT, P),
	    call(Pred, FT, F)
	).

The code is a function that calculates the factorial of a given number. It can be implemented iteratively or recursively. It optionally includes error handling for negative inputs. The function utilizes the Factorial Function, which multiplies a sequence of descending integers from the input number to one. The code also has a relation to Primorial numbers and uses the foldl simulation with anonymous functions from the lambda module by Ulrich Neumerkel.


:- use_module(library(lambda)).
:- use_module(library(clpfd)).

% Parameters of the server

% length of the guess
proposition(4).

% Numbers of digits
% 0 -> 8
digits(8).

bulls_and_cows_server :-
	proposition(LenGuess),
	length(Solution, LenGuess),
	choose(Solution),
	repeat,
	write('Your guess : '),
	read(Guess),
	(   study(Solution, Guess, Bulls, Cows)
	->  format('Bulls : ~w Cows : ~w~n', [Bulls, Cows]),
	    Bulls = LenGuess
	;   digits(Digits), Max is Digits + 1,
	    format('Guess must be of ~w digits between 1 and ~w~n',
		   [LenGuess, Max]),
	    fail).

choose(Solution) :-
	digits(Digits),
	Max is Digits + 1,
	repeat,
	maplist(\X^(X is random(Max) + 1), Solution),
	all_distinct(Solution),
	!.

study(Solution, Guess, Bulls, Cows) :-
	proposition(LenGuess),
	digits(Digits),

	% compute the transformation 1234 => [1,2,3,4]
	atom_chars(Guess, Chars),
	maplist(\X^Y^(atom_number(X, Y)), Chars, Ms),

	% check that the guess is well formed
	length(Ms, LenGuess),
	maplist(\X^(X > 0, X =< Digits+1), Ms),

	% compute the digit in good place
	foldl(\X^Y^V0^V1^((X = Y->V1 is V0+1; V1 = V0)),Solution, Ms, 0, Bulls),

	% compute the digits in bad place
	foldl(\Y1^V2^V3^(foldl(\X2^Z2^Z3^(X2 = Y1 -> Z3 is Z2+1; Z3 = Z2), Ms, 0, TT1),
			 V3 is V2+ TT1),
	      Solution, 0, TT),
	Cows is TT - Bulls.

The code generates a four-digit random number from 1 to 9 without duplication. It prompts the user for guesses, rejects malformed guesses, and prints the score for each guess. The score is calculated based on the number of 'bulls' and 'cows' in the guess, where a 'bull' is a digit that matches the corresponding digit in the random number and a 'cow' is a digit that exists in the random number but in a different position. The game ends when the guess matches the random number. The code is compatible with SWI-Prolog 6.1.8 and uses the lambda and clpfd modules.


dot_product(L1, L2, N) :-
	maplist(mult, L1, L2, P),
	sumlist(P, N).

mult(A,B,C) :-
	C is A*B.

 ?- dot_product([1,3,-5], [4,-2,-1], N).
N = 3.

"Implements a function to compute the dot product of two vectors of the same length by multiplying corresponding terms and summing the products."


the system time in a specified unit. This can be used for debugging, network information, random number seeds, or program performance. It may also relate to the task of date formatting and retrieving system time.


Works with: SWI-Prolog version 6

nth(N, N_Th) :-
    ( tween(N)      -> Th = "th"
    ; 1 is N mod 10 -> Th = "st"
    ; 2 is N mod 10 -> Th = "nd"
    ; 3 is N mod 10 -> Th = "rd"
    ; Th = "th" ),
    string_concat(N, Th, N_Th).

tween(N) :- Tween is N mod 100, between(11, 13, Tween).

test :-
    forall( between(0,25, N),     (nth(N, N_Th), format('~w, ', N_Th)) ),
    nl, nl,
    forall( between(250,265,N),   (nth(N, N_Th), format('~w, ', N_Th)) ),
    nl, nl,
    forall( between(1000,1025,N), (nth(N, N_Th), format('~w, ', N_Th)) ).

The code is a function that takes a non-negative integer as input and returns a string representation of the number followed by its ordinal suffix. It also demonstrates the output for the ranges 0-25, 250-265, and 1000-1025. The use of apostrophes in the output is optional.


:- use_module(library(lambda)).

stripchars(String, Exclude, Result) :-
	exclude(\X^(member(X, Exclude)), String, Result1),
	string_to_list(Result, Result1).

The code defines a function that removes a specified set of characters from a given string. The function takes two arguments: the original string and a string of characters to be removed. The function then returns the original string, stripped of any characters present in the second string. This code is compatible with SWI-Prolog and the lambda.pl module by Ulrich Neumerkel.


maxNumber(105).
factors([(3, "Fizz"), (5, "Buzz"), (7, "Baxx")]).

go :- maxNumber(M), factors(Fs), MLast is M+1, loop(1,MLast,Fs).

loop(B,B,_).
loop(A,B,Fs) :-
    A < B, fizzbuzz(A,Fs,S), ( (S = "", Res is A) ; Res = S ), writeln(Res),
    Next is A+1, loop(Next,B,Fs).

fizzbuzz(_,[],"").
fizzbuzz(N,[(F,S)|Fs],Res) :-
    fizzbuzz(N,Fs,OldRes),
    ( N mod F =:= 0, string_concat(S,OldRes,Res) ; Res = OldRes ).

?- go.

factors([(3, "Fizz"), (5, "Buzz")]).

The code is a generalized implementation of the FizzBuzz program. It accepts a maximum number and a list of factors with corresponding words from the user. It then prints numbers from 1 to the maximum number, replacing multiples of the factors with their corresponding words. If a number is a multiple of multiple factors, it prints all corresponding words in the order of least to greatest factor. The code can handle an arbitrary number of factors.


Works with: SWI-Prolog

:- op(200, xfx, user:(=+)).

%% +Prepend =+ +Chars
%
%    Will destructively update Chars
%    So that Chars = Prepend prefixed to Chars.
%    eazar001 in ##prolog helped refine this approach.

[X|Xs] =+ Chars :-
  append(Xs, Chars, Rest),
  nb_setarg(2, Chars, Rest),
  nb_setarg(1, Chars, X).

?- Str = `World!`, `Hello, ` =+ Str.
Str = "Hello, World!".

create a string variable and prepend it with another string literal. The code also includes idiomatic ways to perform this operation without referring to the variable twice. It also demonstrates the content of the variable. In Prolog, it uses the traditional representation of strings as lists of character codes and the non-logical predicate `setarg/3` to destructively set the head and tail of the list, effectively mutating the variable holding the string.


dragonCurve(N) :-
	dcg_dg(N, [left], DCL, []),
	Side = 4,
	Angle is -N * (pi/4),
	dcg_computePath(Side, Angle, DCL, point(180,400), P, []),
	new(D, window('Dragon Curve')),
	send(D, size, size(800,600)),
	new(Path, path(poly)),
	send_list(Path, append, P),
	send(D, display, Path),
	send(D, open).

% compute the list of points of the Dragon Curve
dcg_computePath(Side, Angle, [left | DCT], point(X1, Y1)) -->
	   [point(X1, Y1)],
	   {	X2 is X1 + Side * cos(Angle),
		Y2 is Y1 + Side * sin(Angle),
		Angle1 is Angle + pi / 2
	   },
	   dcg_computePath(Side, Angle1, DCT, point(X2, Y2)).

dcg_computePath(Side, Angle, [right | DCT], point(X1, Y1)) -->
	   [point(X1, Y1)],
	   {	X2 is X1 + Side * cos(Angle),
		Y2 is Y1 + Side * sin(Angle),
		Angle1 is Angle - pi / 2
	   },
	   dcg_computePath(Side, Angle1, DCT, point(X2, Y2)).

dcg_computePath(_Side, _Angle, [], point(X1, Y1)) -->
	[ point(X1, Y1)].

% compute the list of the "turns" of the Dragon Curve
dcg_dg(1, L) --> L.

dcg_dg(N, L) -->
	{dcg_dg(L, L1, []),
	  N1 is N - 1},
	  dcg_dg(N1, L1).

% one interation of the process
dcg_dg(L) -->
	L,
	[left],
	inverse(L).

inverse([H | T]) -->
	inverse(T),
	inverse(H).

inverse([]) --> [].

inverse(left) -->
	[right].

inverse(right) -->
	[left].

1 ?- dragonCurve(13).
true

The code generates a Dragon Curve fractal either for direct display or to be written to an image file. It uses recursive, successive approximation, iterative, and Lindenmayer system methods to create the fractal. The code also includes functionality to calculate absolute direction and X,Y coordinates of a point, and to test whether a given point or segment is on the curve. It is compatible with SWI-Prolog and uses DCG to compute the list of turns and points in the Dragon Curve.


Works with: SWI-Prolog version 6
main :-
    random_between(1, 10, N),
    repeat,
    prompt1('Guess the number: '),
    read(N),
    writeln('Well guessed!'),
    !.

?- main.
Guess the number: 1.
Guess the number: 2.
Guess the number: 3.
Well guessed!
true.

The code prompts the user to guess a number between 1 and 10. If the guess is incorrect, the user is prompted to guess again. The program continues to prompt the user until the correct number is guessed, at which point it displays a "Well guessed!" message and exits. A conditional loop is used to facilitate repeated guessing.


a_to_z(From, To, L) :-
	maplist(atom_codes, [From, To], [[C_From], [C_To]]),
	bagof([C], between(C_From, C_To, C), L1),
	maplist(atom_codes,L, L1).

 ?- a_to_z(a, z, L).
L = [a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z].

generate a sequence of all lower case ASCII characters from 'a' to 'z'. The sequence can be an array, list, lazy sequence, or indexable string. The code is written in a reliable style suitable for large programs and uses strong typing if available to avoid bugs. The code also demonstrates how to access a similar sequence from the standard library if it exists.


Works with: SWI Prolog
Works with: GNU Prolog
binary(X) :- format('~2r~n', [X]).
main :- maplist(binary, [5,50,9000]), halt.

generate a sequence of binary digits for a given non-negative integer. The output displays only the binary digits of each number, followed by a newline, without any whitespace, radix, sign markers, or leading zeros. The conversion can be achieved using built-in radix functions or a user-defined function.


patient(1001,'Hopper').
patient(4004,'Wirth').
patient(3003,'Kemeny').
patient(2002,'Gosling').
patient(5005,'Kurtz').

visit(2002,'2020-09-10',6.8).
visit(1001,'2020-09-17',5.5).
visit(4004,'2020-09-24',8.4).
visit(2002,'2020-10-08',nan).
visit(1001,'',6.6).
visit(3003,'2020-11-12',nan).
visit(4004,'2020-11-05',7.0).
visit(1001,'2020-11-19',5.3).

summaryDates(Id, Lastname, LastDate) :-
     aggregate(max(Ts),
	       Score^Date^(visit(Id, Date, Score), Date \= '', parse_time(Date, iso_8601, Ts)),
	       MaxTs),
     format_time(atom(LastDate), '%Y-%m-%d', MaxTs),
     patient(Id,Lastname).

summaryScores(Id, Lastname, Sum, Mean) :-
     aggregate(r(sum(Score),count), Date^(visit(Id, Date, Score), Score \= nan), r(Sum,Count)),
     patient(Id,Lastname),
     Mean is Sum/Count.

test :-
    summaryDates(Id, Lastname, LastDate),
    writeln(summaryDates(Id, Lastname, LastDate)),
    fail.

test :-
    summaryScores(Id, Lastname, ScoreSum, ScoreMean),
    writeln(summaryScores(Id, Lastname, ScoreSum, ScoreMean)),
    fail.

The code merges and aggregates two datasets from .csv files into a new dataset. It loads data from 'patients.csv' and 'visits.csv', merges them based on patient id and last name, and calculates the maximum visit date, sum, and average of scores per patient. The resulting dataset is displayed on the screen or saved to a file. The code is particularly suitable for data science and data processing languages like F#, Python, R, SPSS, MATLAB etc.


:- use_module(library( http/http_open )).

http :-
	http_open('http://www.rosettacode.org/',In, []),
	copy_stream_data(In, user_output),
	close(In).

The code accesses a specified URL's content and prints it to the console using the SWI-Prolog and http/http_open library. This is specific to HTTP requests, not HTTPS.


%repeat(Str,Num,Res).
repeat(Str,1,Str).
repeat(Str,Num,Res):-
    Num1 is Num-1,
    repeat(Str,Num1,Res1),
    string_concat(Str, Res1, Res).

Works with: SWI-Prolog version 7
:- system:set_prolog_flag(double_quotes,chars) .

repeat(SOURCEz0,COUNT0,TARGETz)
:-
prolog:phrase(repeat(SOURCEz0,COUNT0),TARGETz)
.

%! repeat(SOURCEz0,COUNT0)//2

repeat(_SOURCEz0_,0)
-->
! ,
[]
.

repeat(SOURCEz0,COUNT0)
-->
SOURCEz0 ,
{ COUNT is COUNT0 - 1 } ,
repeat(SOURCEz0,COUNT)
.

implement a function to repeat a given string a specified number of times. An example of this is repeating "ha" 5 times to get "hahahahaha". Additionally, the code demonstrates a more efficient way to repeat a single character, such as repeating "*" 5 times to get "*****". The implementation uses a tail-recursive DCG, which is more efficient than using lists:append.


print_expression_and_result(M, N, Operator) :-
    Expression =.. [Operator, M, N],
    Result is Expression,
    format('~w ~8|is ~d~n', [Expression, Result]).

arithmetic_integer :-
    read(M),
    read(N),
    maplist( print_expression_and_result(M, N), [+,-,*,//,rem,^] ).

?- arithmetic_integer.
|: 5.
|: 7.
5+7     is 12
5-7     is -2
5*7     is 35
5//7    is 0
5 rem 7 is 5
5^7     is 78125
true.

take two integers as input from the user and calculate their sum, difference, product, integer quotient, remainder, and exponentiation. The code does not include error handling. The integer quotient rounds towards zero and the sign of the remainder matches the sign of the first operand. The code also includes an example of the integer `divmod` operator.


Works with: SWI-Prolog version 7

count_substring(String, Sub, Total) :-
    count_substring(String, Sub, 0, Total).

count_substring(String, Sub, Count, Total) :-
    ( substring_rest(String, Sub, Rest)
    ->
        succ(Count, NextCount),
        count_substring(Rest, Sub, NextCount, Total)
    ;
        Total = Count
    ).

substring_rest(String, Sub, Rest) :-
    sub_string(String, Before, Length, Remain, Sub),
    DropN is Before + Length,
    sub_string(String, DropN, Remain, 0, Rest).

?- count_substring("the three truths","th",X).
X = 3.

?- count_substring("ababababab","abab",X).
X = 2.

Works with: SWI-Prolog version 7.6.4
:- system:set_prolog_flag(double_quotes,chars) .

occurrences(TARGETz0,SUBSTRINGz0,COUNT)
:-
prolog:phrase(occurrences(SUBSTRINGz0,0,COUNT),TARGETz0)
.

occurrences("",_,_)
-->
! ,
{ false }
.

occurrences(SUBSTRINGz0,COUNT0,COUNT)
-->
SUBSTRINGz0 ,
! ,
{ COUNT1 is COUNT0 + 1 } ,
occurrences(SUBSTRINGz0,COUNT1,COUNT)
.

occurrences(SUBSTRINGz0,COUNT0,COUNT)
-->
[_] ,
! ,
occurrences(SUBSTRINGz0,COUNT0,COUNT)
.

occurrences(_SUBSTRINGz0_,COUNT,COUNT)
-->
!
.

The code defines a function to count the number of non-overlapping occurrences of a given substring within a larger string. The function takes two arguments, the main string and the substring to search for, and returns an integer count. Overlapping substrings are not counted multiple times. The matching is done either from left-to-right or right-to-left to yield the maximum number of non-overlapping matches.


hanoi(N) :- move(N,left,center,right).

move(0,_,_,_) :- !.
move(N,A,B,C) :-
    M is N-1,
    move(M,A,C,B),
    inform(A,B),
    move(M,C,B,A).

inform(X,Y) :- write([move,a,disk,from,the,X,pole,to,Y,pole]), nl.

hanoi(N, Src, Aux, Dest, Moves-NMoves) :-
  NMoves is 2^N - 1,
  length(Moves, NMoves),
  phrase(move(N, Src, Aux, Dest), Moves).

move(1, Src, _, Dest) --> !,
  [Src->Dest].

move(2, Src, Aux, Dest) --> !,
  [Src->Aux,Src->Dest,Aux->Dest].

move(N, Src, Aux, Dest) -->
  { succ(N0, N) },
  move(N0, Src, Dest, Aux),
  move(1, Src, Aux, Dest),
  move(N0, Aux, Src, Dest).

"Output: The code uses recursion to solve the Towers of Hanoi problem, as per the task described in Programming in Prolog by W.F. Clocksin & C.S. Mellish. It separates core logic from IO using DCGs."


:- use_module(library(pce)).

animation :-
    new(D, window('Animation')),
    new(Label, label(hello, 'Hello world ! ')),
    send(D, display, Label, point(1,10)),
    new(@animation, animation(Label)),
    send(D, recogniser,
         new(_G, my_click_gesture(left, ''))),

    send(D, done_message, and(message(@animation, free),
                  message(@receiver, destroy))),
    send(D, open),
    send(@animation?mytimer, start).

:- pce_begin_class(animation(label), object).
variable(label, object,  both, "Display window").
variable(delta,    object, both,  "increment of the angle").
variable(mytimer, timer, both, "timer of the animation").

initialise(P, W:object) :->
        "Creation of the object"::
        send(P, label, W),
        send(P, delta, to_left),
    send(P, mytimer, new(_, timer(0.5,message(P, anim_message)))).

% method called when the object is destroyed
% first the timer is stopped
% then all the resources are freed
unlink(P) :->
    send(P?mytimer, stop),
    send(P, send_super, unlink).

% message processed by the timer
anim_message(P) :->
    get(P, label, L),
    get(L, selection, S),
    get(P, delta, Delta),
    compute(Delta, S, S1),
    new(A, name(S1)),
    send(L, selection, A).

:- pce_end_class.

:- pce_begin_class(my_click_gesture, click_gesture,
           "Click in a window").

class_variable(button, button_name, left,
           "By default click with left button").

terminate(G, Ev:event) :->
    send(G, send_super, terminate, Ev),
    get(@animation, delta, D),
    (   D = to_left -> D1 = to_right; D1 = to_left),
    send(@animation, delta, D1).

:- pce_end_class.

% compute next text to be dispalyed
compute(to_right, S, S1) :-
    get(S, size, Len),
    Len1 is Len - 1,
    get(S, sub, Len1, Str),
    get(S, delete_suffix, Str, V),
    get(Str, append, V, S1).

compute(to_left, S, S1) :-
    get(S, sub, 0, 1, Str),
    get(S, delete_prefix, Str, V),
    get(V, append, Str, S1).

create a GUI animation where a "Hello World!" string appears to rotate right by periodically moving the last letter to the front. The direction of rotation reverses when the user clicks on the text. The animation is implemented using SWI-Prolog's graphic interface XPCE.


% initial condition
do(0):- write(0),nl,do(1).

% control condition
do(V):- 0 is mod(V,6), !, fail.

% loop
do(V) :-
    write(V),nl,
    Y is V + 1,
    do(Y).

wloop :-
   do(0).

The code initializes a value to 0, then enters a do-while loop where it increments the value by 1 and prints it, continuing as long as the value modulo 6 is not 0. The loop is guaranteed to execute at least once.


remove_first_last_chars :-
    L = "Rosetta",
    L = [_|L1],
    remove_last(L, L2),
    remove_last(L1, L3),
    writef('Original string      : %s\n', [L]),
    writef('Without first char       : %s\n', [L1]),
    writef('Without last char        : %s\n', [L2]),
    writef('Without first/last chars : %s\n', [L3]).

remove_last(L, LR) :-
    append(LR, [_], L).

 ?- remove_first_last_chars.
Original string          : Rosetta
Without first char       : osetta
Without last char        : Rosett
Without first/last chars : osett
true.

demonstrate how to remove the first, last, or both the first and last characters from a string. It works with any valid Unicode code point in UTF-8 or UTF-16 encoding, referencing logical characters not code units. It is not designed to handle all Unicode characters in other encodings like 8-bit ASCII or EUC-JP.


:- use_module(library(clpfd)).

sudoku(Rows) :-
        length(Rows, 9), maplist(length_(9), Rows),
        append(Rows, Vs), Vs ins 1..9,
        maplist(all_distinct, Rows),
        transpose(Rows, Columns), maplist(all_distinct, Columns),
        Rows = [A,B,C,D,E,F,G,H,I],
        blocks(A, B, C), blocks(D, E, F), blocks(G, H, I).

length_(L, Ls) :- length(Ls, L).

blocks([], [], []).
blocks([A,B,C|Bs1], [D,E,F|Bs2], [G,H,I|Bs3]) :-
        all_distinct([A,B,C,D,E,F,G,H,I]),
        blocks(Bs1, Bs2, Bs3).

problem(1, [[_,_,_,_,_,_,_,_,_],
            [_,_,_,_,_,3,_,8,5],
            [_,_,1,_,2,_,_,_,_],
            [_,_,_,5,_,7,_,_,_],
            [_,_,4,_,_,_,1,_,_],
            [_,9,_,_,_,_,_,_,_],
            [5,_,_,_,_,_,_,7,3],
            [_,_,2,_,1,_,_,_,_],
            [_,_,_,_,4,_,_,_,9]]).

Works with: GNU Prolog version 1.4.4
:- initialization(main).

solve(Rows) :-
    maplist(domain_1_9, Rows)
  , different(Rows)
  , transpose(Rows,Cols), different(Cols)
  , blocks(Rows,Blocks) , different(Blocks)
  , maplist(fd_labeling, Rows)
  .

domain_1_9(Rows) :- fd_domain(Rows,1,9).
different(Rows)  :- maplist(fd_all_different, Rows).

blocks(Rows,Blocks) :-
    maplist(split3,Rows,Xs), transpose(Xs,Ys)
  , concat(Ys,Zs), concat_map(split3,Zs,Blocks)
  . % where
    split3([X,Y,Z|L],[[X,Y,Z]|R]) :- split3(L,R).
    split3([],[]).

% utils/list
concat_map(F,Xs,Ys) :- call(F,Xs,Zs), maplist(concat,Zs,Ys).

concat([],[]).
concat([X|Xs],Ys) :- append(X,Zs,Ys), concat(Xs,Zs).

transpose([],[]).
transpose([[X]|Col], [[X|Row]]) :- transpose(Col,[Row]).
transpose([[X|Row]], [[X]|Col]) :- transpose([Row],Col).
transpose([[X|Row]|Xs], [[X|Col]|Ys]) :-
    maplist(bind_head, Row, Ys, YX)
  , maplist(bind_head, Col, Xs, XY)
  , transpose(XY,YX)
  . % where
    bind_head(H,[H|T],T).
    bind_head([],[],[]).

% tests
test([ [_,_,3,_,_,_,_,_,_]
     , [4,_,_,_,8,_,_,3,6]
     , [_,_,8,_,_,_,1,_,_]
     , [_,4,_,_,6,_,_,7,3]
     , [_,_,_,9,_,_,_,_,_]
     , [_,_,_,_,_,2,_,_,5]
     , [_,_,4,_,7,_,_,6,8]
     , [6,_,_,_,_,_,_,_,_]
     , [7,_,_,6,_,_,5,_,_]
     ]).

main :- test(T), solve(T), maplist(show,T), halt.
show(X) :- write(X), nl.

"Implement a Sudoku solver that takes a partially filled 9x9 grid as input and displays the solved Sudoku in a human-readable format. The solution utilizes the Algorithmics of Sudoku and is adapted for gprolog 1.3.1, running in 0.02 time and using 68352 memory."


Works with: SWI-Prolog
Library: clpfd
:- use_module(library(clpfd)).

caesar :-
	L1 = "The five boxing wizards jump quickly",
	writef("Original : %s\n", [L1]),

	% encryption of the sentence
	encoding(3, L1, L2) ,
	writef("Encoding : %s\n", [L2]),

	% deciphering on the encoded sentence
	encoding(3, L3, L2),
	writef("Decoding : %s\n", [L3]).

% encoding/decoding of a sentence
encoding(Key, L1, L2) :-
	maplist(caesar_cipher(Key), L1, L2).

caesar_cipher(_, 32, 32) :- !.

caesar_cipher(Key, V1, V2) :-
	V #= Key + V1,

	% we verify that we are in the limits of A-Z and a-z.
	((V1 #=< 0'Z #/\ V #> 0'Z) #\/ (V1 #=< 0'z #/\ V #> 0'z)
	#\/
	(V1 #< 0'A #/\ V2 #>= 0'A)#\/ (V1 #< 0'a #/\ V2 #>= 0'a)) #==> A,

	% if we are not in these limits A is 1, otherwise 0.
	V2 #= V - A * 26,

	% compute values of V1 and V2
	label([A, V1, V2]).

implement both encoding and decoding functions of a Caesar cipher. The cipher rotates the alphabet letters based on a key ranging from 1 to 25, replacing each letter with the corresponding next letter in the alphabet. The codes also handle cases of wrapping from Z to A. The codes illustrate that Caesar cipher provides minimal security as it is vulnerable to frequency analysis and brute force attacks. The codes also demonstrate that Caesar cipher is identical to Vigenère cipher with a key length of 1 and to Rot-13 with a key of 13.


calculate the least common multiple (LCM) of two integers m and n. The LCM is the smallest positive integer that has both m and n as factors. If either m or n is zero, the LCM is zero. The LCM can be calculated by iterating all the multiples of m until finding one that is also a multiple of n, or by using the formula |m x n|/gcd(m, n), where gcd is the greatest common divisor. The LCM can also be found by merging the prime decompositions of both m and n.


?- foreach(member(X, [red,green,blue,black,white]), writeln(X)).
red
green
blue
black
white
true.

iterates through each element in a collection in order and prints it, using a "for each" loop or another type of loop if "for each" is not available.


Works with: SWI Prolog
splitup(Sep,[token(B)|BL]) --> splitup(Sep,B,BL).
splitup(Sep,[A|AL],B)      --> [A], {\+ [A] = Sep }, splitup(Sep,AL,B).
splitup(Sep,[],[B|BL])     --> Sep, splitup(Sep,B,BL).
splitup(_Sep,[],[])        --> [].
start :-
    phrase(splitup(",",Tokens),"Hello,How,Are,You,Today"),
    phrase(splitup(".",Tokens),Backtogether),
    string_to_list(ABack,Backtogether),
    writeln(ABack).

"Tokenizes a given string by separating it at commas into an array, then displays each word to the user, separated by a period, using the SWI Prolog string data type and accompanying predicates."


gcd(X, 0, X):- !.
gcd(0, X, X):- !.
gcd(X, Y, D):- X > Y, !, Z is X mod Y, gcd(Y, Z, D).
gcd(X, Y, D):- Z is Y mod X, gcd(X, Z, D).
gcd(X, 0, X):- !.
gcd(0, X, X):- !.
gcd(X, Y, D):- X =< Y, !, Z is Y - X, gcd(X, Z, D).
gcd(X, Y, D):- gcd(Y, X, D).

calculate the greatest common divisor (GCD), also known as the greatest common factor (GCF) or greatest common measure, of two integers. It is related to the task of finding the least common multiple. For more information, refer to the MathWorld and Wikipedia entries on the greatest common divisor.


Works with: SWI-Prolog version 7

numeric_string(String) :-
    atom_string(Atom, String),
    atom_number(Atom, _).

test_strings(Strings) :-
    forall( member(String, Strings),
            ( ( numeric_string(String)
              ->  Result = a
              ;   Result = 'not a' ),
              format('~w is ~w number.~n', [String, Result])
            )
          ).

?- test_strings(["123", "0.123", "-123.1", "NotNum", "1."]).
123 is a number.
0.123 is a number.
-123.1 is a number.
NotNum is not a number.
1. is not a number.
true.

implement a boolean function that checks if a given string can be interpreted as a numeric value, including floating point and negative numbers, in the language's syntax for numeric literals or numbers converted from strings.


Works with: SWI Prolog
Library: clpfd

:- use_module(library(clpfd)).

% tuples (name, weights, value, nb pieces).
knapsack :-
	L = [(   map, 	        9, 	150, 	1),
	     (   compass, 	13, 	35, 	1),
	     (   water, 	153, 	200, 	2),
	     (   sandwich, 	50, 	60, 	2),
	     (   glucose, 	15, 	60, 	2),
	     (   tin, 	68, 	45, 	3),
	     (   banana, 	27, 	60, 	3),
	     (   apple, 	39, 	40, 	3),
	     (   cheese, 	23, 	30, 	1),
	     (   beer, 	52, 	10, 	3),
	     (   'suntan cream', 	11, 	70, 	1),
	     (   camera, 	32, 	30, 	1),
	     (   'T-shirt', 	24, 	15, 	2),
	     (   trousers, 	48, 	10, 	2),
	     (   umbrella, 	73, 	40, 	1),
	     (   'waterproof trousers', 	42, 	70, 	1),
	     (   'waterproof overclothes', 	43, 	75, 	1),
	     (   'note-case', 	22, 	80, 	1),
	     (   sunglasses, 	7, 	20, 	1),
	     (   towel, 	18, 	12, 	2),
	     (   socks, 	4, 	50, 	1),
	     (   book, 	30, 	10, 	2)],

	% Takes is the list of the numbers of each items
	% these numbers are between 0 and the 4th value of the tuples of the items
        maplist(collect, L, Ws, Vs, Takes),
        scalar_product(Ws, Takes, #=<, 400),
        scalar_product(Vs, Takes, #=, VM),

	% to have statistics on the resolution of the problem.
	time(labeling([max(VM), down], Takes)),
        scalar_product(Ws, Takes, #=, WM),

	%% displayinf of the results.
	compute_lenword(L, 0, Len),
	sformat(A1, '~~w~~t~~~w|', [Len]),
	sformat(A2, '~~t~~w~~~w|', [4]),
	sformat(A3, '~~t~~w~~~w|', [5]),
	print_results(A1,A2,A3, L, Takes, WM, VM).

collect((_, W, V, N), W, V, Take) :-
	Take in 0..N.

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
compute_lenword([], N, N).
compute_lenword([(Name, _, _, _)|T], N, NF):-
	atom_length(Name, L),
	(   L > N -> N1 = L; N1 = N),
	compute_lenword(T, N1, NF).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
print_results(A1,A2,A3, [], [], WM, WR) :-
	sformat(W0, '~w ', [' ']),
	sformat(W1, A1, [' ']),
	sformat(W2, A2, [WM]),
	sformat(W3, A3, [WR]),
	format('~w~w~w~w~n', [W0,W1,W2,W3]).

print_results(A1,A2,A3, [_H|T], [0|TR], WM, VM) :-
	!,
	print_results(A1,A2,A3, T, TR, WM, VM).

print_results(A1, A2, A3, [(Name, W, V, _)|T], [N|TR], WM, VM) :-
	sformat(W0, '~w ', [N]),
	sformat(W1, A1, [Name]),
	sformat(W2, A2, [W]),
	sformat(W3, A3, [V]),
	format('~w~w~w~w~n', [W0,W1,W2,W3]),
	print_results(A1, A2, A3, T, TR, WM, VM).

The code determines the optimal combination of items a tourist should carry in his knapsack, given a maximum weight limit of 4 kg. The selection is made based on the value and weight of each item, with the aim to maximize the total value without exceeding the weight limit. The code uses the clpfd and simplex libraries by Markus Triska for computation.


incr_numerical_string(S1, S2) :-
	string_to_atom(S1, A1),
	atom_number(A1, N1),
	N2 is N1+1,
	atom_number(A2, N2),
	string_to_atom(S2, A2).

"Increments a numerical string using SWI-Prolog."


%! directory_prefix(PATHs,STOP0,PREFIX)

directory_prefix([],_STOP0_,'')
:-
!
.

directory_prefix(PATHs0,STOP0,PREFIX)
:-
prolog:once(longest_prefix(PATHs0,STOP0,LONGEST_PREFIX)) ->
prolog:atom_concat(PREFIX,STOP0,LONGEST_PREFIX) ;
PREFIX=''
.

%! longest_prefix(PATHs,STOP0,PREFIX)

longest_prefix(PATHs0,STOP0,PREFIX)
:-
QUERY=(shortest_prefix(PATHs0,STOP0,SHORTEST_PREFIX)) ,
prolog:findall(SHORTEST_PREFIX,QUERY,SHORTEST_PREFIXs) ,
lists:reverse(SHORTEST_PREFIXs,LONGEST_PREFIXs) ,
lists:member(PREFIX,LONGEST_PREFIXs)
.

%! shortest_prefix(PATHs,STOP0,PREFIX)

shortest_prefix([],_STOP0_,_PREFIX_) .

shortest_prefix([PATH0|PATHs0],STOP0,PREFIX)
:-
starts_with(PATH0,PREFIX) ,
ends_with(PREFIX,STOP0) ,
shortest_prefix(PATHs0,STOP0,PREFIX)
.

%! starts_with(TARGET,START)

starts_with(TARGET,START)
:-
prolog:atom_concat(START,_,TARGET)
.

%! ends_with(TARGET,END)

ends_with(TARGET,END)
:-
prolog:atom_concat(_,END,TARGET)
.

The code finds the common directory path from a given set of directory paths using a specified directory separator character. It tests the functionality using '/' as the directory separator and three specific strings as input paths. The code ensures the returned path is a valid directory, not just the longest common string.


median(L, Z) :-
    length(L, Length),
    I is Length div 2,
    Rem is Length rem 2,
    msort(L, S),
    maplist(sumlist, [[I, Rem], [I, 1]], Mid),
    maplist(nth1, Mid, [S, S], X),
    sumlist(X, Y),
    Z is Y/2.

The code calculates the median value of a vector of floating-point numbers. It handles even number of elements by returning the average of the two middle values. The median is found using the selection algorithm for optimal time complexity. The code also includes tasks for calculating various statistical measures like mean, mode, and standard deviation. It also calculates moving (sliding window and cumulative) averages and different types of means such as arithmetic, geometric, harmonic, quadratic, and circular.


Works with: SWI Prolog version 4.8.0
Works with: Ciao Prolog version 1.21.0

fizzbuzz :-
   forall(between(1, 100, X), print_item(X)).

print_item(X) :-
   (  X mod 15 =:= 0
   -> write('FizzBuzz')
   ;  X mod 3 =:= 0
   -> write('Fizz')
   ;  X mod 5 =:= 0
   -> write('Buzz')
   ;  write(X)
   ),
   nl.

fizzbuzz(X) :- X mod 15 =:= 0, !, write('FizzBuzz').
fizzbuzz(X) :- X mod 3 =:= 0, !, write('Fizz').
fizzbuzz(X) :- X mod 5 =:= 0, !, write('Buzz').
fizzbuzz(X) :- write(X).

dofizzbuzz :-between(1, 100, X), fizzbuzz(X), nl, fail.
dofizzbuzz.

%        N  /3?  /5?  V
fizzbuzz(_, yes, yes, 'FizzBuzz').
fizzbuzz(_, yes, no,  'Fizz').
fizzbuzz(_, no,  yes, 'Buzz').
fizzbuzz(N, no,  no,  N).

% Unifies V with 'yes' if D divides evenly into N, 'no' otherwise.
divisible_by(N, D, yes) :- N mod D =:= 0.
divisible_by(N, D, no) :- N mod D =\= 0.

% Print 'Fizz', 'Buzz', 'FizzBuzz' or N as appropriate.
fizz_buzz_or_n(N) :- N > 100.
fizz_buzz_or_n(N) :- N =< 100,
   divisible_by(N, 3, Fizz),
   divisible_by(N, 5, Buzz),
   fizzbuzz(N, Fizz, Buzz, FB),
   write(FB), nl,
   M is N+1, fizz_buzz_or_n(M).

main :-
   fizz_buzz_or_n(1).

Works with: SWI Prolog version 8.2.1 Works with: Scryer Prolog version 0.7.8
% This implementation uses modern Prolog techniques
% in order to be an idiomatic solution that uses logical purity, generality and determinism wherever possible:
% - CLP(Z): constraint logic programming on integers.
% - library(reif): efficient logical predicates based on 'Indexing dif/2'.
:- module(fizz_buzz, [main/0, integer_fizzbuzz_below_100/2, integer_fizzbuzz/2]).

:- use_module(library(reif)).

% for Scryer-Prolog:
:- use_module(library(clpz)).
:- use_module(library(between)).
:- use_module(library(iso_ext)).
:- use_module(library(si)).

% for SWI-Prolog:
% :- use_module(library(clpfd)).

% Prints all solutions to `integer_fizzbuzz_below_100` each on a separate line, in order.
% Logically-impure shell, as currently there is no logically-pure way to write to a filestream.
main :-
    forall(integer_fizzbuzz_below_100(_, FizzBuzz), write_line(FizzBuzz)).

write_line(Value) :-
    write(Value),
    nl.

% Constrains FizzBuzz results to the range 1 <= X <= 100,
% and (for the 'most general query' where neither X or FizzBuzz is concrete)
% ensures results are traversed in order low -> high X.
%
% ?- integer_fizzbuzz_below_100(X, FizzBuzz) % generate all the results in order
% ?- integer_fizzbuzz_below_100(27, Result) % Find out what output `27` will produce (it's 'Fizz'.)
% ?- integer_fizzbuzz_below_100(X, 'Fizz')   % generate all the numbers which would print 'Fizz' in order (3, 6, 9, etc).
% ?- integer_fizzbuzz_below_100(X, Res), integer_si(Res) % generate all the numbers which would print themselves in order (1, 2, 4, 6, 7, 8, 11, etc).
% ?- integer_fizzbuzz_below_100(X, Res), is_of_type(integer, Res) % SWI-Prolog version doing the same.
integer_fizzbuzz_below_100(X, FizzBuzz) :-
    between(1, 100, X),
    integer_fizzbuzz(X, FizzBuzz).

% States the relationship between a number
% and its FizzBuzz representation.
%
% Because constraints are propagated lazily,
% prompting this predicate without having constrained `Num`
% to a particular integer value will give you its definition back.
% Put differently: This predicate returns the whole solution space at once,
% and external labeling techniques are required to traverse and concretize this solution space
% in an order that we like.
integer_fizzbuzz(Num, FizzBuzz) :-
    if_(Num mod 15 #= 0, FizzBuzz = 'FizzBuzz',
        if_(Num mod 5 #= 0, FizzBuzz = 'Buzz',
            if_(Num mod 3 #= 0, FizzBuzz = 'Fizz',
                Num = FizzBuzz)
           )
       ).

% Reifiable `#=`.
#=(X, Y, T) :-
    X #= X1,
    Y #= Y1,
    zcompare(C, X1, Y1),
    eq_t(C, T).

eq_t(=, true).
eq_t(<, false).
eq_t(>, false).

The code prints numbers from 1 to 100, replacing multiples of three with 'Fizz', multiples of five with 'Buzz', and multiples of both three and five with 'FizzBuzz'. It uses different Prolog techniques for looping, including higher-order predicates, failure-driven loops, and tail recursion.


:- use_module(library(pce)).

mandelbrot :-
    new(D, window('Mandelbrot Set')),
    send(D, size, size(700, 650)),
    new(Img, image(@nil, width := 700, height := 650, kind := pixmap)),

    forall(between(0,699, I),
           (   forall(between(0,649, J),
              (   get_RGB(I, J, R, G, B),
                  R1 is (R * 256) mod 65536,
                  G1 is (G * 256) mod 65536,
                  B1 is (B * 256) mod 65536,
                  send(Img, pixel(I, J, colour(@default, R1, G1, B1))))))),
    new(Bmp, bitmap(Img)),
    send(D, display, Bmp, point(0,0)),
    send(D, open).

get_RGB(X, Y, R, G, B) :-
    CX is (X - 350) / 150,
    CY is (Y - 325) / 150,
    Iter = 570,
    compute_RGB(CX, CY, 0, 0, Iter, It),
    IterF is It \/ It << 15,
    R is IterF >> 16,
    Iter1 is IterF - R << 16,
    G is Iter1 >> 8,
    B  is Iter1 - G << 8.

compute_RGB(CX, CY, ZX, ZY, Iter, IterF) :-
    ZX * ZX + ZY * ZY < 4,
    Iter > 0,
    !,
    Tmp is  ZX * ZX - ZY * ZY + CX,
    ZY1 is 2 * ZX * ZY + CY,
    Iter1 is Iter - 1,
    compute_RGB(CX, CY, Tmp, ZY1, Iter1, IterF).

compute_RGB(_CX, _CY, _ZX, _ZY, Iter, Iter).Example :

generate and draw the Mandelbrot set using various algorithms and functions, utilizing the graphic interface XPCE of SWI-Prolog.


sum([],0).
sum([H|T],X) :- sum(T,Y), X is H + Y.
product([],1).
product([H|T],X) :- product(T,Y), X is H * X.

:- sum([1,2,3,4,5,6,7,8,9],X).
X =45;
:- product([1,2,3,4,5],X).
X = 120;

add(A,B,R):-
    R is A + B.

mul(A,B,R):-
    R is A * B.

% define fold now.
fold([], Act, Init, Init).

fold(Lst, Act, Init, Res):-
    head(Lst,Hd),
    tail(Lst,Tl),
    apply(Act,[Init, Hd, Ra]),
    fold(Tl, Act, Ra, Res).

sumproduct(Lst, Sum, Prod):-
    fold(Lst,mul,1, Prod),
    fold(Lst,add,0, Sum).

?- sumproduct([1,2,3,4],Sum,Prod).
Sum = 10,
Prod = 24 .

"Calculates the sum and product of an array of integers using fold method."


Works with: SWI-Prolog
leap_year(L) :-
	partition(is_leap_year, L, LIn, LOut),
	format('leap years : ~w~n', [LIn]),
	format('not leap years : ~w~n', [LOut]).

is_leap_year(Year) :-
	R4 is Year mod 4,
	R100 is Year mod 100,
	R400 is Year mod 400,
	(   (R4 = 0, R100 \= 0); R400 = 0).

determine if a given year is a leap year in the Gregorian calendar using a built-in function.


dept(X) :- between(1, 7, X).

police(X) :- member(X, [2, 4, 6]).
fire(X)   :- dept(X).
san(X)    :- dept(X).

assign(A, B, C) :-
    police(A), fire(B), san(C),
    A =\= B, A =\= C, B =\= C,
    12 is A + B + C.

main :-
    write("P F S"), nl,
    forall(assign(Police, Fire, Sanitation), format("~w ~w ~w~n", [Police, Fire, Sanitation])),
    halt.

?- main.

all possible combinations of unique numbers between 1 and 7 (inclusive) for three different departments (police, sanitation, fire) that add up to 12, with the police department number being an even number.


?- A = "A test string", A = B.
A = B, B = "A test string".

distinguish between copying a string's content and creating an additional reference to an existing string in Prolog, considering that values in Prolog are immutable and a variable can't be reassigned once it has been unified with a string value.


implement two mutually recursive functions to compute the Hofstadter Female and Male sequences. The functions handle cases where a language does not support mutual recursion by stating this limitation.


Works with: SWI-Prolog version 6
?- random_member(M, [a, b, c, d, e, f, g, h, i, j]).
M = i.

demonstrate how to select a random element from a list.


bin_search(Elt,List,Result):-
  length(List,N), bin_search_inner(Elt,List,1,N,Result).

bin_search_inner(Elt,List,J,J,J):-
  nth(J,List,Elt).
bin_search_inner(Elt,List,Begin,End,Mid):-
  Begin < End,
  Mid is (Begin+End) div 2,
  nth(Mid,List,Elt).
bin_search_inner(Elt,List,Begin,End,Result):-
  Begin < End,
  Mid is (Begin+End) div 2,
  nth(Mid,List,MidElt),
  MidElt < Elt,
  NewBegin is Mid+1,
  bin_search_inner(Elt,List,NewBegin,End,Result).
bin_search_inner(Elt,List,Begin,End,Result):-
  Begin < End,
  Mid is (Begin+End) div 2,
  nth(Mid,List,MidElt),
  MidElt > Elt,
  NewEnd is Mid-1,
  bin_search_inner(Elt,List,Begin,NewEnd,Result).

Output examples:
 ?- bin_search(4,[1,2,4,8,16,32,64,128],Result).
Result = 3.

?- bin_search(5,[1,2,4,8],Result).
Result = -1.

The code implements a binary search algorithm, which divides a range of values into halves to find an unknown value. It includes both recursive and iterative versions of the traditional algorithm, as well as versions that return the leftmost and rightmost insertion points for the given value. The code also handles potential overflow bugs. The binary search is performed on a sorted integer array, and the index of the found number is returned, along with a message indicating whether the number was found in the array.


:-
    current_prolog_flag(os_argv, Args),
    write(Args).

:-
    current_prolog_flag(argv, Args),
    write(Args).

"Code retrieves and prints the list of command-line arguments given to the program. It uses os_argv or argv to access arguments not consumed by the Prolog interpreter, excluding the interpreter name, input Prolog filename, and any other arguments directed at the Prolog interpreter."


:- use_module(library(pce)).

pendulum :-
	new(D, window('Pendulum')),
	send(D, size, size(560, 300)),
	new(Line, line(80, 50, 480, 50)),
	send(D, display, Line),
	new(Circle, circle(20)),
	send(Circle, fill_pattern,  colour(@default, 0, 0, 0)),
	new(Boule, circle(60)),
	send(Boule, fill_pattern,  colour(@default, 0, 0, 0)),
	send(D, display, Circle, point(270,40)),
	send(Circle, handle, handle(h/2, w/2, in)),
	send(Boule, handle, handle(h/2, w/2, out)),
	send(Circle, connect, Boule, link(in, out, line(0,0,0,0,none))),
	new(Anim, animation(D, 0.0, Boule, 200.0)),
	send(D, done_message, and(message(Anim, free),
				  message(Boule, free),
				  message(Circle, free),
				  message(@receiver,destroy))),
	send(Anim?mytimer, start),
	send(D, open).

:- pce_begin_class(animation(window, angle, boule, len_pendulum), object).
variable(window, object,  both, "Display window").
variable(boule,  object, both,  "bowl of the pendulum").
variable(len_pendulum,    object, both,  "len of the pendulum").
variable(angle,  object, both,  "angle with the horizontal").
variable(delta,    object, both,  "increment of the angle").
variable(mytimer, timer, both, "timer of the animation").

initialise(P, W:object, A:object, B : object, L:object) :->
        "Creation of the object"::
        send(P, window, W),
        send(P, angle, A),
        send(P, boule, B),
        send(P, len_pendulum, L),
        send(P, delta, 0.01),
	send(P, mytimer, new(_, timer(0.01,message(P, anim_message)))).

% method called when the object is destroyed
% first the timer is stopped
% then all the resources are freed
unlink(P) :->
	send(P?mytimer, stop),
	send(P, send_super, unlink).

% message processed by the timer
anim_message(P) :->
	get(P, angle, A),
	get(P, len_pendulum, L),
	calc(A, L, X, Y),
	get(P, window, W),
	get(P, boule, B),
	send(W, display, B, point(X,Y)),
	% computation of the next position
	get(P, delta, D),
	next_Angle(A, D, NA, ND),
	send(P, angle, NA),
	send(P, delta, ND).

:- pce_end_class.

% computation of the position of the bowl.
calc(Ang, Len, X, Y) :-
	X is Len * cos(Ang)+ 250,
	Y is Len * sin(Ang) + 20.

% computation of the next angle
% if we reach 0 or pi, delta change.
next_Angle(A, D, NA, ND) :-
	NA is D + A,
	(((D > 0,   abs(pi-NA) < 0.01); (D < 0, abs(NA) < 0.01))->
	  ND = - D;
	  ND = D).

simulate and animate a simple gravity pendulum using SWI-Prolog's graphic interface XPCE.


:- use_module([ library(http/json),
                library(func) ]).

test_json('{"widget": { "debug": "on", "window": { "title": "Sample Konfabulator Widget", "name": "main_window", "width": 500, "height": 500 }, "image": { "src": "Images/Sun.png", "name": "sun1", "hOffset": 250, "vOffset": 250, "alignment": "center" }, "text": { "data": "Click Here", "size": 36, "style": "bold", "name": "text1", "hOffset": 250, "vOffset": 100, "alignment": "center", "onMouseUp": "sun1.opacity = (sun1.opacity / 100) * 90;" }}}').

reading_JSON_term :-
    atom_json_dict(test_json(~), Dict, []), %% This accomplishes reading in the JSON data
    writeln( 'JSON as Prolog dict: ~w~n'
           $ Dict),
    writeln( 'Access field "widget.text.data": ~s~n'
           $ Dict.widget.text.data),
    writeln( 'Alter field "widget": ~w~n'
           $ Dict.put(widget, "Altered")).

searalize_a_JSON_term :-
    Dict = _{book:_{title:"To Mock a Mocking Bird",
                    author:_{first_name:"Ramond",
                             last_name:"Smullyan"},
                    publisher:"Alfred A. Knopf",
                    year:1985
                   }},
    json_write(current_output, Dict). %% This accomplishes serializing the JSON object.

utilize SWI-Prolog 7's library(http/json) and the new dict datatype to handle JSON objects. They load a JSON string into a data structure and create a new data structure, serializing it into JSON. The code ensures the JSON is valid and uses objects and arrays as appropriate for the language. The serialization and parsing are accomplished with two predicates.


iroot(_, 0, 0) :- !.
iroot(M, N, R) :-
    M > 1,
    (N > 0 ->
        irootpos(M, N, R)
    ;
        N /\ 1 =:= 1,
        NegN is -N, irootpos(M, NegN, R0), R is -R0).

irootpos(N, A, R) :-
    X0 is 1 << (msb(A) div N),  % initial guess is 2^(log2(A) / N)
    newton(N, A, X0, X1),
    iroot_loop(A, X1, N, A, R).

iroot_loop(X1, X2, _, _, X1) :- X1 =< X2, !.
iroot_loop(_, X1, N, A, R) :-
    newton(N, A, X1, X2),
    iroot_loop(X1, X2, N, A, R).

newton(2, A, X0, X1) :- X1 is (X0 + A div X0) >> 1, !.  % fast special case
newton(N, A, X0, X1) :- X1 is ((N - 1)*X0 + A div X0**(N - 1)) div N.

Implement an algorithm to compute the principal nth root of a positive real number using integer math, with the ability to approximate non-integral roots to arbitrary precision.


Works with: GNU Prolog
:- initialization(main).

answer(24).
play :- round, play ; true.

round :-
    prompt(Ns), get_line(Input), Input \= "stop"
  , ( phrase(parse(Ns,[]), Input) -> Result = 'correct'
                                   ; Result = 'wrong'
    ), write(Result), nl, nl
  . % where
    prompt(Ns)  :- length(Ns,4), maplist(random(1,10), Ns)
                 , write('Digits: '), write(Ns), nl
                 .

parse([],[X])     --> { answer(X) }.
parse(Ns,[Y,X|S]) --> "+", { Z is X  +  Y }, parse(Ns,[Z|S]).
parse(Ns,[Y,X|S]) --> "-", { Z is X  -  Y }, parse(Ns,[Z|S]).
parse(Ns,[Y,X|S]) --> "*", { Z is X  *  Y }, parse(Ns,[Z|S]).
parse(Ns,[Y,X|S]) --> "/", { Z is X div Y }, parse(Ns,[Z|S]).
parse(Ns,Stack)   --> " ", parse(Ns,Stack).
parse(Ns,Stack)   --> { select(N,Ns,Ns1), number_codes(N,[Code]) }
                    , [Code], parse(Ns1,[N|Stack])
                    .

get_line(Xs) :- get_code(X)
              , ( X == 10 -> Xs = [] ; Xs = [X|Ys], get_line(Ys) )
              .
main :- randomize, play, halt.

Digits: [9,4,6,9]
46*9-9+
correct

Digits: [7,4,7,8]
8 4 7 7 / - *
correct

Digits: [7,2,8,2]
7282---
wrong

Digits: [2,6,7,1]
4611***
wrong

Digits: [3,6,5,8]
+
wrong

Digits: [2,1,7,7]
stop

The code generates four random digits from 1 to 9, prompts the player to form an arithmetic expression using those digits exactly once each, and checks if the expression evaluates to 24. The code supports addition, subtraction, multiplication, and division operations, and allows the use of brackets. It does not allow forming multiple digit numbers from the given digits. The order of the digits does not need to be preserved. The code does not generate or test the validity of the expression.


% the test
run_length :-
	L = "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW",
	writef('encode %s\n', [L]),
	encode(L, R),
	writeln(R), nl,
	writef('decode %w\n', [R]),
	decode(R, L1),
	writeln(L1).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%  encode
%
%  translation
%  from
%  "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
%  to
%  "12W1B12W3B24W1B14W"
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
encode(In, Out) :-
	% Because of the special management of the "strings" by Prolog
	( is_list(In) -> I = In; string_to_list(In, I)),
	packList(I, R1),
	dcg_packList2List(R1,R2, []),
	string_to_list(Out,R2).

dcg_packList2List([[N, V]|T]) -->
	{ number_codes(N, LN)},
	LN,
	[V],
	dcg_packList2List(T).

dcg_packList2List([]) --> [].

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%  decode
%
%  translation
%  from
%  "12W1B12W3B24W1B14W"
%  to
%  "WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW"
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
decode(In, Out) :-
	% Because of the special management of the "strings" by Prolog
	( is_list(In) -> I = In; string_to_list(In, I)),
	dcg_List2packList(I, R1, []),
	packList(L1, R1),
	string_to_list(Out, L1).

dcg_List2packList([H|T]) -->
	{code_type(H, digit)},
	parse_number([H|T], 0).

dcg_List2packList([]) --> [].

parse_number([H|T], N) -->
	{code_type(H, digit), !,
	N1 is N*10 + H - 48 },
	parse_number(T, N1).

parse_number([H|T], N) -->
	[[N, H]],
	dcg_List2packList(T).

% use of library clpfd allows packList(?In, ?Out) to works
% in both ways In --> Out and In <-- Out.

:- use_module(library(clpfd)).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% ?- packList([a,a,a,b,c,c,c,d,d,e], L).
%  L = [[3,a],[1,b],[3,c],[2,d],[1,e]] .
% ?- packList(R,  [[3,a],[1,b],[3,c],[2,d],[1,e]]).
% R = [a,a,a,b,c,c,c,d,d,e] .
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
packList([],[]).

packList([X],[[1,X]]) :- !.

packList([X|Rest],[XRun|Packed]):-
    run(X,Rest, XRun,RRest),
    packList(RRest,Packed).

run(Var,[],[1,Var],[]).

run(Var,[Var|LRest],[N1, Var],RRest):-
    N #> 0,
    N1 #= N + 1,
    run(Var,LRest,[N, Var],RRest).

run(Var,[Other|RRest], [1,Var],[Other|RRest]):-
    dif(Var,Other).

 ?- run_length.
encode WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
12W1B12W3B24W1B14W

decode 12W1B12W3B24W1B14W
WWWWWWWWWWWWBWWWWWWWWWWWWBBBWWWWWWWWWWWWWWWWWWWWWWWWBWWWWWWWWWWWWWW
true .

implement a run-length encoding and decoding system. The system takes a string of uppercase characters, compresses repeated characters by storing the length of the character run, and provides a function to reverse the compression. The output can be any format that can recreate the original input.


determine the optimal selection of items a thief can carry in his knapsack, given a weight limit of 15 kg. The items can be cut, with their value decreasing proportionally to their weight. The goal is to maximize the total value of the items in the knapsack. The items available, their weights and values are provided. The solution uses SWI-Prolog and the simplex library.


Works with: SWI-Prolog version 5.10.0
:- use_module(library( http/http_open )).

anagrams:-
        % we read the URL of the words
	http_open('http://wiki.puzzlers.org/pub/wordlists/unixdict.txt',	In, []),
	read_file(In, [], Out),
	close(In),

        % we get a list of pairs key-value where key = a-word value = <list-of-its-codes>
        % this list must be sorted
	msort(Out, MOut),

        % in order to gather values with the same keys
	group_pairs_by_key(MOut, GPL),

        % we sorted this list in decreasing order of the length of values
	predsort(my_compare, GPL, GPLSort),

	% we extract the first 6 items
        GPLSort = [_H1-T1, _H2-T2, _H3-T3, _H4-T4, _H5-T5, _H6-T6 | _],

        % Tnn are lists of codes (97 for 'a'), we create the strings
	maplist(maplist(atom_codes), L, [T1, T2, T3, T4, T5, T6] ),

	maplist(writeln, L).

read_file(In, L, L1) :-
	read_line_to_codes(In, W),
	(   W == end_of_file ->
               % the file is read
	       L1 = L
	       ;
               % we sort the list of codes of the line
	       msort(W, W1),

               % to create the key in alphabetic order
	       atom_codes(A, W1),

               % and we have the pair Key-Value in the result list
	       read_file(In, [A-W | L], L1)).

% predicate for sorting list of pairs Key-Values
% if the lentgh of values is the same
% we sort the keys in alhabetic order
my_compare(R, K1-V1, K2-V2) :-
	length(V1, L1),
	length(V2, L2),
	(   L1 < L2 -> R = >; L1 > L2 -> R = <; compare(R, K1, K2)).

[abel,able,bale,bela,elba]
[caret,carte,cater,crate,trace]
[angel,angle,galen,glean,lange]
[alger,glare,lager,large,regal]
[elan,lane,lean,lena,neal]
[evil,levi,live,veil,vile]
true

find the largest sets of anagrams from the word list provided at http://wiki.puzzlers.org/pub/wordlists/unixdict.txt.


Works with: SWI Prolog

main:-
    write_sierpinski_carpet('sierpinski_carpet.svg', 486, 4).

write_sierpinski_carpet(File, Size, Order):-
    open(File, write, Stream),
    format(Stream,
           "<svg xmlns='http://www.w3.org/2000/svg' width='~d' height='~d'>\n",
           [Size, Size]),
    write(Stream, "<rect width='100%' height='100%' fill='white'/>\n"),
    Side is Size/3.0,
    sierpinski_carpet(Stream, 0, 0, Side, Order),
    write(Stream, "</svg>\n"),
    close(Stream).

sierpinski_carpet(Stream, X, Y, Side, 0):-
    !,
    X0 is X + Side,
    Y0 is Y + Side,
    write_square(Stream, X0, Y0, Side).
sierpinski_carpet(Stream, X, Y, Side, Order):-
    Order1 is Order - 1,
    Side1 is Side / 3.0,
    X0 is X + Side,
    Y0 is Y + Side,
    X1 is X0 + Side,
    Y1 is Y0 + Side,
    write_square(Stream, X0, Y0, Side),
    sierpinski_carpet(Stream, X, Y, Side1, Order1),
    sierpinski_carpet(Stream, X0, Y, Side1, Order1),
    sierpinski_carpet(Stream, X1, Y, Side1, Order1),
    sierpinski_carpet(Stream, X, Y0, Side1, Order1),
    sierpinski_carpet(Stream, X1, Y0, Side1, Order1),
    sierpinski_carpet(Stream, X, Y1, Side1, Order1),
    sierpinski_carpet(Stream, X0, Y1, Side1, Order1),
    sierpinski_carpet(Stream, X1, Y1, Side1, Order1).

write_square(Stream, X, Y, Side):-
    format(Stream,
           "<rect fill='black' x='~g' y='~g' width='~g' height='~g'/>\n",
           [X, Y, Side, Side]).

generate a graphical or ASCII-art representation of a Sierpinski carpet of a given order N. The representation uses whitespace and non-whitespace characters, specifically the '#' character. The program also produces an SVG format image file of the Sierpinski carpet.


huffman :-
	L = 'this is an example for huffman encoding',
	atom_chars(L, LA),
	msort(LA, LS),
	packList(LS, PL),
	sort(PL, PLS),
	build_tree(PLS, A),
	coding(A, [], C),
	sort(C, SC),
	format('Symbol~t   Weight~t~30|Code~n'),
	maplist(print_code, SC).

build_tree([[V1|R1], [V2|R2]|T], AF) :-
	V is V1 + V2,
	A = [V, [V1|R1], [V2|R2]],
	(   T=[] -> AF=A ;  sort([A|T], NT), build_tree(NT, AF) ).

coding([_A,FG,FD], Code, CF) :-
	(   is_node(FG) ->  coding(FG, [0 | Code], C1)
			 ;  leaf_coding(FG, [0 | Code], C1) ),
	(   is_node(FD) ->  coding(FD, [1 | Code], C2)
			 ;  leaf_coding(FD, [1 | Code], C2) ),
	append(C1, C2, CF).

leaf_coding([FG,FD], Code, CF) :-
	reverse(Code, CodeR),
	CF = [[FG, FD, CodeR]] .

is_node([_V, _FG, _FD]).

print_code([N, Car, Code]):-
	format('~w :~t~w~t~30|', [Car, N]),
	forall(member(V, Code), write(V)),
	nl.

packList([], []).
packList([X], [[1,X]]) :- !.
packList([X|Rest], [XRun|Packed]):-
    run(X, Rest, XRun, RRest),
    packList(RRest, Packed).

run(V, [], [1,V], []).
run(V, [V|LRest], [N1,V], RRest):-
    run(V, LRest, [N, V], RRest),
    N1 is N + 1.
run(V, [Other|RRest], [1,V], [Other|RRest]):-
    dif(V, Other).

The code generates a Huffman encoding for each character in the given string "this is an example for huffman encoding". It first creates a priority queue with a leaf node for each character symbol based on their frequency of occurrence. It then constructs a binary tree by removing the two nodes with the highest priority (lowest probability) from the queue and creating a new internal node with these two nodes as children. This process continues until there is only one node left in the queue, which becomes the root node. The code then traverses the binary tree from root to leaves, assigning '0' for one branch and '1' for the other at each node. The accumulated zeros and ones at each leaf constitute the Huffman encoding for the corresponding symbol. The result is a table of Huffman encodings for each character in the string. The code is compatible with SWI-Prolog.


:- dynamic click/1.

dialog('Simple windowed application',
       [ object        :=
	   Simple_windowed_application,
	 parts         :=
	   [ Simple_windowed_application :=
	       dialog('Simple windowed application'),
	     Name                       :=
	       label(name, 'There have been no clicks yet'),
	     BtnClick                     :=
	       button(button)
	   ],
	 modifications :=
	   [ BtnClick := [ label := 'Click me !'
		       ]
	   ],
	 layout        :=
	   [ area(Name,
		  area(40, 20, 200, 18)),
	     area(BtnClick,
		  area(90, 60, 80, 24))
	   ],
	 behaviour :=
	 [
	  BtnClick := [message := message(@prolog, btnclick, Name)]
	 ]
       ]).

btnclick(Label) :-
	retract(click(V)),
	V1 is V+1,
	assert(click(V1)),
	sformat(A, '~w click(s)', [V1]),
	send(Label, selection, A).

simple_windowed :-
	retractall(click(_)),
	assert(click(0)),
	make_dialog(D, 'Simple windowed application'),
	send(D, open).

"Implements a simple windowed application using SWI-Prolog and XPCE. The application features a window with a label displaying the text 'There have been no clicks yet' and a button labeled 'click me'. The label updates to show the number of times the button has been clicked each time the button is pressed."


rfor(Hi,Lo,Hi) :- Hi >= Lo.
rfor(Hi,Lo,Val) :- Hi > Lo, H is Hi - 1, !, rfor(H,Lo,Val).

reverse_iter :-
  rfor(10,0,Val), write(Val), nl, fail.
reverse_iter.
?- reverse_iter.
10
9
8
7
6
5
4
3
2
1
0
true.

implement a for loop that counts down from 10 to 0 using Prolog, which doesn't have a built-in iterator for descending values.


for(Lo,Hi,Step,Lo)  :- Step>0, Lo=<Hi.
for(Lo,Hi,Step,Val) :- Step>0, plus(Lo,Step,V), V=<Hi, !, for(V,Hi,Step,Val).

example :-
  for(0,10,2,Val), write(Val), write(' '), fail.
example.
?- example.
0 2 4 6 8 10
true.

for(Hi,Lo,Step,Hi)  :- Step<0, Lo=<Hi.
for(Hi,Lo,Step,Val) :- Step<0, plus(Hi,Step,V), Lo=<V, !, for(V,Lo,Step,Val).

demonstrate a for-loop with a step-value greater than one and also include a stepping iterator that allows backward iteration.


xor_pattern :-
	new(D, window('XOR Pattern')),
	send(D, size, size(512,512)),
	new(Img, image(@nil, width := 512, height := 512 , kind := pixmap)),

	forall(between(0,511, I),
	       (   forall(between(0,511, J),
			  (   V is I xor J,
			      R is (V * 1024) mod 65536,
			      G is (65536 - V * 1024) mod 65536,
			      (	  V mod 2 =:= 0
			      ->  B is  (V * 4096) mod 65536
			      ;	   B is  (65536 - (V * 4096)) mod 65536),
			      send(Img, pixel(I, J, colour(@default, R, G, B))))))),

	new(Bmp, bitmap(Img)),
	send(D, display, Bmp, point(0,0)),
	send(D, open).

The code generates a graphical pattern where each pixel's color is determined by the 'x xor y' value from a color table, using SWI-Prolog and its GUI XPCE for rendering munching squares.


:- dynamic cell/2.

maze(Lig,Col) :-
	retractall(cell(_,_)),

	new(D, window('Maze')),

	% creation of the grid
	forall(between(0,Lig, I),
	       (XL is  50, YL is I * 30 + 50,
		XR is Col * 30 + 50,
		new(L, line(XL, YL, XR, YL)),
		send(D, display, L))),

	forall(between(0,Col, I),
	       (XT is  50 + I * 30, YT is 50,
		YB is Lig * 30 + 50,
		new(L, line(XT, YT, XT, YB)),
		send(D, display, L))),

	SX is Col * 30 + 100,
	SY is Lig * 30 + 100,
	send(D, size, new(_, size(SX, SY))),

	% choosing a first cell
	L0 is random(Lig),
	C0 is random(Col),
	assert(cell(L0, C0)),
	\+search(D, Lig, Col, L0, C0),
	send(D, open).

search(D, Lig, Col, L, C) :-
	Dir is random(4),
	nextcell(Dir, Lig, Col, L, C, L1, C1),
	assert(cell(L1,C1)),
	assert(cur(L1,C1)),
	erase_line(D, L, C, L1, C1),
	search(D, Lig, Col, L1, C1).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
erase_line(D, L, C, L, C1) :-
	(   C < C1 -> C2 = C1; C2 = C),
	XT is C2  * 30 + 50,
	YT is L * 30 + 51, YR is (L+1) * 30 + 50,
	new(Line, line(XT, YT, XT, YR)),
	send(Line, colour, white),
	send(D, display, Line).

erase_line(D, L, C, L1, C) :-
	XT is  51 + C * 30, XR is 50 + (C + 1) * 30,
	(   L < L1 -> L2 is L1; L2 is L),
	YT is L2 * 30 + 50,
	new(Line, line(XT, YT, XR, YT)),
	send(Line, colour, white),
	send(D, display, Line).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
nextcell(Dir, Lig, Col, L, C, L1, C1) :-
	next(Dir, Lig, Col, L, C, L1, C1);
	(   Dir1 is (Dir+3) mod 4,
	    next(Dir1, Lig, Col, L, C, L1, C1));
	(   Dir2 is (Dir+1) mod 4,
	    next(Dir2, Lig, Col, L, C, L1, C1));
	(   Dir3 is (Dir+2) mod 4,
	    next(Dir3, Lig, Col, L, C, L1, C1)).

% 0 => northward
next(0, _Lig, _Col, L, C, L1, C) :-
	L > 0,
	L1 is L - 1,
	\+cell(L1, C).

% 1 => rightward
next(1, _Lig, Col, L, C, L, C1) :-
	C < Col - 1,
	C1 is C + 1,
	\+cell(L, C1).

% 2 => southward
next(2, Lig, _Col, L, C, L1, C) :-
	L < Lig - 1,
	L1 is L + 1,
	\+cell(L1, C).

% 3 => leftward
next(2, _Lig, _Col, L, C, L, C1) :-
	C > 0,
	C1 is C - 1,
	\+cell(L, C1).

generate and display a maze using the Depth-first search algorithm. The process begins at a random cell, marks it as visited, and retrieves a list of its neighboring cells. For each neighbor, starting with a randomly selected one, if the neighbor hasn't been visited, the wall between the current cell and the neighbor is removed, and the process is recursively repeated with the neighbor as the current cell. The codes are compatible with SWI-Prolog and XPCE.


The code continually calculates and outputs the next decimal digit of Pi, starting from 3.14159265. The process continues indefinitely until interrupted by the user. The code does not use built-in Pi constants but calculates Pi from scratch. It utilizes a coroutine with freeze/2 predicate for this task.


Works with: SWI Prolog
:- table ack/3. % memoization reduces the execution time of ack(4,1,X) from several
                % minutes to about one second on a typical desktop computer.
ack(0, N, Ans) :- Ans is N+1.
ack(M, 0, Ans) :- M>0, X is M-1, ack(X, 1, Ans).
ack(M, N, Ans) :- M>0, N>0, X is M-1, Y is N-1, ack(M, Y, Ans2), ack(X, Ans2, Ans).

ack(0,N,s(N)).
ack(s(M),0,P):- ack(M,s(0),P).
ack(s(M),s(N),P):- ack(s(M),N,S), ack(M,S,P).

% Peano's first axiom in Prolog is that s(0) AND s(s(N)):- s(N)
% Thanks to this we don't need explicit N > 0 checks.
% Nor explicit arithmetic operations like X is M-1.
% Recursion and unification naturally decrement s(N) to N.
% But: Prolog clauses are relations and cannot be replaced by their result, like functions.
% Because of this we do need an extra argument to hold the output of the function.
% And we also need an additional call to the function in the last clause.

% Example input/output:
% ?- ack(s(0),s(s(0)),P).
% P = s(s(s(s(0)))) ;
% false.

The code implements the Ackermann function, a non-primitive recursive function. It takes two non-negative arguments and returns their Ackermann value. The function handles large numbers but doesn't necessarily require arbitrary precision.


implement an algorithm to compute the Gamma function in the real field, comparing the results with built-in or library functions if available. The Gamma function is computed through numerical integration, with the Lanczos approximation and Stirling's approximation suggested for better efficiency. The accuracy of the computation is checked against Wolfram Alpha.


solution([]).

solution([X/Y|Others]) :-
 solution(Others),
 member(Y, [1,2,3,4,5,6,7,8]),
 noattack(X/Y, Others).

noattack(_,[]).

noattack(X/Y,[X1/Y1|Others]) :-
 Y =\= Y1,
 Y1 - Y =\= X1 - X,
 Y1 - Y =\= X - X1,
 noattack(X/Y,Others).

member(Item,[Item|Rest]).

member(Item,[First|Rest]) :-
 member(Item,Rest).

template([1/Y1,2/Y2,3/Y3,4/Y4,5/Y5,6/Y6,7/Y7,8/Y8]).

solution(Queens) :-
 permutation([1,2,3,4,5,6,7,8], Queens),
 safe(Queens).

permutation([],[]).

permutation([Head|Tail],PermList) :-
 permutation(Tail,PermTail),
 del(Head,PermList,PermTail).

del(Item,[Item|List],List).

del(Item,[First|List],[First|List1]) :-
 del(Item,List,List1).

safe([]).

safe([Queen|Others]) :-
 safe(Others),
 noattack(Queen,Others,1).

noattack(_,[],_).

noattack(Y,[Y1|Ylist],Xdist) :-
 Y1-Y=\=Xdist,
 Y-Y1=\=Xdist,
 Dist1 is Xdist + 1,
 noattack(Y,Ylist,Dist1).

solution(Ylist) :-
 sol(Ylist,[1,2,3,4,5,6,7,8],
    [1,2,3,4,5,6,7,8],
    [-7,-6,-5,-4,-3,-2,-1,0,1,2,3,4,5,6,7],
    [2,3,4,5,6,7,8,9,10,11,12,13,14,15,16]).

sol([],[],[],Du,Dv).

sol([Y|Ylist],[X|Dx1],Dy,Du,Dv) :-
 del(Y,Dy,Dy1),
 U is X-Y,
 del(U,Du,Du1),
 V is X+Y,
 del(V,Dv,Dv1),
 sol(Ylist,Dx1, Dy1,Du1,Dv1).

del(Item,[Item|List],List).

del(Item,[First|List],[First|List1]) :-
 del(Item,List,List1).

  ?- findall(S, solution(S), LS), length(LS,N), write(N).
  92

:- initialization(main).

queens(N,Qs) :- bagof(X, between(1,N,X), Xs), place(Xs,[],Qs).

place(Xs,Qs,Res) :-
    Xs = [] -> Res = Qs
  ; select(Q,Xs,Ys), not_diag(Q,Qs,1), place(Ys,[Q|Qs],Res)
  .

not_diag(_, []     , _).
not_diag(Q, [Qh|Qs], D) :-
     abs(Q - Qh) =\= D, D1 is D + 1, not_diag(Q,Qs,D1).

main :- findall(Qs, (queens(8,Qs), write(Qs), nl), _), halt.

Works with: SWI Prolog version version 6.2.6 by Jan Wielemaker, University of Amsterdam
% 8 queens problem.
%  q(Row) represents a queen, allocated one per row. No rows ever clash.
%  The columns are chosen iteratively from available columns held in a
%  list, reduced with each allocation, so we need never check verticals.
%  For diagonals, we check prior to allocation whether each newly placed
%  queen will clash with any of the prior placements. This prevents
%  most invalid permutations from ever being attempted.
can_place(_, []) :- !.	   % success for empty board
can_place(q(R,C),Board) :- % check diagonals against allocated queens
	member(q(Ra,Ca), Board), abs(Ra-R) =:= abs(Ca-C), !, fail.
can_place(_,_).            % succeed if no diagonals failed

queens([], [], Board, Board).                            % found a solution
queens([q(R)|Queens], Columns, Board, Solution) :-
	nth0(_,Columns,C,Free), can_place(q(R,C),Board), % find all solutions
	queens(Queens,Free,[q(R,C)|Board], Solution).    % recursively

queens :-
  findall(q(N), between(0,7,N), Queens), findall(N, between(0,7,N), Columns),
  findall(B, queens(Queens, Columns, [], B), Boards),     % backtrack over all
  length(Boards, Len), writef('%w solutions:\n', [Len]),  % Output solutions
  member(R,Boards), reverse(R,Board), writef('  - %w\n', [Board]), fail.
queens.

solve the N-Queens problem, extending the traditional eight queens puzzle to a board of size NxN. It uses backtracking, a highly efficient mechanism in Prolog, to find all solutions. The code utilizes non-ISO predicates between/3 and select/3, and the CLP(FD): Constraint Logic Programming over Finite Domain Library. The code runs in SWI-Prolog 7.2.3 and v8.0.2, providing the number of solutions for small values of N.


demonstrate how to concatenate two arrays.


Works with: SWI-Prolog
Library: clpfd
:- use_module(library(clpfd)).

knapsack :-
        L = [
             item(map,  9,      150),
             item(compass,      13,     35),
             item(water,        153,    200),
             item(sandwich, 50,         160),
             item(glucose,      15,     60),
             item(tin,  68,     45),
             item(banana,       27,     60),
             item(apple,        39,     40),
             item(cheese,       23,     30),
             item(beer,         52,     10),
             item('suntan cream',       11,     70),
             item(camera,       32,     30),
             item('t-shirt',    24,     15),
             item(trousers, 48,         10),
             item(umbrella, 73,         40),
             item('waterproof trousers',        42,     70),
             item('waterproof overclothes',     43,     75),
             item('note-case',22,       80),
             item(sunglasses,   7,      20),
             item(towel,        18,     12),
             item(socks,        4,      50),
             item(book,         30,     10 )],
        length(L, N),
        length(R, N),
        R ins 0..1,
        maplist(arg(2), L, LW),
        maplist(arg(3), L, LV),
        scalar_product(LW, R, #=<, 400),
        scalar_product(LV, R, #=, VM),
        labeling([max(VM)], R),
        scalar_product(LW, R, #=, WM),
        %% affichage des résultats
        compute_lenword(L, 0, Len),
        sformat(A1, '~~w~~t~~~w|', [Len]),
        sformat(A2, '~~t~~w~~~w|', [4]),
        sformat(A3, '~~t~~w~~~w|', [5]),
        print_results(A1,A2,A3, L, R, WM, VM).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% to show the results in a good way
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
compute_lenword([], N, N).
compute_lenword([item(Name, _, _)|T], N, NF):-
        atom_length(Name, L),
        (   L > N -> N1 = L; N1 = N),
        compute_lenword(T, N1, NF).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
print_results(A1,A2,A3, [], [], WM, WR) :-
        sformat(W1, A1, [' ']),
        sformat(W2, A2, [WM]),
        sformat(W3, A3, [WR]),
        format('~w~w~w~n', [W1,W2,W3]).

print_results(A1,A2,A3, [_H|T], [0|TR], WM, VM) :-
        print_results(A1,A2,A3, T, TR, WM, VM).

print_results(A1, A2, A3, [item(Name, W, V)|T], [1|TR], WM, VM) :-
        sformat(W1, A1, [Name]),
        sformat(W2, A2, [W]),
        sformat(W3, A3, [V]),
        format('~w~w~w~n', [W1,W2,W3]),
        print_results(A1, A2, A3, T, TR, WM, VM).

The code determines the optimal combination of items, with a maximum weight of 4kg, that a tourist can carry in his knapsack for a trip to maximize the total value. The items, their weights, and their importance values are given in a list. The solution does not allow for fractional items. The code uses a library written by Markus Triska and solves the problem in about 3 seconds.


Works with: SWI-PrologLibrary: XPCE

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% facts
prefere(abe,[ abi, eve, cath, ivy, jan, dee, fay, bea, hope, gay]).
prefere(  bob,[ cath, hope, abi, dee, eve, fay, bea, jan, ivy, gay]).
prefere(  col,[ hope, eve, abi, dee, bea, fay, ivy, gay, cath, jan]).
prefere(  dan,[ ivy, fay, dee, gay, hope, eve, jan, bea, cath, abi]).
prefere(   ed,[ jan, dee, bea, cath, fay, eve, abi, ivy, hope, gay]).
prefere( fred,[ bea, abi, dee, gay, eve, ivy, cath, jan, hope, fay]).
prefere(  gav,[ gay, eve, ivy, bea, cath, abi, dee, hope, jan, fay]).
prefere(  hal,[ abi, eve, hope, fay, ivy, cath, jan, bea, gay, dee]).
prefere(  ian,[ hope, cath, dee, gay, bea, abi, fay, ivy, jan, eve]).
prefere(  jon,[ abi, fay, jan, gay, eve, bea, dee, cath, ivy, hope]).

prefere(  abi,[ bob, fred, jon, gav, ian, abe, dan, ed, col, hal]).
prefere(  bea,[ bob, abe, col, fred, gav, dan, ian, ed, jon, hal]).
prefere( cath,[ fred, bob, ed, gav, hal, col, ian, abe, dan, jon]).
prefere(  dee,[ fred, jon, col, abe, ian, hal, gav, dan, bob, ed]).
prefere(  eve,[ jon, hal, fred, dan, abe, gav, col, ed, ian, bob]).
prefere(  fay,[ bob, abe, ed, ian, jon, dan, fred, gav, col, hal]).
prefere(  gay,[ jon, gav, hal, fred, bob, abe, col, ed, dan, ian]).
prefere( hope,[ gav, jon, bob, abe, ian, dan, hal, ed, col, fred]).
prefere(  ivy,[ ian, col, hal, gav, fred, bob, abe, ed, jon, dan]).
prefere(  jan,[ ed, hal, gav, abe, bob, jon, col, ian, fred, dan]).

man(abe).
man(bob).
man(col).
man(dan).
man(ed).
man(fred).
man(gav).
man(hal).
man(ian).
man(jon).

woman(abi).
woman(bea).
woman(cath).
woman(dee).
woman(eve).
woman(fay).
woman(gay).
woman(hope).
woman(ivy).
woman(jan).

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% rules

stable_mariage :-
	new(LstMan, chain),
	forall(man(X),
	       (   prefere(X, Lst),
		   new(P, man(X, Lst)),
		   send(LstMan, append, P))),

	new(LstWoman, chain),
	forall(woman(X),
	       (   prefere(X, Lst),
		   new(P, woman(X, Lst)),
		   send(LstWoman, append, P))),
	send(LstMan, for_all, message(@arg1, init_liste, LstWoman)),
	send(LstWoman, for_all, message(@arg1, init_liste, LstMan)),

	round(LstMan, LstWoman),
	new(LstCouple, chain),
	% creation of the couple.
	send(LstWoman, for_all, and(message(@prolog, create_couple, @arg1, LstCouple),
				   message(@pce, write_ln, @arg1?name, with, @arg1?elu?name))),

	nl,

	% test of the stability of couples
	stability(LstCouple),
	nl,

	% Perturbation of couples
	get(LstCouple, size, Len),
	get_two_random_couples(Len, V1, V2),

	get(LstCouple, nth0, V1, C1),
	get(LstCouple, nth0, V2, C2),
	new(NC1, tuple(C1?first, C2?second)),
	new(NC2, tuple(C2?first, C1?second)),
	send(LstCouple, nth0, V1, NC1),
	send(LstCouple, nth0, V2, NC2),

	send(@pce, write_ln, 'perturbation of couples'),
	send(@pce, write_ln, NC1?second, with, NC1?first),
	send(@pce, write_ln, NC2?second, with, NC2?first),
	nl,

	stability(LstCouple).

get_two_random_couples(Len, C1, C2) :-
	C1 is random(Len),
	repeat,
	C2 is random(Len),
	C1 \= C2.

create_couple(Woman, LstCouple ) :-
	send(LstCouple, append, new(_, tuple(Woman?elu?name, Woman?name))).

% iterations of the algorithm
round(LstMan, LstWoman) :-
	send(LstMan, for_some, message(@arg1, propose)),
	send(LstWoman, for_some, message(@arg1, dispose)),
	(   \+send(LstWoman, for_all, @arg1?status == maybe)
	->
	    round(LstMan, LstWoman)
	;
	    true
	).

:-pce_begin_class(person, object, "description of a person").
variable(name, object, both, "name of the person").
variable(preference, chain, both, "list of priority").
variable(status, object, both, "statut of engagement : maybe / free").

initialise(P, Name, Pref) :->
	send(P, send_super, initialise),
	send(P, slot, name, Name),
	send(P, slot, preference, Pref),
	send(P, slot, status, free).

% reception of the list of partners
init_liste(P, Lst) :->
	% we replace the list of name of partners
	% with the list of persons partners.
	new(NLP, chain),
	get(P, slot, preference, LP),
	send(LP, for_all, message(@prolog, find_person,@arg1, Lst, NLP)),
	send(P, slot, preference, NLP).

:- pce_end_class(person).

find_person(Name, LstPerson, LstPref) :-
	get(LstPerson, find, @arg1?name == Name, Elem),
	send(LstPref, append, Elem).

:-pce_begin_class(man, person, "description of a man").

initialise(P, Name, Pref) :->
	send(P, send_super, initialise, Name, Pref).

% a man propose "la botte" to a woman
propose(P) :->
	get(P, slot, status, free),
	get(P, slot, preference, XPref),
	get(XPref, delete_head, Pref),
	send(P, slot, preference, XPref),
	send(Pref, proposition, P).

refuse(P) :->
	send(P, slot, status, free).

accept(P) :->
	send(P, slot, status, maybe).

:- pce_end_class(man).

:-pce_begin_class(woman, person, "description of a woman").
variable(elu, object, both, "name of the elu").
variable(contact, chain, both, "men that have contact this woman").

initialise(P, Name, Pref) :->
	send(P, send_super, initialise, Name, Pref),
	send(P, slot, contact, new(_, chain)),
	send(P, slot, elu, @nil).

% a woman decide Maybe/No
dispose(P) :->
	get(P, slot, contact, Contact),
	get(P, slot, elu, Elu),

	(   Elu \= @nil
	->
	    send(Contact, append, Elu)
	;
	    true),

	new(R, chain),
	send(Contact, for_all, message(P, fetch, @arg1, R)),
	send(R, sort, ?(@arg1?first, compare, @arg2?first)),
	get(R, delete_head, Tete),
	send(Tete?second, accept),
	send(P, slot, status, maybe),
	send(P, slot, elu, Tete?second),
	send(R, for_some, message(@arg1?second, refuse)),
	send(P, slot, contact, new(_, chain)) .

% looking for the person of the given name  Contact
% Adding it in the chain Chain
fetch(P, Contact, Chain) :->
	get(P, slot, preference, Lst),
	get(Lst, find, @arg1?name == Contact?name, Elem),
	get(Lst, index, Elem, Ind),
	send(Chain, append, new(_, tuple(Ind, Contact))).

% a woman receive a proposition from a man
proposition(P, Name) :->
	get(P, slot, contact, C),
	send(C, append, Name),
	send(P, slot, contact, C).

:- pce_end_class(woman).

% computation of the stability od couple
stability(LstCouple) :-
	chain_list(LstCouple, LstPceCouple),
	maplist(transform, LstPceCouple, PrologLstCouple),
	study_couples(PrologLstCouple, [], UnstableCouple),
	(   UnstableCouple = []
	->
	    writeln('Couples are stable')
	;
	    sort(UnstableCouple, SortUnstableCouple),
	    writeln('Unstable couples are'),
	    maplist(print_unstable_couple, SortUnstableCouple),
	    nl
	).

print_unstable_couple((C1, C2)) :-
	format('~w and ~w~n', [C1, C2]).

transform(PceCouple, couple(First, Second)):-
	get(PceCouple?first, value, First),
	get(PceCouple?second, value, Second).

study_couples([], UnstableCouple, UnstableCouple).

study_couples([H | T], CurrentUnstableCouple, UnstableCouple):-
	include(unstable_couple(H), T, Lst),
	(   Lst \= []
	->
	    maplist(build_one_couple(H), Lst, Lst1),
	    append(CurrentUnstableCouple, Lst1,CurrentUnstableCouple1)
	;
	    CurrentUnstableCouple1 = CurrentUnstableCouple
	),
	study_couples(T, CurrentUnstableCouple1, UnstableCouple).

build_one_couple(C1, C2, (C1, C2)).

unstable_couple(couple(X1, Y1), couple(X2, Y2)) :-
	prefere(X1, PX1),
	prefere(X2, PX2),
	prefere(Y1, PY1),
	prefere(Y2, PY2),

	% index of women for X1
	nth0(IY12, PX1, Y2),
	nth0(IY11, PX1, Y1),
	% index of men for Y2
	nth0(IX21, PY2, X1),
	nth0(IX22, PY2, X2),

	% index of women for X2
	nth0(IY21, PX2, Y1),
	nth0(IY22, PX2, Y2),
	% index of men for Y1
	nth0(IX11, PY1, X1),
	nth0(IX12, PY1, X2),

	% A couple is unstable
	( (IY12 < IY11 , IX21 < IX22);
	  (IY21 < IY22 , IX12 < IX11)).

The code uses the Gale-Shapley algorithm to solve the Stable Marriage Problem. It takes as input preferences of ten males and ten females for potential partners. It then generates a stable set of engagements where no individual prefers someone else over their current partner. The code also perturbs this stable set to create an unstable set and checks its stability.


short_circuit :-
	(   a_or_b(true, true) -> writeln('==> true'); writeln('==> false')) , nl,
	(   a_or_b(true, false)-> writeln('==>  true'); writeln('==> false')) , nl,
	(   a_or_b(false, true)-> writeln('==> true'); writeln('==> false')) , nl,
	(   a_or_b(false, false)-> writeln('==> true'); writeln('==> false')) , nl,
	(   a_and_b(true, true)-> writeln('==> true'); writeln('==> false')) , nl,
	(   a_and_b(true, false)-> writeln('==>  true'); writeln('==> false')) , nl,
	(   a_and_b(false, true)-> writeln('==>  true'); writeln('==> false')) , nl,
	(   a_and_b(false, false)-> writeln('==>  true'); writeln('==> false')) .

a_and_b(X, Y) :-
	format('a(~w) and b(~w)~n', [X, Y]),
	(   a(X), b(Y)).

a_or_b(X, Y) :-
	format('a(~w) or b(~w)~n', [X, Y]),
	(   a(X); b(Y)).

a(X) :-
	format('a(~w)~n', [X]),
	X.

b(X) :-
	format('b(~w)~n', [X]),
	X.

The code defines two functions, 'a' and 'b', which both take and return the same boolean value and print their names when called. The code then calculates the values of two equations, 'x' and 'y', using short-circuit evaluation to ensure that function 'b' is only called when necessary. In the case that the language does not support short-circuit evaluation, nested 'if' statements are used to achieve the same result. The code is tested with SWI-Prolog and should work with other dialects.


% convert text to morse
% query text2morse(Text, Morse)
% where
% Text is string to convert
% Morse is Morse representation
% There is a space between chars and double space between words
%
text2morse(Text, Morse) :-
	string_lower(Text, TextLower),			% rules are in lower case
	string_chars(TextLower, Chars),			% convert string into list of chars
	chars2morse(Chars, MorseChars),			% convert each char into morse
	string_chars(MorsePlusSpace, MorseChars),	% append returned string list into single string
	string_concat(Morse, ' ', MorsePlusSpace).	% Remove trailing space

chars2morse([], "").
chars2morse([H|CharTail], Morse) :-
	morse(H, M),
	chars2morse(CharTail, MorseTail),
	string_concat(M,' ', MorseSpace),
	string_concat(MorseSpace, MorseTail, Morse).

% space
morse(' ', " ").
% letters
morse('a', ".-").
morse('b', "-...").
morse('c', "-.-.").
morse('d', "-..").
morse('e', ".").
morse('f', "..-.").
morse('g', "--.").
morse('h', "....").
morse('i', "..").
morse('j', ".---").
morse('k', "-.-").
morse('l', ".-..").
morse('m', "--").
morse('n', "-.").
morse('o', "---").
morse('p', ".--.").
morse('q', "--.-").
morse('r', ".-.").
morse('s', "...").
morse('t', "-").
morse('u', "..-").
morse('v', "...-").
morse('w', ".--").
morse('x', "-..-").
morse('y', "-.--").
morse('z', "--..").
% numbers
morse('1', ".----").
morse('2', "..---").
morse('3', "...--").
morse('4', "....-").
morse('5', ".....").
morse('6', "-....").
morse('7', "--...").
morse('8', "---..").
morse('9', "----.").
morse('0', "-----").
% common punctuation
morse('.', ".-.-.-").
morse(',', "--..--").
morse('/', "-..-.").
morse('?', "..--..").
morse('=', "-...-").
morse('+', ".-.-.").
morse('-', "-....-").
morse('@', ".--.-.").

text2morse("Hello World", Morse).

The code converts a given string into audible Morse code and sends it to an audio device, such as a PC speaker. It either ignores or indicates unknown characters not included in the standard Morse code, possibly through a different pitch. The code is written in SWI Prolog, Edinburgh syntax.


abc_problem :-
	maplist(abc_problem, ['', 'A', bark, bOOk, treAT, 'COmmon', sQuaD, 'CONFUSE']).

abc_problem(Word) :-
	L = [[b,o],[x,k],[d,q],[c,p],[n,a],[g,t],[r,e],[t,g],[q,d],[f,s],
	     [j,w],[h,u],[v,i],[a,n],[o,b],[e,r],[f,s],[l,y],[p,c],[z,m]],

	(   abc_problem(L, Word)
	->  format('~w OK~n', [Word])
	;   format('~w KO~n', [Word])).

abc_problem(L, Word) :-
	atom_chars(Word, C_Words),
	maplist(downcase_atom, C_Words, D_Words),
	can_makeword(L, D_Words).

can_makeword(_L, []).

can_makeword(L, [H | T]) :-
	(   select([H, _], L, L1); select([_, H], L, L1)),
	can_makeword(L1, T).

The code is a function that checks if a given word can be spelled using a specific collection of ABC blocks. Each block has two letters and can only be used once. The function is case-insensitive and tests the functionality with seven different words. The code uses the CHR library and a module for composing predicates in SWI-Prolog.


Works with: SWI Prolog
main:-
    sort_oid_list(["1.3.6.1.4.1.11.2.17.19.3.4.0.10",
    "1.3.6.1.4.1.11.2.17.5.2.0.79",
    "1.3.6.1.4.1.11.2.17.19.3.4.0.4",
    "1.3.6.1.4.1.11150.3.4.0.1",
    "1.3.6.1.4.1.11.2.17.19.3.4.0.1",
    "1.3.6.1.4.1.11150.3.4.0"], Sorted_list),
    foreach(member(oid(_, Oid), Sorted_list), writeln(Oid)).

sort_oid_list(Oid_list, Sorted_list):-
    parse_oid_list(Oid_list, Parsed),
    sort(1, @=<, Parsed, Sorted_list).

parse_oid_list([], []):-!.
parse_oid_list([Oid|Oid_list], [oid(Numbers, Oid)|Parsed]):-
    parse_oid(Oid, Numbers),
    parse_oid_list(Oid_list, Parsed).

parse_oid(Oid, Numbers):-
    split_string(Oid, ".", ".", Strings),
    number_strings(Numbers, Strings).

number_strings([], []):-!.
number_strings([Number|Numbers], [String|Strings]):-
    number_string(Number, String),
    number_strings(Numbers, Strings).

sort a list of Object Identifiers (OIDs) in their natural lexicographical order. The OIDs are strings of non-negative integers separated by dots.


start(Port) :- socket('AF_INET',Socket),
               socket_connect(Socket, 'AF_INET'(localhost,Port), Input, Output),
               write(Output, 'hello socket world'),
               flush_output(Output),
               close(Output),
               close(Input).

The code opens a socket to localhost on port 256, sends the message "hello socket world", and then closes the socket. It is compatible with Gnu Prolog and does not handle any exceptions or errors.


o(O) :- member(O, [0,1,2,3,4,5,6,7]).

octal([O]) :- o(O).
octal([A|B]) :-
	octal(O),
	o(T),
	append(O, [T], [A|B]),
	dif(A, 0).

octalize :-
	forall(
		octal(X),
		(maplist(write, X), nl)
	).

generate a sequence of octal numbers, starting from zero and incrementing by one each time. The sequence continues until the program is terminated or the maximum value of the numeric type in use is reached. Each octal number is printed on a separate line. The code also includes a function to validate if a number is a valid octal number.


implement a generic swap function or operator that can interchange the values of two variables or storage places, regardless of their types. The function is designed to work with both statically and dynamically typed languages, with certain limitations based on language semantics and support for parametric polymorphism.


palindrome(Word) :- name(Word,List), reverse(List,List).

Works with: SWI Prolog
pali(Str) :- sub_string(Str, 0, 1, _, X), string_concat(Str2, X, Str), string_concat(X, Mid, Str2), pali(Mid).
pali(Str) :- string_length(Str, Len), Len < 2.

Works with: GNU Prolog
pali(Str) :- sub_atom(Str, 0, 1, _, X), atom_concat(Str2, X, Str), atom_concat(X, Mid, Str2), pali(Mid).
pali(Str) :- atom_length(Str, Len), Len < 2.

The code includes a function to check if a given sequence of characters is a palindrome. It supports Unicode characters and has an additional function to detect inexact palindromes, ignoring white-space, punctuation and case differences. It uses string reversal and can be tested using the 'Test a function' task. The code can also run on GNU Prolog when the string is changed into an atom.


demonstrate how to retrieve a specific environment variable from the process's environment in SWI-Prolog using the built-in function getenv. The variables that can be accessed may differ based on the system, but commonly include PATH, HOME, and USER on Unix systems.


int fib(int n) {
  if (n==0 || n==1) {
    return n;
  }
  var prev=1;
  var current=1;
  for (var i=2; i<n; i++) {
    var next = prev + current;
    prev = current;
    current = next;
  }
  return current;
}

int fibRec(int n) => n==0 || n==1 ? n : fibRec(n-1) + fibRec(n-2);

main() {
  print(fib(11));
  print(fibRec(11));
}

generate the nth Fibonacci number, using either an iterative or recursive approach. The function also has an optional feature to support negative Fibonacci sequences.


String reverse(String s) => new String.fromCharCodes(s.runes.toList().reversed);

import 'package:unittest/unittest.dart';

String reverse(String s) => new String.fromCharCodes(s.runes.toList().reversed);

main() {
  group("Reverse a string -", () {
    test("Strings with ASCII characters are reversed correctly.", () {
      expect(reverse("hello, world"), equals("dlrow ,olleh"));
    });
    test("Strings with non-ASCII BMP characters are reversed correctly.", () {
      expect(reverse("\u4F60\u4EEC\u597D"), equals("\u597D\u4EEC\u4F60"));
    });
    test("Strings with non-BMP characters are reversed correctly.", () {
      expect(reverse("hello, \u{1F310}"), equals("\u{1F310} ,olleh"));
    });
  });
}

are designed to reverse a given string, including handling Unicode combining characters and UTF-16 surrogate pairs. The Dart language's "runes" feature is utilized to convert strings into sequences of Unicode code points, which can then be easily reversed to create new strings.


void main(){
  //Set Creation
  Set A = new Set.from([1,2,3]);
  Set B = new Set.from([1,2,3,4,5]);
  Set C = new Set.from([1,2,4,5]);

  print('Set A = $A');
  print('Set B = $B');
  print('Set C = $C');
  print('');
  //Test if element is in set
  int m = 3;
  print('m = 5');
  print('m in A = ${A.contains(m)}');
  print('m in B = ${B.contains(m)}');
  print('m in C = ${C.contains(m)}');
  print('');
  //Union of two sets
  Set AC = A.union(C);
  print('Set AC = Union of A and C = $AC');
  print('');
  //Intersection of two sets
  Set A_C = A.intersection(C);
  print('Set A_C = Intersection of A and C = $A_C');
  print('');
  //Difference of two sets
  Set A_diff_C = A.difference(C);
  print('Set A_diff_C = Difference between A and C = $A_diff_C');
  print('');
  //Test if set is subset of another set
  print('A is a subset of B = ${B.containsAll(A)}');
  print('C is a subset of B = ${B.containsAll(C)}');
  print('A is a subset of C = ${C.containsAll(A)}');
  print('');
  //Test if two sets are equal
  print('A is equal to B  = ${B.containsAll(A) && A.containsAll(B)}');
  print('B is equal to AC = ${B.containsAll(AC) && AC.containsAll(B)}');
}

demonstrate various set operations such as creation, checking if an element is present in a set, union, intersection, difference, subset and equality of sets. The code also optionally shows other set operations and methods to modify a mutable set. It may implement a set using an associative array, binary search tree, hash table, or an ordered array of binary bits. The code also discusses the time complexity of the basic test operation in different scenarios.


quickSort(List a) {
  if (a.length <= 1) {
    return a;
  }

  var pivot = a[0];
  var less = [];
  var more = [];
  var pivotList = [];

  // Partition
  a.forEach((var i){
    if (i.compareTo(pivot) < 0) {
      less.add(i);
    } else if (i.compareTo(pivot) > 0) {
      more.add(i);
    } else {
      pivotList.add(i);
    }
  });

  // Recursively sort sublists
  less = quickSort(less);
  more = quickSort(more);

  // Concatenate results
  less.addAll(pivotList);
  less.addAll(more);
  return less;
}

void main() {
  var arr=[1,5,2,7,3,9,4,6,8];
  print("Before sort");
  arr.forEach((var i)=>print("$i"));
  arr = quickSort(arr);
  print("After sort");
  arr.forEach((var i)=>print("$i"));
}

implement the Quicksort algorithm to sort an array or list of elements. The algorithm works by choosing a pivot element and dividing the rest of the elements into two partitions - one with elements less than the pivot and the other with elements greater than the pivot. It then recursively sorts these partitions and joins them with the pivot to get the sorted array. The codes also include an optimized version of Quicksort that works in place by swapping elements within the array to avoid memory allocation of more arrays. The pivot selection method is not specified.