/*****************************************************************************
Copyright (c) 2001 EDMGROUP
Project: TEAM_THEM_UP
FileName: TEAM_THEM_UP.PRO
Purpose: Team them UP puzzle
Written by:
Serguei Penkov:
spenkov@ozemail.com.au
Comments:
******************************************************************************/
include "iodecl.con"
global domains
SLIST = STRING*
ILIST = INTEGER*
PERSON = p(STRING ID, SLIST KNOWN_PERSONS)
FILE = input
database - persons_data
nondeterm person_data(PERSON)
nondeterm team_id(INTEGER TEAM_ID)
database - teams_data
nondeterm team(INTEGER TEAM_ID,STRING PERSON_ID)
predicates
procedure team_them_up()
nondeterm read_input_data(STRING FILENAME) - (o)
procedure string_to_slist(STRING ,STRING SEP,SLIST ) - (i,i,o)
determ read_persons_data(INTEGER PERSON,INTEGER MAX_NUMBER) - (i,i)
determ remove_last(SLIST,SLIST) - (i,o)
nondeterm member(SLIST, STRING) -(i,i)
nondeterm nondeterm_member(SLIST, STRING) -(i,o)
nondeterm nondeterm_member(ILIST, INTEGER) -(i,o)
procedure list_length(ILIST,INTEGER) -(i,o)
procedure list_length(SLIST,INTEGER) -(i,o)
determ person_knows_everyone(SLIST TEAM_MEMBERS,SLIST TEAM_MEMBERS) - (i,i)
nondeterm for(INTEGER,INTEGER,INTEGER) - (o,i,i)
determ include_to_team(STRING PERSON)
procedure display_list(SLIST)
determ create_teams
procedure display_teams
determ everyone_knows_person(SLIST,STRING PERSON) - (i,i)
determ display_persons
determ analyze_teams
determ display_header
determ split_team(INTEGER NEW_TOTAL)
clauses
% Find solution for each data file
team_them_up():-
display_header,
read_input_data(FNam), % nondeterministically read input files - persons
write("Processing file ",FNam),nl,
display_persons,
write("Team results\n"),
create_teams,
analyze_teams,
display_teams,
fail.
team_them_up().
% Include person to the one of the team
% the team collection depends on the sequence of PERSON_LIST
% it could be a case when 2 first persons do not know each other and
% therefore could block algorithm. However, in this case we do not have solution
% according to problem definiton - everyone should belong to one of the team
create_teams:-
findall(X,person_data(p(X,_)),PERSON_LIST),
nondeterm_member(PERSON_LIST, PERSON),
include_to_team(PERSON),
fail.
create_teams.
include_to_team(PERSON):-
TEAM_ID = 1, % try to include to team 1
person_data(p(PERSON,KNOWN_LIST)),
not(team(TEAM_ID,PERSON)), % not member of the team
findall(X,team(TEAM_ID,X),TEAM_MEMBERS),
person_knows_everyone(TEAM_MEMBERS,KNOWN_LIST),
everyone_knows_person(TEAM_MEMBERS,PERSON),
% OK - include person to TEAM
assert(team(TEAM_ID,PERSON)),
!.
include_to_team(PERSON):-
TEAM_ID = 2, % failed in first case - try another team
person_data(p(PERSON,KNOWN_LIST)),
not(team(TEAM_ID,PERSON)), % not member of the team
findall(X,team(TEAM_ID,X),TEAM_MEMBERS),
person_knows_everyone(TEAM_MEMBERS,KNOWN_LIST),
everyone_knows_person(TEAM_MEMBERS,PERSON),
% include person to TEAM
assert(team(TEAM_ID,PERSON)),
!.
analyze_teams:-
% EVERYONE BELONGS TO THE TEAM
person_data(p(PERSON_ID,_)),
not(team(_,PERSON_ID)),!,
write("*** No solution - Person ",PERSON_ID," is not member of any team"),nl.
analyze_teams:-
% EVERY TEAM HAS AT LEAS ONE MEMBER
team(1,_),
not(team(2,_)),
% check if everyone belongs to the first team
findall(X,person_data(p(X,_)),PERSONS),
findall(X,team(1,X),TEAM_MEMBERS),
list_length(PERSONS,TOTAL_PERSONS),
list_length(TEAM_MEMBERS,TOTAL_MEMBERS),
TOTAL_MEMBERS = TOTAL_PERSONS,
% ok - now - move part of team 1 into team 2
NEW_TOTAL = TOTAL_MEMBERS div 2,
split_team(NEW_TOTAL),
!.
analyze_teams:-
% EVERY TEAM HAS AT LEAS ONE MEMBER
TEAM_ID = 2,
team(1,_),
not(team(TEAM_ID,_)),
write("*** No solution - Team ",TEAM_ID," has no members"),nl,
!.
analyze_teams:-
write("*** Found solution"),nl.
everyone_knows_person([],_):-!.
everyone_knows_person([TEAM_MEMBER|LIST],PERSON):-
person_data(p(TEAM_MEMBER,KNOWN_LIST)),
member(KNOWN_LIST,PERSON),!,
everyone_knows_person(LIST,PERSON).
person_knows_everyone([],_):-!.
person_knows_everyone([PERSON|TEAM_MEMBERS],KNOWN_LIST):-
member(KNOWN_LIST,PERSON),!,
person_knows_everyone(TEAM_MEMBERS,TEAM_MEMBERS).
split_team(0):-!.
split_team(NEW_TOTAL):-
NEXT = NEW_TOTAL - 1,
retract(team(1,PERSON)),
assert(team(2,PERSON)),
split_team(NEXT),!.
display_teams:-
write("\tTeams"),nl,
team_id(TEAM_ID),
findall(X,team(TEAM_ID,X),TEAM_MEMBERS),
write("\t\tTeam ",TEAM_ID," - "),
display_list(TEAM_MEMBERS),nl,
fail.
display_teams.
display_persons:-
write("\tPersons"),nl,
person_data(p(PERSON_ID,KNOWN)),
write("\t\tPerson ",PERSON_ID," knows "),
display_list(KNOWN),nl,
fail.
display_persons.
/* SUPPORT PREDICATES */
remove_last([_],[]):-!.
remove_last([H|T],[H|TEMP]):-!,remove_last(T,TEMP).
nondeterm_member([F|_],F).
nondeterm_member([_|T],F):-nondeterm_member(T,F).
member([F|_],F):-!.
member([_|T],F):-member(T,F).
list_length([],0):-!.
list_length([_|T],LEN):-list_length(T,Temp),LEN = Temp+1.
string_to_slist(View,SEP,[HEAD|LISTTAIL]):-
searchstring(View,SEP,FoundPos),
str_len(SEP,SEPLength),
Pos = FoundPos - 1,
frontstr(Pos,View,HEAD,RestString),
frontstr(SEPLength,RestString,_,Tail),!,
string_to_slist(Tail,SEP,LISTTAIL).
string_to_slist(HEAD,_,[HEAD]).
for(I,I,_).
for(I,Start,Stop):-
Start < Stop,Next=Start+1,
for(I,Next,Stop).
display_list([]):-!.
display_list([H|SLIST]):-!,
write(H," "),
display_list(SLIST).
/* END OF SUPPORT PREDICATES */
read_input_data(FNam):-
syspath(ExeStartupPath,_),
format(Wild,"%s*.txt",ExeStartupPath),
dirfiles(Wild,fa_normal,FNam,_,_,_,_,_,_,_,_),
% for each file
retractall(_,teams_data),
retractall(_,persons_data),
% we have 2 teams
assert(team_id(1)),
assert(team_id(2)),
format(INPUT_FILE,"%s%s",ExeStartupPath,FNam),
openread(input,INPUT_FILE),
readdevice(input),
readln(NUMBER_OF_LINES),
str_int(NUMBER_OF_LINES,MAX_LINE),
read_persons_data(1,MAX_LINE),
closefile(input).
read_persons_data(PERSON,MAX_NUMBER):-
PERSON > MAX_NUMBER,
!.
read_persons_data(PERSON,MAX_NUMBER):-
readln(LINE),
string_to_slist(LINE," ",KNOWN),
remove_last(KNOWN,KNOWN_LIST),
str_int(PERSON_ID,PERSON),
assert(person_data(p(PERSON_ID,KNOWN_LIST))),
NEXT_PERSON = PERSON + 1,
read_persons_data(NEXT_PERSON,MAX_NUMBER).
display_header:-
write("Task definition\n"),
write("\teveryone belongs to one of the teams;\n"),
write("\tevery team has at least one member;\n"),
write("\tevery person in the team knows every other person in his team;\n"),
write("\tteams are as close in their sizes as possible\n"),
write("_______________________\n"),
write("Solution\n"),
!.
goal
team_them_up().