Constraint script: Script.oz

### Constraint script: `Script.oz`

Source File

>     functor

>     import
>        FD Schedule

>     export
>        compile: Compile

>     prepare

>        local
>           fun {Expand N I Is}
>              if N>0 then I|{Expand N-1 I+1 Is} else Is end
>           end
>           fun {Get J IN Is}
>              if J>0 then I#N=IN.J in {Expand N I {Get J-1 IN Is}}
>              else Is
>              end
>           end
>        in
>           fun {IN2Is IN}
>              {Get {Width IN} IN nil}
>           end
>        end

>        local
>           fun {Get J IN}
>              N=IN.J.2
>           in
>              if N>0 then J else {Get J+1 IN} end
>           end
>        in
>           fun {GetMinSizeIN IN}
>              {Get 1 IN}
>           end
>        end

>        local
>           fun {Get J IN}
>              I#N=IN.J
>           in
>              if N>0 then I else {Get J-1 IN} end
>           end
>        in
>           fun {GetFirstIN IN}
>              {Get {Width IN} IN}
>           end
>        end

>        local
>           fun {Get J IN A}
>              if J>0 then {Get J-1 IN IN.J.2*J*J+A} else A end
>           end
>        in
>           fun {GetAreaIN IN}
>              {Get {Width IN} IN 0}
>           end
>        end

>     define

>        fun {Compile Spec}

>           %% Specification is as follows:
>           %%  Spec.x, Spec.y: size of the target plate
>           %%  Spec.squares.D=N: N squares of size D

>           %% Number of all squares
>           N  = {Record.foldL Spec.squares Number.'+' 0}
>           %% Dimension of X and Y
>           DX = Spec.x
>           DY = Spec.y
>           %%
>           MaxSize = {List.last {Arity Spec.squares}}
>           SizeToArea = {MakeTuple '#' MaxSize}

>           {For 1 MaxSize 1 proc {$ I}
>                               SizeToArea.I=I*I
>                            end}

>           %% Mapping: Sqs -> Size
>           SqsSize = {MakeTuple '#' N}

>           %% Mapping: Sqs -> Area
>           SqsArea = {MakeTuple '#' N}

>           %% Initialize area and size
>           {Record.foldRInd Spec.squares
>            fun {$ D M I}
>               {For I I+M-1 1 proc {$ J}
>                                 SqsSize.J=D SqsArea.J=D*D
>                              end}
>               I+M
>            end 1 _}

>        in

>           proc {$ Root}
>              SqsX0 % left coordinates
>              SqsX1 % right coordinates
>              SqsY0 % upper coordinates
>              SqsY1 % lower coordinates
>              Cuts  % cut information

>              local

>                 local
>                    proc {Do J IN MN SqsXY0 SqsXY1 Cut}
>                       if J>0 then I#N=IN.J M=MN.J in
>                          {FD.distribute generic(value:mid) [M]}
>                          {For I I+M-1 1 proc {$ I}
>                                            SqsXY1.I =<: Cut
>                                         end}
>                          {For I+M I+N-1 1 proc {$ I}
>                                              SqsXY0.I >=: Cut
>                                           end}
>                          {Do J-1 IN MN SqsXY0 SqsXY1 Cut}
>                       end
>                    end
>                 in
>                    proc {Position IN MN SqsXY0 SqsXY1 Cut}
>                       {Do MaxSize IN MN SqsXY0 SqsXY1 Cut}
>                    end
>                 end

>                 local
>                    fun {Do J IN MN ?LIN ?RIN LN}
>                       if J>0 then
>                          I#N=IN.J M=MN.J
>                       in
>                          LIN.J = I    #M
>                          RIN.J = (I+M)#N-M
>                          {Do J-1 IN MN LIN RIN LN+M}
>                       else
>                          LN
>                       end
>                    end
>                 in
>                    fun {MakeLRIN IN MN ?LIN ?RIN}
>                       LIN = {MakeTuple '#' MaxSize}
>                       RIN = {MakeTuple '#' MaxSize}
>                       {Do {Width IN} IN MN LIN RIN 0}
>                    end
>                 end

>                 proc {FindXY IN MN I MinSize Area XY0 XY1 DYX SqsXY0 SqsXY1
>                       ?Cut}
>                    AreaL = {FD.decl}
>                 in
>                    Cut = {FD.decl}
>                    %% cut must be right of first square
>                    Cut >=: XY0 + SqsSize.I
>                    %% cut must be left of at least the smallest square
>                    Cut + MinSize =<: XY1
>                    %% numbers of squares for left side
>                    %% they occupy AreaL
>                    {FD.sumC SizeToArea MN '=:' AreaL}
>                    %% which must fit the left of the cut
>                    AreaL =<: (Cut-XY0) * DYX
>                    %% not all squares must go to the left
>                    AreaL  <: Area
>                    %% position the squares
>                    {FD.distribute mid [Cut]}
>                    {Position IN MN SqsXY0 SqsXY1 Cut}
>                 end

>                 fun {FindN N IN X0 X1 Y0 Y1}
>                    I       = {GetFirstIN IN}
>                    Area    = {GetAreaIN IN}
>                    MinSize = {GetMinSizeIN IN}
>                    MN      = {Record.map IN fun {$ _#N}
>                                                {FD.int 0#N}
>                                             end}
>                 in
>                    %% place first square
>                    SqsX0.I=X0 SqsY0.I =Y0
>                    %% mapping of sizes to number of squares on left side
>                    choice
>                       Cut={FindXY IN MN I MinSize Area X0 X1 Y1-Y0 SqsX0 SqsX1}
>                       LIN RIN
>                       LN={MakeLRIN IN MN ?LIN ?RIN}
>                    in
>                       info(cut:Cut dir:y
>                            {Find LN   LIN X0 Cut Y0 Y1}
>                            {Find N-LN RIN Cut X1 Y0 Y1})
>                    []
>                       Cut={FindXY IN MN I MinSize Area Y0 Y1 X1-X0 SqsY0 SqsY1}
>                       LIN RIN
>                       LN={MakeLRIN IN MN ?LIN ?RIN}
>                    in
>                       info(cut:Cut dir:x
>                            {Find LN   LIN X0 X1 Y0 Cut}
>                            {Find N-LN RIN X0 X1 Cut Y1})
>                    end
>                 end

>                 fun {Find N IN X0 X1 Y0 Y1}
>                    case N
>                    of 0 then fail nil
>                    [] 1 then [I]={IN2Is IN} in
>                       SqsX0.I=X0 SqsY0.I=Y0
>                       nil
>                    [] 2 then
>                       [I1 I2]={IN2Is IN}
>                       S1X0=SqsX0.I1 S1X1=SqsX1.I1 S1Y0=SqsY0.I1 S1Y1=SqsY1.I1
>                       S2X0=SqsX0.I2 S2Y0=SqsY0.I2
>                    in
>                       S1X0=X0 S1Y0=Y0
>                       dis S2X0=X0   S2Y0=S1Y1 then info(cut:S1Y1 dir:x nil nil)
>                       []  S2X0=S1X1 S2Y0=Y0   then info(cut:S1X1 dir:y nil nil)
>                       end
>                    [] 3 then
>                       [I1 I2 I3]={IN2Is IN}
>                       S1X0=SqsX0.I1 S1X1=SqsX1.I1 S1Y0=SqsY0.I1 S1Y1=SqsY1.I1
>                       S2X0=SqsX0.I2 S2X1=SqsX1.I2 S2Y0=SqsY0.I2 S2Y1=SqsY1.I2
>                       S3X0=SqsX0.I3 S3Y0=SqsY0.I3
>                    in
>                       S1X0=X0 S1Y0=Y0
>                       dis S2X0=X0  S2Y0=S1Y1 S3X0=X0   S3Y0=S2Y1 then
>                          info(cut:S1Y1 dir:x nil info(cut:S2Y1 dir:x nil nil))
>                       []  S2X0=X0  S2Y0=S1Y1 S3X0=S1X1 S3Y0=S1Y1 then
>                          info(cut:S1Y1 dir:x nil info(cut:S2X1 dir:y nil nil))
>                       [] S2X0=S1X1 S2Y0=Y0   S3X0=S2X1 S3Y0=Y0   then
>                          info(cut:S1X1 dir:y nil info(cut:S2X1 dir:y nil nil))
>                       [] S2X0=S1X1 S2Y0=Y0   S3X0=S2X0 S3Y0=S2Y1 then
>                          info(cut:S1X1 dir:y nil info(cut:S2Y1 dir:x nil nil))
>                       end
>                    else
>                       {FindN N IN X0 X1 Y0 Y1}
>                    end
>                 end
>              in
>                 fun {FindCuts}
>                    IN={MakeTuple '#' MaxSize}
>                 in
>                    {ForThread MaxSize 1 ~1
>                     fun {$ I Size}
>                        N={CondSelect Spec.squares Size 0}
>                     in
>                        IN.Size = I#N
>                        I+N
>                     end 1 _}
>                    {Find N IN 0 DX 0 DY}
>                 end
>              end

>              proc {Fit SqsXY Cap}
>                 {Schedule.cumulative [{Arity SqsXY}] SqsXY SqsSize SqsSize [Cap]}
>              end

>           in

>              SqsX0 = {MakeTuple '#' N}
>              SqsX1 = {MakeTuple '#' N}
>              SqsY0 = {MakeTuple '#' N}
>              SqsY1 = {MakeTuple '#' N}

>              Root = root(x:SqsX0 y:SqsY0 d:SqsSize dx:DX dy:DY cuts:Cuts)

>              %% Set up problem variables
>              {For 1 N 1 proc {$ I}
>                            Size = SqsSize.I
>                            X0   = {FD.int 0#{Max 0 DX-Size}}
>                            Y0   = {FD.int 0#{Max 0 DY-Size}}
>                            X1   = {FD.decl}
>                            Y1   = {FD.decl}
>                         in
>                            X1 =: X0 + Size  Y1 =: Y0 + Size
>                            SqsX0.I = X0  SqsY0.I = Y0
>                            SqsX1.I = X1  SqsY1.I = Y1
>                         end}

>              %% The squares must fit the target
>              {FD.sum SqsArea '=<:' DX*DY}

>              %% Fix some freedom for first square (wolg)
>              SqsX0.1=0 SqsY0.1=0

>              %% Remove permutations of equally-sized squares by ordering them
>              {For 1 N-1 1 proc {$ I}
>                              I1=I+1
>                           in
>                              if SqsSize.I==SqsSize.I1 then
>                                 %% This is respected by the no overlap
>                                 SqsX0.I =<: SqsX0.I1
>                              end
>                           end}

>              %% No Overlaps allowed
>              {FD.distinct2 SqsX0 SqsSize SqsY0 SqsSize}

>              %% In any direction (be it x or y) the squares must
>              %% fit into the height/width of the rectangle
>              {Fit SqsX0 DY} {Fit SqsY0 DX}

>              %% The diffuclt part: find the cuts
>              Cuts = {FindCuts}

>           end

>        end

>     end