Puzzles and pastimes from the book `Programmation Lineaire'

(!******************************************************
   Mosel Example Problems
   ======================

   file k1masterm_ka.mos
   `````````````````````
   Playing Mastermind

   Given information:
   Round  Pos.1   Pos.2   Pos.3   Pos.4   Judgement
    1     red     yellow  white   green   1 color well positioned, 
                                          1 color on wrong position  
    2     blue    green   white   blue    1 color well positioned
    3     yellow  black   white   black   1 color well positioned, 
                                          1 color on wrong position
    4     blue    yellow  red     black   all colors on wrong position
       
   (c) 2008 Fair Isaac Corporation
       author: S. Heipcke, March 2005
*******************************************************!)

model "K-1 Mastermind (CP)"
 uses "kalis"

 declarations
  POS = 1..4                          ! Positions in a row
  COLORS = 1..6                       ! 1: White, 2: Blue, 3: Yellow, 
                                      ! 4: Black, 5: Red, 6: Green
  place: array(POS) of cpvar          ! Color of position
  use: array(COLORS) of cpvar         ! Number of occurences of a color
 end-declarations
 
! Creation of variables 
 forall(p in POS) do 
  1 <= place(p); place(p) <= 6; end-do
 forall(c in COLORS) do 
  0 <= use(c); use(c) <= 4; end-do
 
! Relation between placement variables and choice indicators 
 forall(c in COLORS) use(c) = occurrence(c, place)
 sum(c in COLORS) use(c) = 4

! Round 1: 1 color well positioned, 1 color on wrong position
 place(1)=5 or place(2)=3 or place(3)=1 or place(4)=6
 use(5) + use(3) + use(1) + use(6) = 2

 writeln("Round 1: ", place, use) 
 
! Round 2: 1 color well positioned
 place(1)=2 or place(2)=6 or place(3)=1 or place(4)=2
 use(2) + use(6) + use(1) = 1

 writeln("Round 2: ", place, use) 

! Round 3: 1 color well positioned, 1 color on wrong position
 place(1)=3 or place(2)=4 or place(3)=1 or place(4)=4
 use(3) + use(4) + use(1) = 2

 writeln("Round 3: ", place, use) 
 
! Round 4: 4 colors on wrong position
 place(1)<>2; place(2)<>3; place(3)<>5; place(4)<>4
 forall(p in POS) do
  2 <= place(p); place(p) <= 5
 end-do
 use(2)=1; use(3)=1; use(5)=1; use(4)=1 
 
 writeln("Round 4: ", place, use) 



! Branching strategy
 cp_set_branching(assign_var(KALIS_SMALLEST_DOMAIN, KALIS_MIN_TO_MAX, place))

! Solve the problem 
 if not cp_find_next_sol then
  writeln("Problem is infeasible")
  exit(1)
 end-if

! Solution printing
 declarations
  COLORNAMES: array(COLORS) of string
 end-declarations
 
 COLORNAMES:: ["White","Blue","Yellow","Black","Red","Green"]
 
 forall(p in POS)
  writeln("Position ", p, ": ", COLORNAMES(getsol(place(p))) )
  
end-model

(!******************************************************
   Mosel Example Problems
   ======================

   file k2marath_ka.mos
   ````````````````````
   Marathon puzzle
   
   Dominique, Ignace, Naren, Olivier, Philippe, and Pascal
   have arrived as the first six at the Paris marathon.
   Reconstruct their arrival order from the following
   information:
   a) Olivier has not arrived last
   b) Dominique, Pascal and Ignace have arrived before Naren 
      and Olivier
   c) Dominique who was third last year has improved this year.
   d) Philippe is among the first four.
   e) Ignace has arrived neither in second nor third position.
   f) Pascal has beaten Naren by three positions.
   g) Neither Ignace nor Dominique are on the fourth position.

   (c) 2008 Fair Isaac Corporation
       author: S. Heipcke, March 2005
*******************************************************!)

model "K-2 Marathon (CP)"
 uses "kalis"

 declarations
  NPOS = 6
  POS = 1..NPOS                       ! Arrival positions
  RUNNERS = {"Dominique","Ignace","Naren","Olivier","Philippe","Pascal"}
    
  arrive: array(RUNNERS) of cpvar     ! Position of runner
 end-declarations

! Creation of variables
 forall(r in RUNNERS) do
  setname(arrive(r),r)
  1 <= arrive(r); arrive(r) <= NPOS
 end-do

! Every runner has a different position
 all_different(arrive) 
 
! a: Olivier not last
 arrive("Olivier") <= 5

! b: Dominique, Pascal and Ignace before Naren and Olivier
 forall(r in {"Dominique","Pascal","Ignace"}, s in {"Naren","Olivier"})
  arrive(r) <= arrive(s) - 1
 
! c: Dominique better than third
 arrive("Dominique") <= 2
 
! d: Philippe is among the first four 
 arrive("Philippe") <= 4

! e: Ignace neither second nor third
 arrive("Ignace") <> 2;  arrive("Ignace") <> 3

! f: Pascal three places earlier than Naren
 arrive("Pascal") + 3 = arrive("Naren")

! g: Neither Ignace nor Dominique on fourth position
 arrive("Ignace") <> 4; arrive("Dominique") <> 4

! Solve the problem
 if cp_find_next_sol then
  forall(r in RUNNERS) writeln(r, ": ", arrive(r))
 else
  writeln("Problem is infeasible")
 end-if
 
end-model

(!******************************************************
   Mosel Example Problems
   ======================

   file k3congress_ka.mos
   ``````````````````````
   Congress puzzle
   
   At an international congress taking place on 7-11 August
   five researchers of different nationality are giving talks,
   each on a different day. Find out the date and nationality
   for every researcher from the following information:
   a) Michael is not Japanese.
   b) Eric is French and he talks before the 10th.
   c) Arabinda talks on the 9th.
   d) The Chinese who is not Hitoshi gives his talk on the 8th, 
      before Michael.
   e) Hitoshi does his talk after the Indian and before the American.
   
   (c) 2008 Fair Isaac Corporation
       author: S. Heipcke, March 2005
*******************************************************!)

model "K-3 Congress (CP)"
 uses "kalis"

 declarations
  DAYS = 7..11
  NAMES = {"Arabinda","Eric","Hitoshi","Michael","Zhicheng"}
  NAT = {"Japanese","French","Chinese","American","Indian"}
    
  talkp: array(NAMES) of cpvar         ! Choice of day for person p
  talkn: array(NAT) of cpvar           ! Choice of day for nationality n
 end-declarations

 forall(p in NAMES) setdomain(talkp(p), DAYS)
 forall(n in NAT) setdomain(talkn(n), DAYS)

! Every researcher on a different day
 all_different(talkp)
 
! Every nationality exactly once
 all_different(talkn)
 
! a: Michael is not Japanese
 talkp("Michael") <> talkn("Japanese")

! b: Eric is French and he talks before the 10th
 talkp("Eric") = talkn("French")
 talkp("Eric") <= 9

! c: Arabinda talks on the 9th
 talkp("Arabinda") = 9

! d: The Chinese who is not Hitoshi gives his talk on the 8th, before Michael
 talkp("Hitoshi") <> talkn("Chinese")
 talkn("Chinese") = 8
 talkp("Michael") >= 9

! e: Hitoshi does his talk after the Indian and before the American
 talkp("Hitoshi") >= talkn("Indian") + 1
 talkp("Hitoshi") <= talkn("American") - 1
 
 ! Solving and solution printing
 if cp_find_next_sol then
  forall(p in NAMES) do
   write(p," (") 
   day:= getub(talkp(p))
   forall(n in NAT) write( if(getub(talkn(n))=day, n, "") )
   writeln(") : ", day)
  end-do
 else
  writeln("Problem is infeasible")
 end-if

end-model

(!******************************************************
   Mosel Example Problems
   ======================

   file k4even_ka.mos
   ```````````````
   Placing a given number of chips on a 4x4 grid 
   such that every row and every column contains
   an even number of chips.
   
   (c) 2008 Fair Isaac Corporation
       author: S. Heipcke, March 2005, rev. Jan. 2018
*******************************************************!)

model "K-4 Even (CP)"
 uses "kalis"

 forward procedure test_return(result: boolean)

 setparam("KALIS_DEFAULT_LB", 0)

 declarations
  NPOS = 4
  POS = 1..NPOS                       ! Positions in a row/column
  NCHIP = 10                          ! Number of chips
    
  place: array(POS,POS) of cpvar      ! 1 if chip at the position, 0 otherwise
  row, column: array(POS) of cpvar    ! Chips per row/column
 end-declarations

! Creation of variables
 forall(r,c in POS) place(r,c) <= 1
 VALUES:= union(p in POS | isodd(p)) {p}
 forall(r in POS) do
  row(r) <= NPOS
  forall(v in VALUES) row(r) <> v
 end-do 
 forall(c in POS) do
  column(c) <= NPOS
  forall(v in VALUES) column(c) <> v
 end-do

! Total number of chips
 NumChip:= sum(r,c in POS) place(r,c) = NCHIP
 test_return(cp_post(NumChip))

! Even number of chips in all rows and columns
 forall(r in POS) do
  PR(r):= sum(c in POS) place(r,c) = row(r)
  test_return(cp_post(PR(r)))
 end-do
 forall(c in POS) do
  PC(c):= sum(r in POS) place(r,c) = column(c)
  test_return(cp_post(PC(c)))
 end-do

! Define enumeration 
 cp_set_branching(assign_and_forbid(KALIS_SMALLEST_MAX, KALIS_MAX_TO_MIN,
                                    place))

! Solve the problem 
 if not(cp_find_next_sol) then
  writeln("Problem is infeasible")
  exit(1)
 end-if 
 
! Solution printing
 forall(r in POS) do
  forall(c in POS) write( if(getsol(place(r,c))>0, "X ", ". ") )
  writeln
 end-do

!***********************************************************************
! Error handling
 procedure test_return(result: boolean)
  if not(result) then
   writeln("Problem is infeasible")
   exit(1)
  end-if
 end-procedure
  
end-model

(!******************************************************
   Mosel Example Problems
   ======================

   file k5nephew_ka.mos
   `````````````````
   Distributing wine barrels among nephews
   
   A farmer wishes to distribute his 45 wine barrels among
   his 5 nephews. 9 barrels are full, 9 filled to 3/4, 
   9 half-full, 9 filled to a quarter, and 9 are empty.
   Each nephew is to receive the same number of barrels
   and the same volume of wine. Furthermore, each nephew
   must receive at least one barrel of every type and 
   no two of the nephews must be allocated exactly the
   same number of barrels of every fill type. 

   (c) 2008 Fair Isaac Corporation
       author: S. Heipcke, March 2005, rev. Jan. 2018
*******************************************************!)

model "K-5 Nephew (CP)"
 uses "kalis"

 setparam("KALIS_DEFAULT_UB", 100000)

 declarations
  NN = 5; NT = 5
  NEPHEWS = 1..NN                     ! Nephews
  TYPES = 1..NT                       ! Contents types of wine barrels
  BARRELS = 45
    
  COEF: array(TYPES) of integer       ! Factors for "all_different" constraint
  FILL: array(TYPES) of integer       ! Fill level of barrels

  give: array(NEPHEWS,TYPES) of cpvar ! Barrels of type t for every nephew
  p: array(NEPHEWS) of cpvar          ! 'Pattern': value of the product
                                      !            c*give(n,t)
 end-declarations

 FILL:: [100, 75, 50, 25, 0]
 COEF:: [10000, 1000, 100, 10, 1]

! Bounds and names for variables
 forall(n in NEPHEWS, t in TYPES) do
  setname(give(n,t),"GIVE["+n+","+t+"]")
  1 <= give(n,t); give(n,t) <= NN
 end-do
 forall(t in TYPES) setname(p(t),"PRODUCT["+t+"]")  
 
! Barrels per nephew
 forall(n in NEPHEWS) sum(t in TYPES) give(n,t) = round(BARRELS/NN)
 forall(t in TYPES) sum(n in NEPHEWS) give(n,t) = round(BARRELS/NN)

! Equilibrated contents
 forall(n in NEPHEWS) 
   sum(t in TYPES) FILL(t)*give(n,t) = 
           round(BARRELS/NN * (sum(t in TYPES) FILL(t))/NT)
 
! Every nephew receives a different number of barrels of any given type
! (that is, a different pattern for every nephew)
 forall(n in NEPHEWS) do
  1 <= p(n); p(n) <= NN*COEF(1)
  sum(t in TYPES) COEF(t)*give(n,t) = p(n)
 end-do
 all_different(p)

! Branching strategy 
 cp_set_branching(split_domain(KALIS_SMALLEST_DOMAIN, KALIS_MIN_TO_MAX, 
                               give, true, 2))

! Solve the problem 
 if not(cp_find_next_sol) then
  writeln("Problem is infeasible")
  exit(1)
 end-if 
 
! Solution printing
 forall(n in NEPHEWS) do
  write(n,": ")
  forall(t in TYPES) write( give(n,t), " " )
  writeln
 end-do

end-model

(!****************************************************************
   Mosel Example Problems
   ======================
   
   file k6queens_ka.mos
   ````````````````````
   Placing N queens on an NxN chess board such that
   they do not attack each other.

   *** This model cannot be run with a Community Licence 
       for the default data instance ***

   (c) 2008 Fair Isaac Corporation
       author: S. Heipcke, March 2005
*****************************************************************!)
model nqueen
 uses "kalis"

 parameters
  N = 10                                     ! Number of queens
  SOL = 10                                   ! Number of solutions
 end-parameters

 forward procedure print_solution(numsol: integer)
 
 declarations
  ROWS = 1..N                                ! Rows and columns
  queen: array(ROWS) of cpvar                ! Position of queen per row
 end-declarations

! Defining the decision variables
 forall(i in ROWS) do
  1 <= queen(i); queen(i) <= N
 end-do

! One queen per column
 all_different(queen,KALIS_GEN_ARC_CONSISTENCY)

! No two queens on the same diagonal
 forall(i in ROWS, j in i+1..N) do
  queen(i) <> queen(j)
  queen(i) <> queen(j) + j - i
  queen(j) <> queen(i) + j - i  
 end-do
 

! Setting enumeration parameters
 cp_set_branching(assign_var(KALIS_SMALLEST_DOMAIN, KALIS_RANDOM_VALUE, queen))
 
! Solve the problem (generate up to SOL solutions)
 solct:= 0
 while (cp_find_next_sol and solct<SOL) do
  solct+=1
  print_solution(solct)
  cp_show_stats
 end-do
 

!****************************************************************
! **** Solution printing ****
 procedure print_solution(numsol: integer)  		
  writeln("Solution ", numsol)
  ct:=4
  write("    1  ")
  while(ct<=N) do
   write(strfmt(ct,-4))
   ct+=4
  end-do
  writeln
  
  forall(r in ROWS) do
   write(strfmt(r,3), " ")
   forall(c in ROWS) write(if(c=getsol(queen(r)), "Q", "."))
   writeln
  end-do
  writeln("Positions: ", queen)

 end-procedure
 
end-model

(!****************************************************************
   Mosel Example Problems
   ======================
   
   file k6queens_ka.mos
   ````````````````````
   Placing N queens on an NxN chess board such that
   they do not attack each other.

   *** This model cannot be run with a Community Licence 
       for the default data instance ***

   (c) 2008 Fair Isaac Corporation
       author: S. Heipcke, March 2005, Sep. 2017
*****************************************************************!)
model nqueen
 uses "kalis","mmsvg"

 parameters
  N = 10                                     ! Number of queens
  SOL = 10                                   ! Number of solutions
 end-parameters

 forward procedure print_solution(numsol: integer)
 forward procedure draw_solution(numsol: integer) 
 
 declarations
  ROWS = 1..N                                ! Rows and columns
  queen: array(ROWS) of cpvar                ! Position of queen per row
 end-declarations

! Defining the decision variables
 forall(i in ROWS) do
  1 <= queen(i); queen(i) <= N
 end-do

! One queen per column
 all_different(queen,KALIS_GEN_ARC_CONSISTENCY)

! No two queens on the same diagonal
 forall(i in ROWS, j in i+1..N) do
  queen(i) <> queen(j)
  queen(i) <> queen(j) + j - i
  queen(j) <> queen(i) + j - i  
 end-do
 

! Setting enumeration parameters
 cp_set_branching(assign_var(KALIS_SMALLEST_DOMAIN, KALIS_RANDOM_VALUE, queen))
 
! Solve the problem (generate up to SOL solutions)
 solct:= 0; svgrefresh
 while (cp_find_next_sol and solct<SOL and not svgclosing) do
  solct+=1
  print_solution(solct)
  draw_solution(solct)
  cp_show_stats
 end-do
 
 svgwaitclose("Close browser window to terminate model execution.", 1)

!****************************************************************
! **** Solution printing ****
 procedure print_solution(numsol: integer)  		
  writeln("Solution ", numsol)
  ct:=4
  write("    1  ")
  while(ct<=N) do
   write(strfmt(ct,-4))
   ct+=4
  end-do
  writeln
  
  forall(r in ROWS) do
   write(strfmt(r,3), " ")
   forall(c in ROWS) write(if(c=getsol(queen(r)), "Q", "."))
   writeln
  end-do
  writeln("Positions: ", queen)

 end-procedure
 
! **** Solution drawing in SVG format ****
 procedure draw_solution(numsol: integer)
  svgerase                          ! Delete previous graph

  svgaddgroup("S", "Solution "+numsol)  
  
  forall(r in ROWS) do 
   sol:= getsol(queen(r))
   forall(c in ROWS | c=sol) svgaddtext(r,c,"Q")
  end-do

 ! Draw the board
  svgaddgroup("B", "", SVG_BLACK)
  forall(i in 1..N+1) svgaddline(i-0.5, 0.5, i-0.5, N+0.5)
  forall(j in 1..N+1) svgaddline(0.5, j-0.5, N+0.5, j-0.5)

  svgsetgraphscale(20)
  svgrefresh
 ! Uncomment next line to pause at every iteration:
  svgpause
 end-procedure
 
end-model