Scene Allocation Problem (oclpe06)
/***************************************************************/
/* */
/* S A S S A M P L E L I B R A R Y */
/* */
/* NAME: oclpe06 */
/* TITLE: Scene Allocation Problem (oclpe06) */
/* PRODUCT: OR */
/* SYSTEM: ALL */
/* KEYS: OR */
/* PROCS: OPTMODEL, GANTT */
/* DATA: */
/* */
/* SUPPORT: UPDATE: */
/* REF: Constraint and Integer Programming in OPL */
/* INFORMS J of Computing 14(4) 345-372, 2002 */
/* MISC: Example 6 from the CLP solver chapter of the */
/* Mathematical Programming book. */
/* */
/***************************************************************/
data scene;
input Number Actor $ DailyFee S_Var1 S_Var2 S_Var3 S_Var4
S_Var5 S_Var6 S_Var7 S_Var8 S_Var9;
datalines;
1 Patt 26481 2 5 7 10 11 13 15 17 .
2 Casta 25043 4 7 9 10 13 16 19 . .
3 Scolaro 30310 3 6 9 10 14 16 17 18 .
4 Murphy 4085 2 8 12 13 15 . . . .
5 Brown 7562 2 3 12 17 . . . . .
6 Hacket 9381 1 2 12 13 18 . . . .
7 Anderson 8770 5 6 14 . . . . . .
8 McDougal 5788 3 5 6 9 10 12 15 16 18
9 Mercer 7423 3 4 5 8 9 16 . . .
10 Spring 3303 5 6 . . . . . . .
11 Thompson 9593 6 9 12 15 18 . . . .
;
run;
proc print data=scene;
run;
%macro scene;
/* Ai_Sj=1 if actor i appears in scene j */
/* Ai_Sj=0 otherwise */
/* Initialize to 0 */
%do i=1 %to 11; /* 11 actors */
%do j=1 %to 19; /* 19 scenes */
%let A&i._S&j=0;
%end;
%end;
data scene_cost;
set scene;
keep DailyFee A;
retain DailyFee A;
do day=1 to 4;
A='A'||left(strip(_N_))||'_'||left(strip(day));
output;
end;
call symput("Name"||strip(_n_), Actor); /* read actor name */
call symput("Cost"||strip(_n_), DailyFee); /* read actor cost */
/* read whether an actor appears in a scene */
%do i=1 %to 9; /* 9 scene variables in the data set */
if S_Var&i > 0 then
call symput("A"||strip(_n_)||"_S"||strip(S_Var&i), 1);
%end;
run;
/* Create constraint data set which defines the objective function */
proc transpose data=scene_cost out=cost(drop=_name_);
var DailyFee;
id A;
run;
data cost;
set cost;
_TYPE_='MIN';
_RHS_=.;
run;
/* Generate the Gantt charts */
%gantt_gen;
%mend scene;
proc optmodel;
set ACTORS;
str actor_name {ACTORS};
num daily_fee {ACTORS};
num most_scenes = 9; /* most scenes by any actor */
num scene_list {ACTORS, 1..most_scenes};
read data scene into ACTORS=[_N_]
actor_name=Actor daily_fee=DailyFee
{j in 1..most_scenes} <scene_list[_N_,j]=col('S_Var'||j)>;
print actor_name daily_fee scene_list;
set SCENES_actor {i in ACTORS} =
(setof {j in 1..most_scenes} scene_list[i,j]) diff {.};
set SCENES = 1..19;
set DAYS = 1..4;
/* Indicates if actor i is present on day k. */
var A {ACTORS, DAYS} binary;
/* Indicates if scene j is shot on day k. */
var S {SCENES, DAYS} binary;
/* Every scene is shot exactly once.*/
con SceneCon {j in SCENES}:
gcc({k in DAYS} S[j,k], {<1,1,1>});
/* At least 4 and at most 5 scenes are shot per day. */
con NumScenesPerDayCon {k in DAYS}:
gcc({j in SCENES} S[j,k], {<1,4,5>});
/* Actors for a scene must be present on day of shooting. */
con LinkCon {i in ACTORS, j in SCENES_actor[i], k in DAYS}:
S[j,k] <= A[i,k];
/* Symmetry-breaking constraints. Without loss of any generality, you
can assume Scene1 to be shot on day 1, Scene2 to be shot on day 1
or day 2, and Scene3 to be shot on either day 1, day 2, or day 3. */
fix S[1,1] = 1;
for {k in 2..4} fix S[1,k] = 0;
for {k in 3..4} fix S[2,k] = 0;
fix S[3,4] = 0;
/* If Scene2 is shot on day 1, (as opposed to day 2) */
/* then Scene3 can be shot on day 1 or day 2 (but not day 3). */
con Symmetry:
S[2,1] + S[3,3] <= 1;
/* Minimize total cost. */
min TotalCost = sum {i in ACTORS, k in DAYS} daily_fee[i] * A[i,k];
/* Set lower and upper bounds for the objective value */
/* Lower bound: every actor appears on one day. */
/* Upper bound: every actor appears on all four days. */
num obj_lb = sum {i in ACTORS} daily_fee[i];
num obj_ub = sum {i in ACTORS, k in DAYS} daily_fee[i];
put obj_lb= obj_ub=;
con TotalCost_bounds:
obj_lb <= TotalCost <= obj_ub;
solve with CLP / varselect=maxc;
create data out from
{i in ACTORS, k in DAYS} <col('A'||i||'_'||k)=A[i,k]>
{j in SCENES, k in DAYS} <col('S'||j||'_'||k)=S[j,k]>;
quit;
%macro scenesbyday;
proc transpose data=out out=dayout; run;
%do i=1 %to 4;
%global day&i.;
proc sql;
create table day&i. as
select substr( ' ',length(_name_)-2)||
substr(_name_,2,index(_name_,'_')-2)
from dayout where _name_ like 'S%_'||"&i." and col1=1;
quit;
data _null_;
set day&i. end=lastobs;
format string $32.;
retain string '';
string = strip(string) || substr(' ',length(strip(_TEMA001)))
|| (strip(_TEMA001));
if lastobs then do;
var = 'day' || strip(put(&i.,best.));
call symput(var, string);
end;
run;
%end;
proc sql;
insert into day1 values(' ');
quit;
data scenes;
rename _TEMA001 = label;
set day1 day2 day3 day4;
fmtname='scenes';
start = _n_;
end = _n_;
run;
proc sql;
insert into scenes values(' ', 'scenes', 21, 21);
quit;
proc format cntlin=scenes; run;
proc format;
value days
1 = ' Day 1 '
6 = ' Day 2'
11 = ' Day 3'
16 = ' Day 4'
;
value scenedays
1 = ' Scenes '
6 = ' Scenes'
11 = ' Scenes'
16 = ' Scenes'
;
run;
%mend;
%macro gantt_gen;
%scenesbyday;
data gantt_actor;
format actor $15.;
format s_start s_finish scenes.;
set out;
label actor='Actor';
keep _label _labele segmt_no actor s_start s_finish;
%do i = 1 %to 11;/* 11 actors */
segmt_no = 1;
%do k = 1 %to 4; /* 4 days */
actor="&&Name&i";
if (A&i._&k ne 0) then do;
%let j = 1;
%let m = 1;
%let scene = %scan(&&day&k.,&j.);
%do %while (&scene. ne );
_label = '';
_labele = 'W';
%if (&&A&i._S&scene.>0) %then %do;
if (S&scene._&k=1) then do;
_label = 'W';
_labele = '';
end;
%end;
s_start=(&k.-1)*5 + &m.;
s_finish=s_start + 0.9;
output;
segmt_no = segmt_no + 1;
%let m = %eval(&m.+1);
%let j = %eval(&j.+1);
%let scene = %scan(&&day&k.,&j.);
%end;
_label = "";
end;
%end;
%end;
run;
data labels;
format _flabel _lvar $10.;
_y=-1;
_lvar="_label";
_xvar="s_start";
_hlabel=3;
_yoffset = 2.0;
_xoffset = 0.3;
_flabel='marker';
output;
_y=-1;
_lvar="_labele";
_flabel='markere';
output;
run;
data gantt_scene;
format _label $80. scene $2.;
format s_start s_finish scenes.;
set out;
label scene='Scene';
keep _label segmt_no scene s_start s_finish duration;
retain duration 0.95;
%do j = 1 %to 19;/* 19 scenes */
%do k = 1 %to 4; /* 4 days */
if ( S&j._&k = 0) then do;
s_start=.;
s_finish=.;
segmt_no = &k;
_label = "";
scene="&j";
output;
end;
else do;
%do i = 1 %to 11;/* 11 actors */
%if (&&A&i._S&j>0) %then %do;
if (_label ne '') then
_label = strip(_label)||", &&Name&i";
else _label = "&&Name&i";
%end;
%end;
s_start=%eval(&k-1)+0.5;
s_finish=&k+0.45;
segmt_no = &k;
scene="&j";
output;
_label = "";
end;
%end;
%end;
run;
%mend gantt_gen;
%scene;
title1 h=4pct "Scene Allocation Problem";
title2 h=3pct "Optimal Schedule by Actor";
goptions reset=pattern;
pattern1 v=e c=white r=10;
proc gantt data=gantt_actor labdata=labels;
chart /
skip=3
nojobnum
nolegend
pcompress
act=actor
increment=1
useformat
ref=6 11 16
height=3
chartwidth=89
timeaxisformat=(days., scenedays., scenes.);
;
id actor;
run;
title1 h=4pct "Scene Allocation Problem";
title2 h=3pct "Optimal Schedule by Scene";
proc format;
value scenes
0.5 = ' 1'
1.5 = ' 2'
2.5 = ' 3'
3.5 = ' 4'
4.5 = ' '
;
run;
data labels;
_y=-1;
_lvar="_label";
_xvar="s_start";
_hlabel=4;
_yoffset = -0.4;
_xoffset = 0;
run;
goptions reset=pattern;
pattern1 r=10 c=ltgray v=s;
proc gantt data=gantt_scene labdata=labels;
chart /
skip=3
nolegend
nojobnum
compress
act=scene
duration=duration
increment=1
mindate=0.5
labsplit='/'
useformat
height=4
chartwidth=95
barht=1.1
;
id scene;
run;
