Round Robin Tournament Scheduling (clpe08)
/***************************************************************/
/* */
/* S A S S A M P L E L I B R A R Y */
/* */
/* NAME: clpe08 */
/* TITLE: Round Robin Tournament Scheduling (clpe08) */
/* PRODUCT: OR */
/* SYSTEM: ALL */
/* KEYS: OR */
/* PROCS: CLP, GANTT, SQL */
/* DATA: */
/* */
/* SUPPORT: UPDATE: */
/* REF: */
/* MISC: Example 8 from the CLP Procedure chapter of the */
/* Constraint Programming book. */
/* */
/***************************************************************/
%macro round_robin(nteams);
%let nrounds = %eval(%sysfunc(ceil((&nteams * (&nteams - 1)/2)/4)));
data actdata;
do i = 1 to &nteams - 1;
do j = i + 1 to &nteams;
_activity_ = compress('ACT_'||put(i,best.)||'_'||put(j,best.));
_duration_ = 1;
output;
end;
end;
run;
proc clp actdata = actdata schedule = schedule;
schedule finish = &nrounds actselect=minls;
resource (TEAM1-TEAM&nteams);
resource (ROOM1-ROOM4);
requires
%do i = 1 %to &nteams - 1;
%do j = &i + 1 %to &nteams;
ACT_&i._&j = ( TEAM&i )
ACT_&i._&j = ( TEAM&j )
ACT_&i._&j = ( ROOM1, ROOM2, ROOM3, ROOM4)
%end;
%end;
;
run;
proc sort data=schedule;
by start finish;
run;
%mend round_robin;
%round_robin(14);
/* Convert output schedule data set from proc CLP to PM format */
%macro schedcvt(dsn);
data &dsn._temp1;
set &dsn.(drop=RESOURCE QTY);
if OBSTYPE='TIME';
run;
proc sort data=&dsn._temp1(drop=OBSTYPE);
by ACTIVITY;
run;
data &dsn._temp2;
set &dsn.(drop=DURATION START FINISH);
if OBSTYPE='RESOURCE';
run;
proc sort data=&dsn._temp2;
by ACTIVITY;
run;
proc transpose data=&dsn._temp2 out=&dsn._temp21(drop=_NAME_);
by ACTIVITY;
var QTY;
id RESOURCE;
run;
data &dsn.;
merge &dsn._temp1 &dsn._temp21;
by ACTIVITY;
run;
data schedule(drop=i);
set schedule;
array testmiss(*) _numeric_;
do i = 1 to dim(testmiss);
if testmiss(i)=. then testmiss(i)=0;
end;
run;
%mend schedcvt;
%schedcvt(schedule);
/******************************************************************/
/* SET UP PATTERNS AND LEGEND ANNOTATION */
/******************************************************************/
/* Specify pattern statements */
%macro setPattern(count, color);
pattern&count. v=s color=&color repeat=1;
%mend setPattern;
/* map colors to patterns */
%macro setPatterns(data=pattern_color_map);
data _null_;
set &data;
retain count 1;
dummy = resolve('%setPattern('||put(count,best.)||','||color||')');
call execute(dummy);
count = count + 1;
run;
%mend setPatterns;
/* map colors to patterns */
data pattern_color_map;
format color $8.;
input _pattern color $8.;
datalines;
1 red
2 blue
3 yellow
4 orange
;
%macro addLegend(title=, colsperrow=5, data=machine_color_map,
activity=machine, fontfactor=0.85, out=anno, footnotes=4,
xDisplacement=35, yDisplacement=5, center=100, yStart=0,
barHeight=1.75, barWidth=4.0, barTextFactor=3.0,
yTitleStart=7);
%annomac;
/* create space for annotating legend */
%do i = 1 %to &footnotes-1;
footnote&i. ' ';
%end;
footnote&footnotes. c=ltgray h=1.5 j=c ;
%let xStart = %sysevalf(¢er - (&xDisplacement * &colsperrow / 2.0));
data &out;
%dclanno;
%system(3,3,4);
format savcol $8.;
drop count savcol tempx tempy;
set &data;
tempy = int(count/&colsperrow);
tempx = count - &colsperrow*tempy;
retain count 0;
retain y &yStart;
retain x &xStart;
savcol = color;
if count eq 0 then do;
%LABEL(%sysevalf(¢er-(%length(&title)*&fontfactor)),
%sysevalf(&yStart+&yTitleStart), &title, , 0, 0,
%sysevalf(&barHeight.*1.2), , C);
end;
color = savcol;
x = &xStart + tempx*&xDisplacement;
y = &yStart - tempy*&yDisplacement;
%bar(x, y, x+&barWidth, y+&barHeight, *, 0, solid);
x = x + &barWidth/&barTextFactor;
y = y - &barHeight;
%label(x, y, input(&activity,best.), , 0, 0,
%sysevalf(&barHeight), , C);
count = count + 1;
run;
%setPatterns;
%mend addLegend;
%macro displayrr;
proc sql;
create table temp as
select trim(translate(substr(activity,5,2), '', '_'))
as p1str 'Team 1',
strip(translate(substr(activity,7), '', '_'))
as p2str 'Team 2',
1+log2(room1 * 1 + room2*2 + room3*4 + room4*8) as room,
duration, start, finish from schedule;
create table schedsort as
select p1str, p2str, duration, start, finish, room from temp
union corresponding
select p1str as p2str, p2str as p1str, duration, start, finish,
room from temp;
quit;
/* Show Team Schedule */
proc sort data=schedsort;
by p1str start;
run;
data schedseg;
set schedsort;
keep duration p1 segmt_no _pattern start finish p2str room;
retain segmt_no;
format _pattern p1 3.;
label p1 = 'Team';
p1 = input(p1str,best.);
_pattern = room;
if p1str ne lag1(p1str) then do;
segmt_no = 1;
end;
else do;
segmt_no = segmt_no + 1;
end;
finish = finish - 0.1;
run;
proc sort data=schedseg;
by p1 segmt_no;
run;
data labelsa;
_y=-1;
_lvar="p2str";
_xvar="start";
_hlabel=0.8;
_yoffset = -.2;
_xoffset = 0.35;
run;
%addLegend(title='Rooms', data=pattern_color_map, activity=_pattern,
colsperrow=2, xDisplacement=7, yDisplacement=3, yStart=10,
center=53, barHeight=1, barWidth=2.5, fontFactor=0.5,
barTextFactor=-3.0, yTitleStart=3);
title 'PROC CLP: Schedule For Each Team';
title2 'Number Above Segment Indicates Opponent';
goptions htext=1.0;
title1 h=5pct c = ltgray 'Round Robin Team Schedule';
title2 h=1.25 'Number Above Bar Indicates Opponent';
proc gantt data=schedseg anno=anno labdata=labelsa;
id p1 /* start finish */;
chart /
act=p1
duration=duration
ss=start /* start time */
sf=finish /* finish time */
pcompress /* compresses chart onto a single page */
nojobnum
nolegend;
run;
/* Show Room Schedule */
proc sort data=temp;
by room start;
run;
data roomsched;
set temp;
keep duration teams segmt_no start finish room finish1;
retain segmt_no;
label room='Room';
teams = trim(p1str)||'/'||trim(p2str);
finish1= finish - .1;
if room ne lag1(room) then do;
segmt_no = 1;
end;
else do;
segmt_no = segmt_no + 1;
end;
run;
data labelsb;
_y=-1;
_lvar="teams";
_xvar="start";
_hlabel=.7; _jlabel='r';
_yoffset = -.2;
_xoffset = 0.8;
run;
goptions reset=pattern htext=.75 hsize=8in vsize=5in vpos=25;
pattern1 c=ltgray r=10;
title1 h=5pct c = ltgray 'Round Robin Room Schedule';
title2 h=.75 'Numbers In Bar Indicate Pairings';
proc gantt data=roomsched labdata=labelsb;
id room /* start finish */;
chart /
act=room
duration=duration
skip = 2 barht=2 labsplit='/'
ss=start /* start time */
sf=finish1 /* finish time */
pcompress /* compresses chart onto a single page */
nojobnum
nolegend;
run;
%mend displayrr;
%displayrr;
title;