Prolog 4/4: GUI

Prolog 4/4: GUI

The Plan

I will write a GUI for last week’s RSS reader in order to explore how to write a GUI in a logic based language using Prolog’s XPCE toolkit.

The XPCE toolkit is:

  • An IDE for SWI-Prolog.
  • A library for writing GUI in Prolog.
  • An object layer for Prolog.

What to Expect

When this article is complete:

  • You will have:
    • A GUI front end for the RSS reader from last week
  • You will know:
    • How to use SWIPL-Win.
    • How to write a GUI in Prolog.

Files Used in this Project

  • rssGui.txt: The GUI code. (Change the extension from txt to pl)
  • rss.txt: The original RSS reader file, used here as a library. (Change the extension from txt to pl)
  • feeds.txt: Sample RSS feed config file.

The Code

Compiling the Code… More or Less

I discovered that compiling GUI code for XPCE is easier said than done. I made several attempts, read a couple of tutorials and got nowhere. If there are any Prolog guru’s reading who wouldd like to set me straight, please leave a comment.

On the other hand, running the code on the is pretty easy:

  1. Download the files for this project and re-name them as described above.
  2. Double click on “rssGui.pl”
  3. In the SWIPL window, type, rssGui.

At that point, you should have a window with the RSS reader in it.

Loading Libraries And Other Activities

:- consult(rss).
:- pce_autoload(finder, library(find_file)).
:- pce_global(@finder, new(finder)).

To load the rss library from last week, tell Prolog to consult it. The two lines afterward load the file finder into memory. This makes it possible to open a file finder to select the rss config file.

Laying Out the GUI, and Adding Hooks

rssGui :-
  new(Frame, frame('RSS Reader')),
  new(RssFeeds, browser),
  send(Frame, append(RssFeeds)),
  send(new(NewsList, browser(news)), right, RssFeeds),
  send(RssFeeds, select_message, message(@prolog, newsDisplay, RssFeeds, NewsList)),
  send(new(Buttons, dialog), below(RssFeeds)),
  send(Buttons, append(button(load, message(@prolog, load, RssFeeds)))),
  send(Frame, open).

XPCE makes it possible to access objects in Prolog by adding three predicates:

  • new: Instantiates a new object.
  • send: Sends information to the object.
  • get: Gets information from an object.

To make a new GUI window, first a frame is created(Line 2) which contains all the GUI elements.
Lines 3 and 4 create a List Box to contain the channel names and adds it to the Frame.
Line 5 adds a List Box to the right side of the channel list box for displaying news titles.
Line 6 adds an action so that when a value is selected in RssFeeds, the newsDisplay predicate is fired with RssFeeds and NewsList for arguments.
Line 7 adds a container for a button. Line 8 adds a button to the dialog which has the text “load” and fires load when clicked.
Line 9 opens the frame.

Read the Config and Load the RSS Feeds

load(Browser) :-
  get(@finder, file, exists := @on, FileName),
  readConfig(FileName, URLs),
  send(Browser, clear),
  foreach(member(URL, URLs), readAndListChannels(Browser, URL)).

Line 2 opens up a standard file dialog and unifies the selected file with FileName, from there the code is much like the display code from last week.

I used a separate predicate to write each of the URLs to avoid potential logical contradictions in the foreach.

Fetch the Feed and Add it to the RssFeeds Browser

readAndListChannels(Browser, URL) :-
  catch((rssFetch(URL, XML),
        rssRead(XML, RSS),
        foreach(member(channel(Name, News), RSS), 
          send(Browser, append, create(dict_item, Name, Name, News)))), 
      _, 
      readAndListChannels(Browser, URL)).

Again, much of this is similar to the code to display the feeds on the command line. The only real change is in Line 5, where the data from each channel is wrapped into a dictionary item with:

  1. identifier: Name
  2. key value: Name
  3. object: News

As before, this will keep trying until it succeeds or blows the stack.

Display the News Titles in the NewsList Browser

newsDisplay(RssFeeds, NewsList) :-
  get(RssFeeds, selection, Channel),
  get(Channel, object, News), 
  get(News, size, SizeVal),
  send(NewsList, clear),
  foreach(between(1, SizeVal, LineNumber), 
      sendVector(NewsList, News, LineNumber)).

Line 2 unifies Channel with the currently selected item in RssFeeds, the dictionary item from readAndListChannels.
Line 3 pulls the object from the dictionary item, a vector.
Line 4 determines the length of the vector.
Line 5 clears the NewsList so we don’t just keep adding to the end.
Line 6-7 iterates over each of the values in the vector and appends them to NewsList with sendVector.

Append a Cell from a Vector to a Browser

sendVector(Browser, Vector, Index) :-
  get(Vector, element, Index, Value),
  send(Browser, append, Value).

Given a Browser, Vector and Index, sendVector pulls the Indexth element from the Vector and appends it to the Browser.

Final Summary

Prolog’s logic based semantics make for an interesting programming experience. Up to this point I had trouble imagining how you’d deal with dynamic situations, like user input or a file being read in, in context to a language that is based on logic. Now that I’ve spent a month working with it, it’s an incredibly elegant way to solve problems. That being said, I think I’m going to stick with Python for my day to day scripting needs.

Coming Up

Next week is a fifth Monday, so I’ll be working with a tool, Robot Framework. Robot Framework is a Python based glue language for writing test cases in a clear format which is readable to non-technical users.

In February, I’ll be working with Squeak. Squeak several neat features, it is:

  • generally considered the first full object oriented language
  • where unit tests frameworks came from (in the form that most of us are used to today)
  • contained entirely in its own design environment
  • designed to be useful as an education language
  • host to Seaside a powerful web framework

Resources

Prolog 3/4: XML Parsing

Reading, Parsing and Displaying RSS Data in Prolog

This is the third article in a series, to read it from the beginning go here.

The Plan

This week is when I really put the assertion that Prolog is a general purpose language to the test. Most decently rational Prolog programmers will tell you to do things like XML parsing and display through another language, then use Prolog dll’s to do the interesting logical stuff. But, it does have the libraries, so let’s see how they work.

What to Expect

When this article is complete:

  • You will have:
    • A command-line RSS aggregator.
  • You will know:
    • How to read a text file.
    • How to read from an HTTP stream.
    • How to parse an XML file.
    • How to pretty print text to the screen.

Files Used in this Project

Compiling

To compile “xml.pl”, navigate to the directory that contains it on the commandline, then execute:

swipl -g main -o xml.exe -c xml.pl

The Code

Libraries Used

:- consult(library(sgml)).
:- consult(library(http/http_open)).
  • sgml: The SGML library, which also handles XML.
  • http/http_open: The HTTP library handles server and client code, I just used the small bit that let’s me treat an HTTP stream like a file.

Reading a File

readConfig(Lines) :-
  open('feeds.txt', read, ConfigStream),
  read_stream(ConfigStream, Lines).

read_stream(ReadStream, Lines) :-
  read_line_to_codes(ReadStream, Line),
  read_stream(ReadStream, Line, Lines).
read_stream(ReadStream, end_of_file, []) :- close(ReadStream), !.
read_stream(ReadStream, OldLine, [Atom | Lines]) :-
  read_line_to_codes(ReadStream, NewLine),
  string_to_atom(OldLine, Atom),
  read_stream(ReadStream, NewLine, Lines).

read_stream is a helper function to read multiple lines from a stream. It reads a stream in one line a time and returns/unifies its contents to Lines. Most of it is similar to what you saw in the previous article, recursively pulling off one line at a time, testing if it’s the last line and adding it to the list. The two key elements that are worth noting are: the use of the atom end_of_file, which is what the file stream returns when the stream is empty and the use of ! to indicate that if execution makes it to closing the stream, then there’s no need to backtrack.

readConfig‘s functionality is pretty obvious. Open a file using an atom with the file’s name. Remember, single-quotes are for atoms, double quotes are for strings. This opens a read only stream and unifies it with ConfigStream, then read_stream pulls the text in the file out into Lines.

Reading From HTTP

rssFetch(URL, XML) :-
  http_open(URL, XmlStream, []),
  load_xml_file(XmlStream, XML),
  close(XmlStream).

The pattern here is similar to the one for readConfig, except that it extracts the XmlStream straight to a Prolog XML structure. There’s quite a bit to it, but the short version is, it’s a nested linked list. There are a variety of functors in that list, but the one that interests us is element which has the form element(<element name>, <attributes>, <sub elements>). For example when given the xml:


  in text

load_xml_file returns:

[element(testOuter, [], 
    ['\n  ', element(inside, [inAtt=hello], ['in text']), '\n'])].

Parsing XML

rssRead([], []).
rssRead([element(channel, _, Elements) | _], [Rss | Rsses]) :-
  channelRead(Elements, Rss), rssRead(Elements, Rsses).
rssRead([element(rss, _, Elements) | _], Rss) :-
  rssRead(Elements, Rss).
rssRead([_ | Elements], Rss) :-
  rssRead(Elements, Rss).

channelRead(Elements, channel(Name, Titles)) :-
  titleRead(Elements, Name), itemsRead(Elements, Titles).

itemsRead([], []).
itemsRead([element(item, _, Elements) | Items], [ Title | Titles ]) :-
  titleRead(Elements, Title), itemsRead(Items, Titles).
itemsRead([_ | Items], Titles) :-
  itemsRead(Items, Titles).

titleRead([element(title, _, [Text | _]) | _], Text) :- !.
titleRead([_ | Elements], Text) :-
  titleRead(Elements, Text).

Strictly speaking Prolog is a weakly typed language, you have only a couple of basic types which all reduce to atoms and functors. But with those you can do the same tricks that are generally associated to algebraic type systems. Here is one example where I use the element functor to recurse through the XML structure and extract the titles.

Once you know how Prolog’s XML structures work, it’s just a matter of figuring out what information you need and recursing until you get it. For this purpose I’ve created my own functor channel(<channel name>, <title list>).

In Prolog functors and atoms are created simply by using them. This makes writing the code feel a lot like freeform sketching a picture. I like it. But I’m pretty sure that unless I made an effort to document my code well, it would make large projects unwieldy.

Pretty Printing Text

displayRss(Channels) :-
  foreach(member(channel(Name, Titles), Channels),
      (writef("*** %w ***\n", [Name]), displayTitles(Titles), nl)).

displayTitles(Titles) :-
  foreach(member(Title, Titles), writef("\t%w\n", [Title])).

writef works similarly to printf in nearly every language I’ve worked in. It has a few quirks that are detailed in its docs.

Main And Helper Text

readAndDisplayRss(URL) :-
  catch((rssFetch(URL, XML), 
        rssRead(XML, RSS), 
        displayRss(RSS)), _, readAndDisplayRss(URL)).

main :-
  readConfig(FeedURLs),
  foreach(member(URL, FeedURLs), readAndDisplayRss(URL)),
  halt.  

The above is glue code. It’s been written to continue retrying until it succeeds or runs out of stack, so make sure your URL’s are valid.

Final Summary

When I was reading up on Prolog, I heard predicates described as a generalization on functions. This week has driven that one home. Working in Prolog has felt a great deal like when I was first learning Haskell. I’ll spend hours fighting with something that I could do in my sleep in another language, then when I figure it out it is extraordinarily clear, obvious and feels cleaner than anything else I’ve worked with.

Hard Lessons Learned

foreach is not the same as a for comprehension/list comprehension, no matter how much it looks like one. The key difference is that the second term in the statement does not contain its own namespace. What happens in there happens throughout the same namespace that contains the foreach. For example:

main :-
  foreach(member(Number, [1, 2, 3, 4]), 
      (Square is Number * Number,
       write(Square), nl)).

Does not print the square of the numbers 1 through 4. It first asserts that Square is equal to 1 * 1, then that it is also equal to 2 * 2, 3 * 3, and 4 * 4, which is clearly false and ends execution of the foreach. It is possible to do this, the safe and idiomatic way is to break the second term out into its own predicate:

showSquare(Number) :-
  Square is Number * Number,
  write(Square), nl.

main :-
  foreach(member(Number, [1, 2, 3, 4]), showSquare(Number)).

That lesson took me half a day for me to learn. You’re welcome.

Coming Up

Next week I’ll be working out how to use XPCE, Prolog’s native GUI library.

Resources

Prolog 2/4: Loops, Decisions and Tests

Writing and Testing Fizzbuzz in Prolog

This is the second article in a series, to read it from the beginning go here.

The Plan

This week I’ve worked my way through solving the Fizzbuzz problem in Prolog. The most difficult part of working on it was learning to deal with Prolog’s syntax. Once I got a decent grasp of the syntax, the solution to the fizzbuzz problem fell out quite naturally.

What to Expect

When this article is complete:

  • You will have:
    • An executable that produces fizzbuzz up to 20
    • Unit tests that verify several of predicates
  • You will know:
    • How to write recursive clauses.
    • How to write conditionals.
    • How to write loops.
    • How to trow and catch exceptions.
    • How to write and run unit tests.

Files Used in this Project

The Code

Basic Predicates

isFizz(Num) :- 0 is Num mod 3.
isBuzz(Num) :- 0 is Num mod 5.
isFizzbuzz(Num) :- isFizz(Num), isBuzz(Num).

There are two basic ways that information comes out of a predicate. The first is by filling in all of its arguments, then it returns either true or false depending on how they evaluate in the predicate’s body.

Conditionals

fizzbuzz(Num, Res) :- 
  isFizzbuzz(Num) -> Res = 'fizzbuzz';
    isFizz(Num) -> Res = 'fizz';
    isBuzz(Num) -> Res = 'buzz';
    Res = Num.

Prolog’s conditional is ->. a -> b is equivalent to if a then b. You can see above that the conditionals are separated out by Prolog’s “or” operator is ;. In this context, ; operates as an else. These aren’t special cases, but the standard operation of Prolog. For example:

  1. If isFizzbuzz(Num) evaluates to true, then Res = ‘fizzbuzz’ and the statement evaluates to true and the following ‘or’ statement is short-circuited.
  2. If isFizzbuzz(Num) evaluates to false, then the whole if statement evaluates to false and then the other side of the ‘or’ operator is evaluated.

Recursion and Exceptions

fizzbuzzes(TopNum, TopNum, List) :-
  List = [],!.
fizzbuzzes(TopNum, CurrentNum, [Head | Tail]) :- 
  CurrentNum > TopNum -> throw('the CurrentNum is greater than TopNum'); 
  TopNum < 1 -> throw('the TopNum is less than 1'); 
  (NextNum is CurrentNum + 1,
  fizzbuzz(CurrentNum, Head),
  fizzbuzzes(TopNum, NextNum, Tail)).

Here I took advantage of the fact that Prolog evaluates its terms on the left side as well as on the right of :-. For the first clause, if the first two terms have the same value then this clause is the one to fire. List is set to [], then all further evaluation stops because of the !. I’m still a little vague on exactly how it works, but the short version is that if a predicate has multiple possible values, then Prolog will normally try to look for them. The ! tells Prolog that once it reaches it, it shouldn’t look any further.

Line 3 is in some ways the oddest one in the set. The first two values passed in aren’t unusual. The third value [Head | Tail] is a list which doesn’t have a name as a whole, but its head and tail do. For our use this is will be the return value of the predicate, though in Prolog this isn’t entirely a meaningful phrase. Later you’ll see a case where the “return value” is passed into the predicate to verify if it’s valid.

In Line 4 I verify if the CurrentNum is greater than the TopNum, this should never happen since there’s a wrapper that’s intended to be used that won’t let it, but there’s no harm in a bit of verification. If it is then an error is thrown with the term: 'the CurrentNum is greater than TopNum'. Normally terms don’t have spaces in them, but if you surround a term in single quotes it can have any combination of characters.

Clauses with More Than One Arity

fizzbuzzes(TopNum, List) :- 
  OneHigher is TopNum + 1,
  fizzbuzzes(OneHigher, 1, List).

This fizzbuzzes is the same clause as the one in the previous section, but with Arity 2 instead of 3. In Prolog these are differentiated as fizzbuzzes\2 and fizzbuzzes\3. In the second line you can see some arithmetic, which is OneHigher = TopNum + 1.

Loops

printFizzbuzzes(TopNum) :-
  fizzbuzzes(TopNum, FizzbuzzList),
  forall(member(X, FizzbuzzList), (print(X), nl)). 

main :- 
  printFizzbuzzes(20), 
  halt.

I claimed in the last article that Prolog had no looping constructs. This is a half truth. It has no special syntax for loops, but it does allow for the creation of a for loop as a predicate. forall is part of swipl’s standard library where the first argument is a generator for terms and the second argument is applied to each of those terms.

Unit Tests

Starting Unit Tests

:- begin_tests(fizzbuzz).

A clause that has a body, and not a head is a message to the compiler. A sequence of unit tests always starts with the being_tests clause. The term inside it will mark out what test suite this is.

Test Cases, Negation

test(isFizz_isnot) :-
  not(isFizz(5)).

When a predicate named test is defined it will be added to the test suite. not here is a little bit strange, it does not mean that something is false, but that it can’t be asserted as true. So if there is no assertion of the truth or falsehood of a statement, it will return true.

Not Really a Return Type

test(fizzbuzz_fizz) :-
  fizzbuzz(3, 'fizz').

test(fizzbuzzes_empty) :-
  fizzbuzzes(0, []).

test(fizzbuzzes_5) :-
  fizzbuzzes(5, [1, 2, fizz, 4, buzz]).

Where previously I used the second argument in fizzbuzz and fizzbuzzes to return a value, here I’m using it to verify the truth of a statement.

Closing the Test Suite

:- end_tests(fizzbuzz).

end_tests closes out the test suite.

Running Your Tests

To execute the unit tests, run swipl from the directory that contains fizzbuzz.pl. Load fizzbuzz into the interpreter with [fizzbuzz]., then run the tests with run_tests.

Final Summary

Fizzbuzz comes out well in Prolog. I’ve spent a lot more time time thinking I was fighting with the syntax when the reality was I don’t get the semantics. It’s the first time in a few years I’ve had to remind myself, “The compiler’s not broken, you just don’t know what you’re doing.”

Coming Up

Next week we’ll put the rubber to the road. Prolog’s pretty cool for algoritmic stuff, let’s see how it handles networking and XML.

Resources

Prolog 1/4: Getting Started

Getting Started with Prolog

The Plan

Prolog is rather unusual when compared to other programming languages. Rather than describing a sequence of steps as in a procedural language, it’s a declarative language that uses formal logic as its primary metaphor. Prolog is used predominantly in academic settings for language research and artificial intelligence. That being said it is a general purpose programming language and used in commercial settings where the system must be able to reason about complex data like logistics, language processing and data mining. Some examples can be found at SICStus’s Website.

Although it’s a general purpose programming language, generally other languages are used to do GUI and interface coding. There are GUI packages available though, so I’ll give one of them a try in Week 4. With a little luck we’ll see Prolog’s strength in Weeks 2 and 3.

What to Expect

When this article is complete:

  • You will have:
    • An installation of SWI-Prolog
    • A program that’ll say “Hello World”
  • You will know:
    • How to compile a program in SWI-Prolog.
    • How to use the interactive interpreter to make logical queries from a logic base.
    • That Socrates is mortal.

Files Used in this Project

SWI-Prolog

There are a large variety of implementations of Prolog. From these I chose SWI-Prolog because:

  • It works on Windows. (All projects on this blog do)
  • It has a GUI toolkit. (necessary for week 4)
  • It’s free, under the LGPL. (Please remember to include a link to SWI’s page if you use it for your applications)
  • It has an interactive interpreter. (I like interactive interpreters)

Installation

  1. Download the latest version of SWI-Prolog from their download page.
  2. Run the installer accepting all the defaults.
  3. Add "C:\Program Files\pl\bin" to your PATH in environment variables. How to change your path.

The Code

helloworld.txt (Rename to helloworld.pl):

% Say Hello Prolog
main :-
  write('Hello World!'), nl,
  halt.

Comments

In Prolog comments are preceded by a %.

Clause Structure

Prolog programs are composed of clauses separated by periods. A clause is divided into the head and the body with the format <head> :- <body> or just <head>. When just the head is given it’s treated like <head> :- true. The body of a clause is a statement composed of either a term, or sequence of terms composed by operators and ending in a period.

In Prolog a , is equivalent to boolean and. In the above, should any of the statements return false, then the others will not be executed. Each of the terms: * write('Hello World!'): Writes “Hello World!” to the screen. * nl: Writes a new line to the screen. * halt: Causes Prolog to shutdown.

Running/Compiling Your Code

SWI-Prolog has an interactive interpreter, an interpreter and a compiler.

The Interactive Interpreter

A session with the interactive interpreter looks like:

C:\>swipl
Welcome to SWI-Prolog (Multi-threaded, 32 bits, Version 5.10.2)
Copyright (c) 1990-2010 University of Amsterdam, VU Amsterdam
SWI-Prolog comes with ABSOLUTELY NO WARRANTY. This is free software,
and you are welcome to redistribute it under certain conditions.
Please visit http://www.swi-prolog.org for details.

For help, use ?- help(Topic). or ?- apropos(Word).

1 ?- write('Hello World!'), nl.
Hello World!
true.

2 ?- halt.

C:\Documents and Settings\fberthold\My Documents\My Dropbox\VirtuousProgrammer\Prolog\1 - Getting Started>

You can also interact with the interpreter through SWI-Prolog’s IDE. I’m a command line junky so haven’t played with it too much yet, but you can find it in the Start menu.

The Interpreter

To run your programmer through the interpreter type:

swipl -g main helloworld.pl

Where “helloworld.pl” is your Prolog program, commonly called a logicbase. “main” is what you’ve declared to be the main clause in your program.

The Compiler

You can compile it with:

swipl -g main -o helloworld.exe -c helloworld.pl

This will generate a windows executable “helloworld.exe” by compiling “helloworld.pl”.

Prolog’s Hello World

It’s a little hard to do Prolog justice from this first example, because the primary function of Prolog is to describe and evaluate relationships, which don’t come up in ‘hello world’. To give a little more flavor of what Prolog does, here’s a simple relationship:

socrates.txt (Rename to socrates.pl):

% All men are mortal, Socrates is a man.
mortal(X) :- man(X).
man(socrates).

Here we have two assertions. That men are mortal and that Socrates is a man. We can how use Prolog to draw a couple of conclusions. The first step is to load “socrates.pl” into the interactive interpreter with:

swipl socrates.pl

Here’s a sample session in which we can find that Socrates is mortal and that if you are mortal, you are Socrates (Add more facts to the logicbase if you want more mortals):

1 ?- mortal(socrates).
true.

2 ?- mortal(X).
X = socrates.

Prolog’s single data type is a term. Prolog terms can be(with examples from the above code):

  • atoms: socrates
  • numbers: no example in the above code
  • variables: X
  • compound terms: man(socrates)
    • where man is called a functor

Summary

Prolog is unlike any programming language I’ve worked with to date. Not only is it’s model entirely different, but it’s syntax was designed before it was obvious Algol style syntax was going to predominate, so it’s syntax is more influenced by it’s logical roots than what is currently considered normal looking syntax.

Coming Up

Next week I’ll be putting Prolog through it’s paces. The fizzbuzz problem should be interesting to solve. It feels like it should naturally be able to deal with conditional statements, but it doesn’t have any direct looping facilities other than recursion. Unit tests on the other hand also feel like a natural fit.

Resources

Trivia

  • Despite being based on an entirely different semantic set than other programming languages, Prolog is Turing complete.
  • Prolog was created at the University of Aix-Marseille by Alain Colmerauer and Phillipe Roussel, collaborating with Robert Kowalski of the University of Edinburgh in 1972.
  • If you enter X. at the interactive interpreter, SWI-Prolog gives Douglas Adams fans the answer.