Prolog Archives - Andriy Buday

Do you know what is the Travelling Salesman Problem? Or course you know if you have at least some technical education. Will you forget what about it this problem? Could be… But I’m 100% sure that I will never, after I did task that I’m going to describe. Hope that comments in code will be enough to keep you on track.

domains
/* will allow us cooperate with better names, for me this is like #typedef in C++ */
  town = symbol
  distance = unsigned
  rib = r(town,town,distance)
  tlist = town*
  rlist = rib*
predicates
  nondeterm way(town,town,rlist,distance)
  nondeterm route(town,town,rlist,tlist,distance)
  nondeterm route1(town,tlist,rlist,tlist,distance)
  nondeterm ribsmember(rib,rlist)
  nondeterm townsmember(town,tlist)
  nondeterm tsp(town,town,tlist,rlist,tlist,distance)
  nondeterm ham(town,town,tlist,rlist,tlist,distance)
  nondeterm shorterRouteExists(town,town,tlist,rlist,distance)
  nondeterm alltown(tlist,tlist)
  nondeterm write_list(tlist)
clauses
  /*
  Nothing special with write_list.
  If list is empty we do nothing,
  and if something there we write head and call ourselves for tail.
  */
  write_list([]).
  write_list([H|T]):-
    write(H,‘ ‘),
    write_list(T).
  /* Is true if town X is in list of towns… */
  townsmember(X,[X|_]).
  townsmember(X,[_|L]):-
    townsmember(X,L).
  /* Is true if rib X is in list of ribs…  */     
  ribsmember(r(X,Y,D),[r(X,Y,D)|_]).
  ribsmember(X,[_|L]):-
    ribsmember(X,L).    
  /* Is true if Route consists of all Towns presented in second argument */
  alltown(_,[]).
  alltown(Route,[H|T]):-
    townsmember(H,Route),
    alltown(Route,T).
  
  /* Is true if there is a way from Town1 to Town2, and also return distance between them */
  way(Town1,Town2,Ways,OutWayDistance):-
    ribsmember(r(Town1,Town2,D),Ways),
    OutWayDistance = D.
    
%/*
  /* If next is uncommented then we are using non-oriented graph*/
  way(Town1,Town2,Ways,OutWayDistance):-
    ribsmember(r(Town2,Town1,D),Ways), /*switching direction here…*/
    OutWayDistance = D.
%*/
  
  /* Is true if we could build route from Town1 to Town2 */
  route(Town1,Town2,Ways,OutRoute,OutDistance):-
    route1(Town1,[Town2],Ways,OutRoute,T1T2Distance),
%SWITCH HERE
    way(Town2,Town1,Ways,LasDist), /* If you want find shortest way comment this line*/
    OutDistance = T1T2Distance + LasDist. /* And make this: OutDistance = T1T2Distance.*/
    
  route1(Town1,[Town1|Route1],_,[Town1|Route1],OutDistance):-
    OutDistance = 0.
  /* Does the actual finding of route. We take new TownX town and if it is not member of PassedRoute,
  we continue searching with including TownX in the list of passed towns.*/
  route1(Town1,[Town2|PassedRoute],Ways,OutRoute,OutDistance):-
    way(TownX,Town2,Ways,WayDistance),
    not(townsmember(TownX,PassedRoute)),
    route1(Town1,[TownX,Town2|PassedRoute],Ways,OutRoute,CompletingRoadDistance),
    OutDistance = CompletingRoadDistance + WayDistance.
  
  shorterRouteExists(Town1,Town2,Towns,Ways,Distance):-
     ham(Town1,Town2,Towns,Ways,_,Other),
         Other < Distance.
  /* calling tsp(a,a,…. picks any one connected to a town and calls another tsp*/
  tsp(Town1,Town1,Towns,Ways,BestRoute,MinDistance):-
    way(OtherTown,Town1,Ways,_),
        tsp(Town1,OtherTown,Towns,Ways,BestRoute,MinDistance).
  /*Travelling Salesman Problem is Hammilton way which is the shortes of other ones.*/
  tsp(Town1,Town2,Towns,Ways,BestRoute,MinDistance):-
        ham(Town1,Town2,Towns,Ways,Route,Distance),
        not(shorterRouteExists(Town1,Town2,Towns,Ways,Distance)),
    BestRoute = Route,
    MinDistance = Distance.
  /*Hammilton route from Town1 to Town2 assuming that Town2->Town1 way exists.*/
  ham(Town1,Town2,Towns,Ways,Route,Distance):-
    route(Town1,Town2,Ways,Route,Distance),
%SWITCH HERE
    alltown(Route,Towns), % if you want simple road without including all towns you could uncomment this line
    write_list(Route),
    write(” tD = “,Distance,“n“).
%   fail.
    
goal
/* EXAMPLE 1
  AllTowns = [a,b,c,d],
  AllWays = [r(a,b,1),r(a,c,10),r(c,b,2),r(b,c,2),r(b,d,5),r(c,d,3),r(d,a,4)],
*/
/* EXAMPLE 2 */
  AllTowns = [a,b,c,d,e],
  AllWays = [r(a,c,1),r(a,b,6),r(a,e,5),r(a,d,8),r(c,b,2),r(c,d,7),r(c,e,10),r(b,d,3),r(b,e,9),r(d,e,4)], 
  tsp(a,a,AllTowns,AllWays,Route,Distance),
%SWITCH HERE 
%  tsp(a,b,AllTowns,AllWays,Route,Distance),
  write(“Finally:n“),
  write_list(Route),
  write(” tMIN_D = “,Distance,“n“).

Let’s take a look on the following graph:

Here is output of my program:

a e d b c       D = 15
a e d b c       D = 15
a d e b c       D = 24
  a e b d c       D = 25
a b e d c       D = 27
a d b e c       D = 31

a b d e c D = 24
Finally:
a e d b c MIN_D = 15
Which is correct! :)

Also I did not mention before I faced with issue of getting minimum of the value returned from predicate.

And this link provided help for me:

http://www.cs.kuleuven.ac.be/~dtai/projects/ALP/newsletter/archive_93_96/net/meta-level/minimum.html

Hello. Today I would like to speak a little bit not about C#. We will talk about strange language Prolog. At first I was interacted with it I was impressed that… there is no assignment operator in Prolog! Yes, that looks ugly, but even in general Prolog is not kind of languages we aware of.

Here’s a short look at how Prolog differs from traditional programming languages.
Prolog is descriptive.

Instead of a series of steps specifying how the computer must work to solve a problem, a Prolog program consists of a description of the problem.
Conceptually, this description is made up of two components:
1. descriptions of the objects involved in the problem
2. facts and rules describing the relations between these objects

The rules in a Prolog program specify relations between the given input data and the output which should be generated from that input.

Source: "C:Program FilesVIP52DOCGetstart.doc"

Actually there are operator like ‘=’, but we can use it only to not assigned before variables. But this is not matter of this short article. Its matter is just to describe few tasks solved by me, so they could provide some examples to you.

Let us start with following task: We need to build binary searching tree using data in file and then we will need to traverse tree to get sorted list.
As you see in this we will figure out how to work with files, lists in Prolog and also we will find out how build such structure as tree. Before we will start with this task I would like to mention that I’m using Prolog v5.2.

Next two lines are enough to have compliable program:

goal
write("hey, there!").

Now we will add treetype to domains. Following declaration means that tree can be written as functor tree or as functor empty. empty is required to mark empty leaf.

domains
treetype = tree(string,treetype,treetype);empty

As we are going to have binary tree we need to implement inserting strategy. At first it will insert value into empty tree, or if it is not empty it will insert in right if value is greater than current tree node otherwise it will insert into left one. So insert statements will look like:

predicates

insert(string, treetype, treetype)

clauses
% if current node is empty we will insert NewItem instead of it
insert(NewItem, empty, tree(NewItem,empty,empty)):-!.
% if NewItem is less than Element we insert it to left tree
insert(NewItem, tree(Element,Left,Right), tree(Element,NewLeft,Right)):-

              NewItem < Element,
              !,
              insert(NewItem,Left,NewLeft).
% otherwise we will insert it to the right tree

insert(NewItem, tree(Element,Left,Right), tree(Element,Left,NewRight)):-
              insert(NewItem,Right,NewRight).

Next step is traversing. (If you could remember there are three types of traversing.) Let us imagine root node T with left tree L and right one R. Then traversing like T -> L -> R will be called preorder traversing. Code will look like:

predicates
traverse(treetype)
clauses

traverse(empty).
traverse(tree(Element,Left,Right)):-
write(Element, ‘n’),

traverse(Left),
traverse(Right).

New step was to read data from the file… And here I got puzzled being. I played with not(eof(input)) few hours and got nothing. What solved my issue was funny – I looked into folder ‘EXAMPLES’ with searching for ‘file’ string and found my answer, I will describe below, but one note here: Always when you are blocked or feel angry because you cannot resolve that bad error first thing go to examples especially if technology is new for you, otherwise search internet, but do not bump the wall during few hours.

So, when readln(S) fails at EOF we need only another similar clause which do nothing to be ok with our processing. See:

read_input(Tree):-
                read_input_aux(empty,Tree).

read_input_aux(Tree, NewTree):-
                readln(Ln),

                !,
                insert(Ln, Tree, Tree1),
                read_input_aux(Tree1, NewTree).

read_input_aux(Tree, Tree). /* The first clause fails at EOF. */

To easily work with list I wrote following clauses. Would like to mention that Lists in Prolog goes with paradigm of Head and Tail. So having list = integer*, we could write [H|T] for our usings, and H always is one element, T is ending list. To mark emtpy we need [].

write_list([]).

  write_list([H|T]):-

              write(H,’ ‘),

              write_list(T).

append([],SecondList,SecondList).

append([H|L1],SecondList,[H|L3]):-

append(L1,SecondList,L3).

I changed traversing to pass ther List which I want to fill in with elements. To work with files you also need few lines. It is put global file variable, then use openread to open file, use readdevice to redirect standard input.

goal

openread(input,"input.txt"),
readdevice(input),

read_input(Result),

traverse(Result,OrderedList),
write_list(OrderedList),

closefile(input).

For input file like "q w e r t y u i o p a …." (new line instead of ‘ ‘) result will be "a b c d e f g …".

Task number 2 is: Write Quick Sort agrorithm and apply it to some list. Yes, I know that there are lot of QuickSort examples in internet, but I haven’t used them – I just wrote my own and I think it is somekind unique. Here is code:

domains
item = integer

list = item*
predicates
nondeterm write_list(list)
nondeterm append(list,list,list)
nondeterm quicksort(list, list)
nondeterm partition(list, item, list, list)

clauses
write_list([]).
write_list([H|T]):-
write(H,’ ‘),
write_list(T).
append([],SecondList,SecondList).

append([H|L1],SecondList,[H|L3]):-
append(L1,SecondList,L3).

partition([], Pivot, Smalls, Bigs).
partition([X|Xs], Pivot, Smalls, Bigs):-
X < Pivot,

                !,
        partition(Xs, Pivot, Rest, Bigs),
        Smalls=[X|Rest].
partition([X|Xs], Pivot, Smalls, Bigs):-
        partition(Xs, Pivot, Smalls, Rest),

Bigs=[X|Rest].

quicksort([],[]).
quicksort([X|Xs], SortedList):-
partition(Xs, X, Smaller, Bigger),
quicksort(Smaller, SortedSmaller),

quicksort(Bigger, SortedBigger),
append(SortedSmaller,[X|SortedBigger],SortedList).
goal
quicksort([4,5,6,3,9,3,2,87,7,8], SortedList),
write_list(SortedList).

Next 3rd task looks funny to work with it. It asks me to: Move List in Cycle for given number of elements in given direction.

domains
item = integer
list = item*
predicates

nondeterm getNeededTail(list, integer, list, list)
nondeterm append(list,list,list)
nondeterm write_list(list)
nondeterm listLen(list,integer)
nondeterm moveList(list, integer, integer, integer, list, list)
clauses

listLen([],0).
listLen([H|T],N):-
listLen(T,TailLen),
N = TailLen+1.
append([],SecondList,SecondList).

append([H|L1],SecondList,[H|L3]):-
append(L1,SecondList,L3).
write_list([]).
write_list([H|T]):-
write(H,’ ‘),

              write_list(T).

getNeededTail(InputTail, 0, NeededTail, NeededHead):-
              NeededTail = InputTail.
getNeededTail([H|T], N, NeededTail, NeededHead):-

              N1 = N-1,
              getNeededTail(T, N1, NeededTail, NotDiscoveredHead),
              NeededHead = [H|NotDiscoveredHead].

moveList(ListToMove,N,Direction,Len,GoodTail, GoodHead):-

              Direction < 0,
              !,
              getNeededTail(ListToMove,N,GoodTail, GoodHead).
moveList(ListToMove,N,ToRight,Len,GoodTail, GoodHead):-

N1 = Len – N,
getNeededTail(ListToMove,N1,GoodTail, GoodHead).

goal
write("Please enter direction. Number > 0 to right:"),

readint(Direction),
write("N:"),
readint(N),
ListToMove = [1,2,3,4,5,6,7,8,9,0],

listLen(ListToMove,Len),
CorrectedN = N mod Len,
moveList(ListToMove,CorrectedN,Direction,Len,GoodTail, GoodHead),
append(GoodTail,GoodHead,MovedList),
write_list(MovedList).

4th task is quite also easy. Next clauses allow me to have new list formed out of my input by cutting positive values and squaring negative ones:

modifyList([],[]).
modifyList([H|T], ResultList):-
H > 0,
!,

              modifyList(T,ResultList).
modifyList([H|T], ResultList):-
              modifyList(T,ModifiedList),
              HSquared = H*H,
              ResultList = [HSquared|ModifiedList].

Do you know what is Expert System? Ok. I do not want to write some real word expert system, but I need at least some to try how it works. So I took example out of examples folder and tried to change it to solve some other problem. Example I took has system which decides what kind of animal is animal you have in mind. It asks few simple questions and saves them to answers database. Then using backtracking if it fails on facts of current checkin’ animal it goes to next animal and asks questions you haven’t answered yet. note here: You should NOT always trust examples which are provided to you, even if they comes with commercial product.Why? Example I found there has one bug: it doesn’t save negative answer for positive question. Understand? Ok… If you have question "Does it fly?" and answer is Yes system saves it to database so will not ask the same question, but if answer is No system will not save opposite and will ask same when will be checking other bird. This is code I’m talking about:

ask(X,Y,yes):-
!,

                write(X," it ",Y,’n’),
                readln(Reply),nl,
                frontchar(Reply,’y’,_),
                remember(X,Y,yes).

as you see if it fails on frontchar(Reply,’y’,_) it will save nothing. So this was what I changed to example by introducing new clause rememberYesAnswer, which saves Yes and allow go further or saves No and fail checking of current item.

ask(X,Y,yes):-
                !,
                write(X," it ",Y,’n’),
                readln(Reply),nl,

                rememberYesAnswer(X,Y,Reply).
rememberYesAnswer(X,Y,Reply):-
                frontchar(Reply,’y’,_),
                !,
                remember(X,Y,yes).

rememberYesAnswer(X,Y,Reply):-

remember(X,Y,no),
fail.

My expert system might be useful :) for grand master who forgot name of chess figure but know how it looks. It desides what chess figure are you trying to describe, by asking quesitons like "Is figure tall?" or "Is it first row figure?". BTW: Windows 7 has very great game called "Chesss Titans". I played it when writing this:

global facts
xpositive(symbol,symbol)
xnegative(symbol,symbol)
predicates
figure_is(symbol) – nondeterm (o)
ask(symbol,symbol,symbol) – determ (i,i,i)
rememberYesAnswer(symbol,symbol,symbol)

rememberNoAnswer(symbol,symbol,symbol)
remember(symbol,symbol,symbol) – determ (i,i,i)
positive(symbol,symbol) – determ (i,i)
negative(symbol,symbol) – determ (i,i)
clear_facts – determ ()
run – determ ()

clauses
figure_is(king):-
              positive(is,tall),
                positive(is,at_firts_row),
                positive(has,cross_at_the_top),

positive(does,move_few_cells).

figure_is(queen):-
              positive(is,tall),
                positive(is,at_firts_row),
                positive(does,move_very_well).

figure_is(rook):-
              negative(is,tall),
                positive(is,at_firts_row),
                positive(does,move_forward_backward_sideway).

figure_is(bishop):-
              positive(is,tall),
                positive(is,at_firts_row),
                positive(does,move_diagonally_only).

figure_is(knight):-

                positive(is,at_firts_row),
                positive(is,short),
                positive(does,move_like_letter_L).

figure_is(pawn):-

        negative(is,tall),
                negative(is,at_firts_row),
                positive(does,move_step_forward).

positive(X,Y):-

                xpositive(X,Y),!.
positive(X,Y):-
                not(xnegative(X,Y)),
                ask(X,Y,yes).

negative(X,Y):-

                xnegative(X,Y),!.
negative(X,Y):-
                not(xpositive(X,Y)),
                ask(X,Y,no).

ask(X,Y,yes):-

                !,
                write(X," it ",Y,’n’),
                readln(Reply),nl,
                rememberYesAnswer(X,Y,Reply).

ask(X,Y,no):-
                !,
                write(X," it ",Y,’n’),
                readln(Reply),nl,

                rememberNoAnswer(X,Y,Reply).

rememberYesAnswer(X,Y,Reply):-
                frontchar(Reply,’y’,_),
                !,

                remember(X,Y,yes).
rememberYesAnswer(X,Y,Reply):-
                remember(X,Y,no),
                fail.

rememberNoAnswer(X,Y,Reply):-
                frontchar(Reply,’n’,_),
                !,
                remember(X,Y,no).
rememberNoAnswer(X,Y,Reply):-

                remember(X,Y,yes),
                fail.

remember(X,Y,yes):-
                assertz(xpositive(X,Y)).

remember(X,Y,no):-
assertz(xnegative(X,Y)).

clear_facts:-
write("nnPlease press the space bar to exitn"),

retractall(_,dbasedom),
readchar(_).

run:-
figure_is(X),!,
write("nYour figure may be a (an) ",X),

                nl,
                clear_facts.
run:-
                write("nUnable to determine what"),

write("your figure is.nn"),
clear_facts.

goal
run.

Also I have few other tasks, but will put them some other time. Thank you for attention.

Prolog

Travelling Salesman Problem with Prolog

Funny Prolog

Highlights

Recent Posts

Recent Comments

Archives