[jfitter]

25 years ago I wrote a program in Turbo Prolog 1.1 to figure out a competition draw for N teams. This was for my squash club. At that time (1991) the owners of draws kept them as heirlooms - they were precious and difficult to produce. The program worked very well even if it did take over 4 hours to figure out a draw for 18 teams, running on an old 33MHz 80386.

I am now in the middle of a PhD program and have a need for some Prolog to link into other code I have written as part of my project. To refresh my Prolog skills I dragged out the old Draw program and converted it to Visual Prolog, keeping it as a console app for now.

I rarely ask for help on forums, but this is an exception. At my age I need all the hair I have left.

Nothing I do will make this program compile. The errors are all about predicate types and flow patterns. I have read every piece of documentation, done every tutorial, poured over sample programs, but still cannot figure out where I am going wrong.

I seem to be missing some key piece of knowledge but I don't know what it is.
What is confusing is that this program worked just fine under TP1.1. Furthermore I actually wrote it so I must have known something about Prolog back then.

I have attached the program which includes the old code and sample output as a comment block.
I would be forever grateful if someone could find the time to have a look at it.

Maybe my error will jump out at an expert. surely the differences between TP and VP are not that great.

[Martin Meyer]

Hello jfitter,

your code works in VIP 7.5.0.2 when adding predicate's modes and flows as below (I think the code could be improved however).

Code: Select all

implement main
 
    open core
 
domains
    match = p(integer, integer).
    free_teams = integer*.
    draw = match*.
    free_matches = match*.
 
clauses
    run() :-
        console::write("Enter number of teams : "),
        Num_teams = console::read(),
 
        console::writeF("Generating teams draw for % teams.\n", Num_teams),
        console::write("<[ctrl][break] to stop>\n\n"),
 
        StartTime = time::new(),
        StartTime:getTimeDetailed(Hr, Min, Sec),
 
        do_draw(Num_teams, Draw),
        Matches = Num_teams div 2,
        writeDraw(Num_teams, Matches, Draw),
        !,
 
        EndTime = time::new(),
        EndTime:getTimeDetailed(Hr1, Min1, Sec1),
 
        DeltaTime = timeInterval::new(StartTime, EndTime),
        DeltaTime:getIntervalDetailed(_, Hr2, Min2, Sec2),
 
        console::writeF("\n\nStart time   : %03u:%02u:%05.2f", Hr, Min, Sec),
        console::writeF("\nStop  time   : %03u:%02u:%05.2f", Hr1, Min1, Sec1),
        console::writeF("\nElapsed time : %03u:%02u:%05.2f\n\n", Hr2, Min2, Sec2).
    run().
 
% create a competition draw
class predicates
    do_draw : (
        integer Teams,
        draw Draw [out])
        nondeterm.
clauses
    do_draw(Teams, Draw):-
        Rounds = Teams - 1,
        make_match_list(Teams, Rounds, Match_list),
        select_next_match(Teams, Draw, Match_list, []).
 
% create a list of free matches
class predicates
    make_match_list : (
        integer Teams,
        integer Rounds,
        free_matches Match_list [out])
        multi.
clauses
    make_match_list(1, 0, []).
    make_match_list(X, 0, Z) :-
        X1 = X - 1,
        Y1 = X1 - 1,
        make_match_list(X1, Y1, Z).
    make_match_list(X, Y, [p(X, Y) | Z]):-
        Y1 = Y - 1,
        make_match_list(X, Y1, Z).
 
% create a list of free teams
class predicates
    make_team_list : (
        integer Teams,
        free_teams Team_list [out])
        multi.
clauses
    make_team_list(1, [1]).
    make_team_list(X, [X | Z]):-
        X1 = X - 1,
        make_team_list(X1, Z).
 
% remove a match from the free list
class predicates
    remove_match : (
        match Match,
        free_matches Match_list,
        free_matches New_match_list)
        nondeterm (p(o, o), i, o).
clauses
    remove_match(X, [X | Z], Z).
    remove_match(X, [W | Z], [W | V]) :-
        remove_match(X, Z, V).
 
% remove a team from the free list
class predicates
    remove_team : (
        integer Team,
        free_teams Team_list,
        free_teams New_team_list [out])
        determ.
clauses
    remove_team(X, [X | Z], Z) :-
        !.
    remove_team(X, [Y | Z], [Y | W]) :-
        remove_team(X, Z, W).
 
% select the next match
class predicates
    select_next_match : (
        integer Teams,
        draw Draw [out],
        free_matches Match_list,
        free_teams Team_list)
        nondeterm.
clauses
    select_next_match(_, [], [], _).
    select_next_match(Teams, Draw, Match_list, []) :-
        make_team_list(Teams, Team_list),
        select_next_match(Teams, Draw, Match_list, Team_list).
    select_next_match(Teams, [p(Team1,Team2) | Draw], Match_list, Team_list) :-
        remove_match(p(Team1, Team2), Match_list, New_match_list),
        member_of_teams(Team1, Team_list),
        member_of_teams(Team2, Team_list),
        remove_team(Team1, Team_list, Temp_team_list),
        remove_team(Team2, Temp_team_list, New_team_list),
        select_next_match(Teams, Draw, New_match_list, New_team_list).
 
% write out the draw
class predicates
    writeDraw : (
        integer Teams,
        integer Matches,
        draw Draw)
        nondeterm.
clauses
    writeDraw(_, _, []) :-
        console::nl.
    writeDraw(N, M, [p(X, Y) | D]) :-
        N mod M = 0,
        console::writeF("\n%,%", X, Y),
        N1 = N - 1,
        writeDraw(N1, M, D).
    writeDraw(N, M, [p(X, Y) | D]):-
        N mod M <> 0,
        console::writeF("  %,%", X, Y),
        N1 = N - 1,
        writeDraw(N1, M, D).
 
% test if team is a member of team list
class predicates
    member_of_teams : (
        integer Team,
        free_teams Team_list)
        nondeterm.
clauses
    member_of_teams(X, [X | _]).
    member_of_teams(X, [_ | Y]):-
        member_of_teams(X, Y).
 
end implement main

[jfitter]

Hello jfitter,

your code works in VIP 7.5.0.2 when adding predicate's modes and flows as below (I think the code could be improved however).

Martin thankyou very much. Your reply is greatly appreciated. I needed to actually get it to run to enable me to move forward and improve my skills. The changes you made work. Now I just need to try to understand why they worked.

The predicate modes and flows I can understand. Adding the cut in the middle of the run clause has got me confounded just now. I am an "old" Fortran, C, C++ programmer, mainly embedded systems, and think very much procedurally. I know I need to get over that to write Prolog code. Also the empty run clause I will have to think about too.

I am sure the program could be better, but as a newby Prolog programmer just getting it to work is a good start. I am not planning a career as a Prolog coder. I have a specific job to do and Prolog seems to be the best tool for this job. It is certainly worth the effort of exploring this further. If I can get on top of Prolog it will contribute to a software tool I am developing as part of my doctoral studies. Just part. The rest is electrical and mechanical.

Thanks again.

[Thomas Linder Puls]

It is of course interesting and funny to solve such a puzzle yourself. And it is of course important to learn Visual Prolog.

But actually someone has come up with a very fast solution. Such a tournament requires N*N/2 matches, and the algorithm can be made linear in the number of matches, see Round-robin tournament.

[jfitter]

It is of course interesting and funny to solve such a puzzle yourself. And it is of course important to learn Visual Prolog.

Your are right and it was an interesting learning exercise. Very valuable for getting up to speed on Prolog.

I ran the program on a 4.7GHz i7 and it took 5hr 17m to generate a draw for 22 teams - yikes!!.

After that I had some spare time so I looked at the problem and worked out an algorithm to solve it. I wrote it in Python because it was quick to do. It generated a draw for 100 teams so fast I couldn't get my finger off the enter key quickly enough.

After I finished this I saw your post and followed your link. I found that the algorithm described is very similar to mine. Since I wrote it in Python it is a very pythonly way to do the job.

The biggest lesson I have learned here is to analyse the application very carefully before jumping into coding. It's the sort of problem that at first glance looks like it is suited to Prolog - exploring options and backtracking. In reality the more than exponential growth of the search tree with increasing numbers of teams make such an approach completely impractical.

As I found, with a little thought, there is a better way.

Spoken like a true engineer (pretend programmer).

Here it is just for interest - Draw.py

Code: Select all

teams = raw_input("Enter number of teams : ")
teams = int(teams)
teams = (teams/2)*2
 
if teams < 2 : teams = 2
pattern = [x for x in range(1, teams+1)]
 
print
print '"Round Robin" draw for ', teams, ' teams ', pattern 
print
 
for round in range(teams-1):
    print "Round ", round
    print pattern[:teams/2]
    print (pattern[teams/2:])[::-1]
    pattern = pattern[:1]+pattern[-1:]+pattern[1:-1]
    print

[Martin Meyer]

This is a round-robin tournament solution in VIP 7.5.0.2 which is linear in the number of matches. It utilizes carousel pairing often used in blitz- and rapid chess.

Code: Select all

implement main
 
    open core
 
class predicates
    rotate_mt : (Type* List)
        -> Type* RotatedList
        multi.
clauses
    rotate_mt(List) = list::append(RearList, FrontList) :-
        rotate_mt1(List, FrontList, RearList).
 
class predicates
    rotate_mt1 : (
        Type* List,
        Type* FrontList [out],
        Type* RearList [out])
        multi.
clauses
    rotate_mt1(List, [], List).
    rotate_mt1([Elem1, Elem2 | RestList], [Elem1 | RestFrontList], RearList) :-
        rotate_mt1([Elem2 | RestList], RestFrontList, RearList).
 
class predicates
    splitAndReverseLeft : (
        positive Index,
        Type* List,
        Type* ReverseLeftList0,
        Type* ReverseLeftList [out],
        Type* RightList [out]).
clauses
    splitAndReverseLeft(0, List, ReverseLeftList0, ReverseLeftList0, List) :-
        !.
    splitAndReverseLeft(Index, List, ReverseLeftList0, ReverseLeftList, RightList) :-
        [Head | Tail] == List,
        splitAndReverseLeft(Index - 1, Tail, [Head | ReverseLeftList0], ReverseLeftList, RightList).
 
class predicates
    getPairings_nd : (Type* List)
        -> tuple{Type, Type}* PairList
        nondeterm.
clauses
    getPairings_nd([Elem1, Elem2 | RestList]) = list::zip(HalfList1, HalfList2) :-
        Length = list::length(RestList) + 2,
        HalfLength = Length div 2,
        if 2 * HalfLength = Length then
            RotatedList = rotate_mt([Elem2 | RestList]),
                splitAndReverseLeft(HalfLength, [Elem1 | RotatedList], [], HalfList1, HalfList2)
        else
            [_ | RotatedList] = rotate_mt([Elem1, Elem2 | RestList]),
                splitAndReverseLeft(HalfLength, RotatedList, [], HalfList1, HalfList2)
        end if.
 
clauses
    run() :-
        ExampleList = ["Donald", "Della",  "Huey", "Dewey", "Louie"],
        stdIO::write("contestants: ", ExampleList, '\n'),
        RoundM = varM_integer::new(),
        foreach PairList = getPairings_nd(ExampleList) do
            RoundM:inc(),
            stdIO::write("round ", RoundM:value, ": ", PairList, '\n')
        end foreach.
 
end implement main

[jfitter]

This is a round-robin tournament solution in VIP 7.5.0.2 which is linear in the number of matches. It utilizes carousel pairing often used in blitz- and rapid chess.

Thank you so much for offering this. Having implemented the algorithm in Python and now seeing it implemented in Prolog I can see easily how it should have been done in Prolog in the first instance.

Your

Code: Select all

ExampleList

is the

Code: Select all

pattern

in the Python code.
Your

Code: Select all

splitAndReverseLeft

is this Python code

Code: Select all

print pattern[:teams/2]
print (pattern[teams/2:])[::-1]

except the Python code is really a splitAndReverseRight.

And this Python code simple rotates the list (the carousel) except for the list head which remains at the head.

Code: Select all

pattern = pattern[:1]+pattern[-1:]+pattern[1:-1]

I plan to study your code in more detail and have a go at doing it again in Prolog from scratch.
Thanks again for the opportunity to see how a pro would implement this in Prolog.

JohnF