Skip to main content
added 366 characters in body
Source Link
Dr. belisarius
  • 116.2k
  • 13
  • 205
  • 456

I thought it could be easier using IntegerPartitions[], but suddenly the code got convoluted.

part[r_] := 
   Module[{d},
     d = IntegerPartitions[#, All, Range@3, 1][[1]] & /@ r[[3 ;; 4]];
     Flatten/@Transpose@{Tuples[r[[#]]+Most@FoldList[Plus,0,d[[#]]] & /@ {1, 2}], Tuples@d}]

part[{2, 3, 6, 5}]
(*
{{2, 3, 3, 3}, {2, 6, 3, 2}, {5, 3, 3, 3}, {5, 6, 3, 2}}
*)
part[{2, 3, 7, 9}]
(*
{{2, 3, 3, 3}, {2, 6, 3, 3}, {2, 9, 3, 3}, {5, 3, 3, 3}, 
 {5, 6, 3, 3}, {5, 9, 3, 3}, {8, 3, 1, 3}, {8, 6, 1, 3}, {8, 9, 1, 3}}
*)

Edit

A plotting function, just for completeness:

rect[{x_, y_, w_, h_}] := Rectangle[{x, -y - h}, {x + w, -y}]
plotrects[{x_, y_, w_, h_}] := 
 Graphics[{FaceForm[White], EdgeForm[Black],  rect /@ part[{x, y, w, h}]}, Axes -> True, 
           PlotRange -> {{x - 3, x + w + 3}, {-y - h - 3, -y + 3}}]
plotrects[{2, 3, 6, 5}]

I thought it could be easier using IntegerPartitions[], but suddenly the code got convoluted.

part[r_] := 
   Module[{d},
     d = IntegerPartitions[#, All, Range@3, 1][[1]] & /@ r[[3 ;; 4]];
     Flatten/@Transpose@{Tuples[r[[#]]+Most@FoldList[Plus,0,d[[#]]] & /@ {1, 2}], Tuples@d}]

part[{2, 3, 6, 5}]
(*
{{2, 3, 3, 3}, {2, 6, 3, 2}, {5, 3, 3, 3}, {5, 6, 3, 2}}
*)
part[{2, 3, 7, 9}]
(*
{{2, 3, 3, 3}, {2, 6, 3, 3}, {2, 9, 3, 3}, {5, 3, 3, 3}, 
 {5, 6, 3, 3}, {5, 9, 3, 3}, {8, 3, 1, 3}, {8, 6, 1, 3}, {8, 9, 1, 3}}
*)

I thought it could be easier using IntegerPartitions[], but suddenly the code got convoluted.

part[r_] := 
   Module[{d},
     d = IntegerPartitions[#, All, Range@3, 1][[1]] & /@ r[[3 ;; 4]];
     Flatten/@Transpose@{Tuples[r[[#]]+Most@FoldList[Plus,0,d[[#]]] & /@ {1, 2}], Tuples@d}]

part[{2, 3, 6, 5}]
(*
{{2, 3, 3, 3}, {2, 6, 3, 2}, {5, 3, 3, 3}, {5, 6, 3, 2}}
*)
part[{2, 3, 7, 9}]
(*
{{2, 3, 3, 3}, {2, 6, 3, 3}, {2, 9, 3, 3}, {5, 3, 3, 3}, 
 {5, 6, 3, 3}, {5, 9, 3, 3}, {8, 3, 1, 3}, {8, 6, 1, 3}, {8, 9, 1, 3}}
*)

Edit

A plotting function, just for completeness:

rect[{x_, y_, w_, h_}] := Rectangle[{x, -y - h}, {x + w, -y}]
plotrects[{x_, y_, w_, h_}] := 
 Graphics[{FaceForm[White], EdgeForm[Black],  rect /@ part[{x, y, w, h}]}, Axes -> True, 
           PlotRange -> {{x - 3, x + w + 3}, {-y - h - 3, -y + 3}}]
plotrects[{2, 3, 6, 5}]
deleted 110 characters in body
Source Link
Dr. belisarius
  • 116.2k
  • 13
  • 205
  • 456

I thought it could be easier using IntegerPartitions[], but suddenly the code got too convoluted.

part[r_] := 
   Module[{d},
     d = Prepend[#,0]&/@ (IntegerPartitions[#, All, Range@3, 1][[1]] & /@ r[[3;;r[[3 4]]);;; 4]];
     Flatten/@Transpose[@Transpose@{Tuples[r[[#]]Tuples[r[[#]]+Most@FoldList[Plus,0,d[[#]]] +& Most@Accumulate@d[[#]]&/@ {1, 2}], Tuples[Rest/@d]}]
                                                  /. {x_Integer, w_, y_, h_} -> {x, y, w, hTuples@d}]

part[{2, 3, 6, 5}]
(*
{{2, 3, 3, 3}, {2, 6, 3, 2}, {5, 3, 3, 3}, {5, 6, 3, 2}}
*)
part[{2, 3, 7, 9}]
(*
{{2, 3, 3, 3}, {2, 6, 3, 3}, {2, 9, 3, 3}, {5, 3, 3, 3}, 
 {5, 6, 3, 3}, {5, 9, 3, 3}, {8, 3, 1, 3}, {8, 6, 1, 3}, {8, 9, 1, 3}}
*)

I thought it could be easier using IntegerPartitions[], but the code got too convoluted.

part[r_] := 
   Module[{d},
     d = Prepend[#,0]&/@ (IntegerPartitions[#,All,Range@3,1][[1]] & /@ r[[3;; 4]]); 
     Flatten/@Transpose[{Tuples[r[[#]] + Most@Accumulate@d[[#]]&/@ {1, 2}], Tuples[Rest/@d]}]
                                                  /. {x_Integer, w_, y_, h_} -> {x, y, w, h}]

part[{2, 3, 6, 5}]
(*
{{2, 3, 3, 3}, {2, 6, 3, 2}, {5, 3, 3, 3}, {5, 6, 3, 2}}
*)
part[{2, 3, 7, 9}]
(*
{{2, 3, 3, 3}, {2, 6, 3, 3}, {2, 9, 3, 3}, {5, 3, 3, 3}, 
 {5, 6, 3, 3}, {5, 9, 3, 3}, {8, 3, 1, 3}, {8, 6, 1, 3}, {8, 9, 1, 3}}
*)

I thought it could be easier using IntegerPartitions[], but suddenly the code got convoluted.

part[r_] := 
   Module[{d},
     d = IntegerPartitions[#, All, Range@3, 1][[1]] & /@ r[[3 ;; 4]];
     Flatten/@Transpose@{Tuples[r[[#]]+Most@FoldList[Plus,0,d[[#]]] & /@ {1, 2}], Tuples@d}]

part[{2, 3, 6, 5}]
(*
{{2, 3, 3, 3}, {2, 6, 3, 2}, {5, 3, 3, 3}, {5, 6, 3, 2}}
*)
part[{2, 3, 7, 9}]
(*
{{2, 3, 3, 3}, {2, 6, 3, 3}, {2, 9, 3, 3}, {5, 3, 3, 3}, 
 {5, 6, 3, 3}, {5, 9, 3, 3}, {8, 3, 1, 3}, {8, 6, 1, 3}, {8, 9, 1, 3}}
*)
deleted 12 characters in body
Source Link
Dr. belisarius
  • 116.2k
  • 13
  • 205
  • 456

I thought it could be easier using IntegerPartitions[], but the code got too convoluted.

part[r_] := 
   Module[{d},
              d = Prepend[#,0]&/@ (IntegerPartitions[#,All,Range@3,1][[1]] & /@ r[[3;; 4]]); 
              Flatten/@Transpose[{Tuples[r[[#]] + Most@Accumulate@d[[#]]&/@ Tuples[Transpose{1, 2}], Tuples[Rest/@@d]}]
                     ({r[[#]] + Most@Accumulate@d[[#]], Rest@d[[#]]} & /@ {1, 2})] /. 
                      /. {x_Integer, w_, y_, h_} -> {x, y, w, h}]

part[{2, 3, 6, 5}]
(*
{{2, 3, 3, 3}, {2, 6, 3, 2}, {5, 3, 3, 3}, {5, 6, 3, 2}}
*)
part[{2, 3, 7, 9}]
(*
{{2, 3, 3, 3}, {2, 6, 3, 3}, {2, 9, 3, 3}, {5, 3, 3, 3}, 
 {5, 6, 3, 3}, {5, 9, 3, 3}, {8, 3, 1, 3}, {8, 6, 1, 3}, {8, 9, 1, 3}}
*)

I thought it could be easier using IntegerPartitions[], but the code got too convoluted.

part[r_] := Module[{d},
              d = Prepend[#,0]&/@ (IntegerPartitions[#,All,Range@3,1][[1]] & /@ r[[3;; 4]]); 
              Flatten /@ Tuples[Transpose /@
                     ({r[[#]] + Most@Accumulate@d[[#]], Rest@d[[#]]} & /@ {1, 2})] /. 
                       {x_Integer, w_, y_, h_} -> {x, y, w, h}]

part[{2, 3, 6, 5}]
(*
{{2, 3, 3, 3}, {2, 6, 3, 2}, {5, 3, 3, 3}, {5, 6, 3, 2}}
*)
part[{2, 3, 7, 9}]
(*
{{2, 3, 3, 3}, {2, 6, 3, 3}, {2, 9, 3, 3}, {5, 3, 3, 3}, 
 {5, 6, 3, 3}, {5, 9, 3, 3}, {8, 3, 1, 3}, {8, 6, 1, 3}, {8, 9, 1, 3}}
*)

I thought it could be easier using IntegerPartitions[], but the code got too convoluted.

part[r_] := 
   Module[{d},
     d = Prepend[#,0]&/@ (IntegerPartitions[#,All,Range@3,1][[1]] & /@ r[[3;; 4]]); 
     Flatten/@Transpose[{Tuples[r[[#]] + Most@Accumulate@d[[#]]&/@ {1, 2}], Tuples[Rest/@d]}]
                                                  /. {x_Integer, w_, y_, h_} -> {x, y, w, h}]

part[{2, 3, 6, 5}]
(*
{{2, 3, 3, 3}, {2, 6, 3, 2}, {5, 3, 3, 3}, {5, 6, 3, 2}}
*)
part[{2, 3, 7, 9}]
(*
{{2, 3, 3, 3}, {2, 6, 3, 3}, {2, 9, 3, 3}, {5, 3, 3, 3}, 
 {5, 6, 3, 3}, {5, 9, 3, 3}, {8, 3, 1, 3}, {8, 6, 1, 3}, {8, 9, 1, 3}}
*)
Source Link
Dr. belisarius
  • 116.2k
  • 13
  • 205
  • 456
Loading