Recursive script for Sisyphus-I

function main ()
{
  //Test if the problem is solvable
  spec Employee : ?      | count | set number_of_employees;
  spec Small_office : ?  | count | set number_of_small_offices;
  spec Large_office : ?  | count | set number_of_large_offices;
  set number_of_places
             `expr 2 \* $number_of_large_offices + $number_of_small_offices`;
  if ($number_of_places < $number_of_employees)
  { print "Insolvable problem: there are" $number_of_employees
          "employees and only" $number_of_places "places in the offices";
  }
  else
  { //List employees already placed if any
    spec [Employee]->(In)->[Office] | count | set number_of_placed_employees;
    if ($number_of_placed_employees > 0)
    { print "Employees already placed:";  spec [Employee]->(In)->[Office]; }

    //Initialise global variables and call the function solving the problem
    spec Employee   : ?  |  set The_employees;
    spec Group_head : ?  |  set The_group_head;
    spec Secretary  : ?  |  set The_secretaries;
    spec Manager    : ?  |  set The_managers;
    spec Large_project_head : ?  |  set The_head_of_large_projects;
    spec Simple_researcher  : ?  |  set The_simple_researchers;
    spec "[Employee:$The_group_head]->(In)->[Office:?]" | set Office_of_group_head;
    spec [Employee:?]- { (Agent)<-[Smoke]; } | set Smokers;
    spec [Employee:?]- { (Agent)<-[Hack]; }  | set Hackers;
    spec [Employee:?]- { (Agent)<-[Hack]; (Agent)<-[Smoke]; } | set Hackers_smokers;

    subtract "$Smokers" "$Hackers_smokers" | set Smokers_non_hackers;
    subtract "$Hackers" "$Hackers_smokers" | set Hackers_non_smokers;
    subtract "$The_employees" "$Smokers" | set Non_smokers;
    subtract "$Non_smokers" "$Hackers_non_smokers" | set Non_hackers_non_smokers;

    set Trace no;   //By default, reasoning traces are printed.
                    //The user must type "set Trace no" to have no trace
    set Answers "";
    if (possible_to_place_the_employees_without_office("")) { print $Answers; }
    else { if ($Answers!="") { print $Answers; }
           else { print "Internal error: an answer should have been found"; }
         }
  }
}


/* The next function returns true if it places 1 employee without office
   or if all employees have an office. Actually, this function tries to place
   all employees without office since it is indirectly recursive via the
   function possible_to_place_first(). This last function manages the backtraking
   when a sequence of office allocation fails. Indented traces shows the sequence
   of office allocations and the backtracking. The parameter "i" contains the
   current indentation for traces.
*/
boolean function possible_to_place_the_employees_without_office (i)
{
  if ($Office_of_group_head == "")
  { if (possible_to_place_head_of_group(Large_central_office))  { return true; }
    if (possible_to_place_head_of_group(Small_central_office))  { return true; }
    if (possible_to_place_head_of_group(Large_and_not_central_office)){return true;}
    if (possible_to_place_head_of_group(Small_and_not_central_office)){return true;}
    set Answers "No office left for the head of group $The_group_head";
    return false;
  }

  set s get_an_employee_without_office("$The_secretaries");
  if ($s)
  { //First, try to place $s with another secretary
    for s2 in $The_secretaries
    { spec "[Employee:$s2]->(In)->[Office:?]" | set offices_with_a_secretary;
      for o in $offices_with_a_secretary
      { if (office_not_fully_occupied($o))
        { if (possible_to_place_first($s,$o," ")) { return true; } }
      }
    }
    //Try to place $s alone nearest to the head of group
    if (possible_to_place_nearest_head_of_group($s,Large_office,$i)) {return true;}
    if (possible_to_place_nearest_head_of_group($s,Small_office,$i)) {return true;}
    set Answers "The secretary $s cannot be placed close to
          $Office_of_group_head, the office of head of group $The_group_head";
    return false;
  }

  set m get_an_employee_without_office("$The_managers");
  if ($m)
  { if (possible_to_place_nearest_head_of_group($m,Small_central_office,$i))
    { return true; }
    if (possible_to_place_nearest_head_of_group($m,Small_and_not_central_office,$i))
    { return true; }
    if (possible_to_place_nearest_head_of_group($m,Large_central_office,$i))
    { return true; }
    if (possible_to_place_nearest_head_of_group($m,Large_and_not_central_office,$i))
    { return true; }
    set Answers "The manager $m cannot be placed close to
           $Office_of_group_head, the office of head of group $The_group_head";
    return false;
  }

  set h get_an_employee_without_office("$The_head_of_large_projects");
  if ($h)
  { if (possible_to_place_nearest_head_of_group($h,Small_office,$i)) {return true;}
    if (possible_to_place_nearest_head_of_group($h,Large_office,$i)) {return true;}
    set Answers "The head of large project $h cannot be placed close to
           $Office_of_group_head, the office of head of group $The_group_head";
    return false;
  }


  set r get_an_employee_without_office("$The_simple_researchers");
  if ($r)
  { if (possible_to_place_alone($r,Small_office,$i)) { return true; }
    if (possible_to_place_alone($r,Large_office,$i)) { return true; }
    if (possible_to_place_with_another_simple_researcher($r,$i)) { return true; }
    set Answers "No office left for the researcher $r";
    return false;
  }

  return true; //all employees are already placed
}


string function get_an_employee_without_office (employees)
{ for e in $employees
  { spec "[Employee:$e]->(In)->[Office]" | set office_of_this_employee;
    if ("$office_of_this_employee" == "") { return $e; }
  }
  return "";
}


boolean function possible_to_place_head_of_group (kind_of_office)
{
  spec $kind_of_office : ?  |  set office_of_this_kind;
  for o in $office_of_this_kind
  { spec "[Employee]->(In)->[Office:$o]" | set occupied_office;
    if ("$occupied_office" == "") //$o is empty
    { set Office_of_group_head $o;
      if (possible_to_place_first($The_group_head,$o," ")) { return true; }
    }
  }
  return false;
}


boolean function office_not_fully_occupied (office)
{
  spec "[Employee]->(In)->[Office:$office]" | count | set number_of_occupants;
  if ($number_of_occupants == 0) { return true; }
  ? Large_office : $office | set office_is_large;
  if ($office_is_large)
  { if ($number_of_occupants < 2) { return true; } }
  return false;
}


boolean function possible_to_place_nearest_head_of_group (employee,kind_of_office,i)
{ set near_chain "->(Near)->";  //first, try very close offices
  while (true)                  //then the loop progressively increases $near_chain
  { spec "[Office:?]$near_chain[Office:$Office_of_group_head]"
        | set offices_near_group_head;
    if ($offices_near_group_head == "") { break; } //no more office at such distance
    for o in $offices_near_group_head
    { ? $kind_of_office : $o  | set office_is_suitable;
      if ($office_is_suitable)
      { spec "[Employee]->(In)->[Office:$o]" | set occupied_office;
         if ("$occupied_office" == "") //$o is empty
         { if (possible_to_place_first($employee,$o,$i)) { return true; } }
      }
    }
    set near_chain "$near_chain[Office]->(Near)->";
  }
  return false;
}


boolean function possible_to_place_alone (employee, kind_of_office, i)
{ /*print $employee; print $kind_of_office;*/
  spec $kind_of_office : ?  |  set office_of_this_kind;
  for o in $office_of_this_kind
  { spec "[Employee]->(In)->[Office:$o]" | set occupied_office;
    if ("$occupied_office" == "") //$o is empty, the employee can be alone
    { if (possible_to_place_first($employee,$o,$i)) { return true; } }
  }
  return false;
}

/* 1) Place smoker with smoker, non-smoker with non-smoker
   2) Place researcher with researcher of a different project
   3) Place hacker with hacker, non hacker with non-hacker
*/
boolean function possible_to_place_with_another_simple_researcher (e, i)
{
  //print "possible_to_place $e with_another_simple_researcher";
  spec "[Employee:$e]<-(Agent)<-[Hack]"  | set employee_hacks;
  spec "[Employee:$e]<-(Agent)<-[Smoke]" | set employee_smokes;
  spec "[Employee:$e]->(Project)->[Project:?]" | set p; //$p: project of $e

  //Place $e with another one with similar smoking and hacking habits
  //and from a different project
  if ("$employee_hacks")
  { if ("$employee_smokes")
    { if (possible_to_place_with($e,Hackers_smokers,$p,$i)) { return true; }
      if (possible_to_place_with($e,Hackers_smokers,"",$i)) { return true; }
    }
    else
    { if (possible_to_place_with($e,Hackers_non_smokers,$p,$i)) { return true; }
      if (possible_to_place_with($e,Hackers_non_smokers,"",$i)) { return true; }
    }
  }
  else
  { if ("$employee_smokes")
    { if (possible_to_place_with($e,Smokers_non_hackers,$p,$i)) { return true; }
      if (possible_to_place_with($e,Smokers_non_hackers,"",$i)) { return true; }
    }
    else
    { if (possible_to_place_with($e,Non_hackers_non_smokers,$p,$i)) { return true; }
      if (possible_to_place_with($e,Non_hackers_non_smokers,"",$i)) { return true; }
    }
  }

  //Now the hacking constraint is relaxed
  if ("$employee_smokes")
  { if (possible_to_place_with($e,Smokers,$p,$i)) { return true; }
    if (possible_to_place_with($e,Smokers,"",$i)) { return true; }
  }
  else
  { if (possible_to_place_with($e,Non_smokers,$p,$i)) { return true; }
    if (possible_to_place_with($e,Non_smokers,"",$i)) { return true; }
  }

  return false;
}


boolean function possible_to_place_with (employee, kind_of_co-occupants,
                                         project, i)
{ set suitable_co-occupants $$kind_of_co-occupants;
  //print "possible_to_place $e ($project) with $kind_of_co-occupants: $suitable_co-occupants .";
  for e2 in $suitable_co-occupants
  { if ($e2 != $employee)
    { ? Simple_researcher: $e2  | set e2_is_a_simple_researcher;
      if ($e2_is_a_simple_researcher)
      { spec "[Employee:$e2]->(In)->[Office:?]" | set o;
        if ($o)
        { ? Large_office : $o | set office_is_large;
          if ($office_is_large)
          { spec "[Employee]->(In)->[Office:$o]" | count | set number_of_occupants;
            if ($number_of_occupants < 2)
            { spec "[Employee:$e2]->(Project)->[Project:?]" | set p2;
              if ($project)
              { if ($p2)
                { if ($p2 != $project)
                  { if (possible_to_place_first($employee,$o,$i)) { return true; } }
                }
              }
              else { if (possible_to_place_first($employee,$o,$i)) {return true;} }
            }
          }
        }
      }
    }
  }

  return false;
}



boolean function possible_to_place_first (employee, office, i)
{
  if ($Trace != no) { print $i "$employee placed in $office"; }
  print "  " $i | set new_indentation;

  name "#$employee$office" "[Employee: $employee]->(In)->[Office: $office]";
  //print "---------------------------------------------------------------";
  if (possible_to_place_the_employees_without_office("$new_indentation"))
  { set Answers "$employee placed in $office
$Answers";
    return true;
  }

  if ($Trace != no) { print $i "$employee cannot be placed in $office"; }
  delCG "#$employee$office";
  return false;
}


main();  //run the program