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;