200分求最好算法

Question

16 个长方形 ，12小4大（16进制表示：0-B# 规格：1*2；C-F# 规格：1*3）放入 6*6的正方形内，有多少种放法，列印出来？
如：
001122
334455
667788
99AABB
CCCDDD
EEEFFF
输出：001122，334455，667788，99AABB，CCCDDD，EEEFFF
012345
012345
CCCDDD
EF6677
EF88AB
EF99AB输出：012345，012345，CCCDDD，EF6677，EF88AB，EF99AB
熟悉华容道算法的朋友自然小菜一碟

Answer 1

问题可以简化：
长方形有两种：1*2（A）, 1*3（B）。欲放入 6*6 正方形中。A 至多可用 12 个，B 至多可用 4 个。
把大小长方形命令并求其具体位置并没有意义。如果一定要，可在上题解出后，求大小长方形的数学排列。

Answer 2

'递归
Option Explicit
Private fk(5, 5) As Byte
Private Sub Form_Load()
Call pl(0)
End SubPrivate Sub pl(cfx As Byte)Dim i As Byte
Dim j As Byte
Dim i1 As Byte
Dim j1 As Byte
Dim b As String
Dim fk2(5, 5) As Byte'用循环扫描长方形起始点全部情况，然后向右和下分别作长方形For i1 = 0 To 5
    For j1 = 0 To 5
        fk2(i1, j1) = fk(i1, j1)
    Next
NextFor i = 0 To 5
    For j = 0 To 5
    
        If cfx = 0 Then
            For i1 = 0 To 5
                For j1 = 0 To 5
                    fk2(i1, j1) = 16 '先把方块的初始值设为16
                Next
            Next
        End If
        
        For i1 = 0 To 5
            For j1 = 0 To 5
                fk(i1, j1) = fk2(i1, j1)
            Next
        Next
        If cfx >= 0 And cfx <= 11 Then '0-B# 规格：1*2
            If i + 1 <= 5 Then '向右作长方形
                If fk(i, j) = 16 And fk(i + 1, j) = 16 Then
                    fk(i, j) = cfx
                    fk(i + 1, j) = cfx
                    Call pl(cfx + 1)
                End If
            End If
            If j + 1 <= 5 Then '向下作长方形
                If fk(i, j) = 16 And fk(i, j + 1) = 16 Then
                    fk(i, j) = cfx
                    fk(i, j + 1) = cfx
                    Call pl(cfx + 1)
                End If
            End If
        Else 'C-F# 规格：1*3
            If i + 2 <= 5 Then '向右作长方形
                If fk(i, j) = 16 And fk(i + 1, j) = 16 And fk(i + 2, j) = 16 Then
                    fk(i, j) = cfx
                    fk(i + 1, j) = cfx
                    fk(i + 2, j) = cfx
                    If cfx <> 15 Then
                        Call pl(cfx + 1)
                    Else
                        b = ""
                        For j1 = 0 To 5
                            For i1 = 0 To 5
                                b = b & Hex(fk(i1, j1))
                            Next
                            If j1 <> 5 Then b = b & ","
                        Next
                        Debug.Print b
                    End If
                End If
            End If
            If j + 2 <= 5 Then '向下作长方形
                If fk(i, j) = 16 And fk(i, j + 1) = 16 And fk(i, j + 2) = 16 Then
                    fk(i, j) = cfx
                    fk(i, j + 1) = cfx
                    fk(i, j + 2) = cfx
                    If cfx <> 15 Then
                        Call pl(cfx + 1)
                    Else
                        b = ""
                        For j1 = 0 To 5
                            For i1 = 0 To 5
                                b = b & Hex(fk(i1, j1))
                            Next
                            If j1 <> 5 Then b = b & ","
                        Next
                        Debug.Print b
                    End If
                End If
            End If
        End If
    Next
NextEnd Sub

Answer 3

    发现带“.:RNPA:.”标志的都是高手。

Answer 4

To of123:长方形有两种：1*2（A）, 1*3（B）。欲放入 6*6 正方形中。A 至多可用 12 个，B 至多可用 4 个。---------------------------------------------------------------------------------言之有理。 不考虑编号，12 个1*2（A）,4 个 1*3（B）放入6*6 的正方形中，怎么放？有什么别的方法么？

Answer 5

Sub PrintOut(Matrix() As Long)
Dim i As Long, j As Long
Dim s As String
For i = 0 To 5
  For j = 0 To 5
    s = s & Hex(Matrix(i, j) - 1)
  Next j
  s = s & vbCrLf
Next i
Text1.Text = Text1.Text & vbCrLf & s
C = C + 1
End SubSub Recursion(Matrix() As Long, s As Long)
Dim SfMatrix(0 To 5, 0 To 5) As Long
Dim i As Long, j As Long
For i = 0 To 5
  For j = 0 To 5
    SfMatrix(i, j) = Matrix(i, j)
  Next j
Next i
If s <= 12 Then
For i = 0 To 5
  For j = 0 To 5
    If SfMatrix(i, j) = 0 Then
      If j < 5 Then
        If SfMatrix(i, j + 1) = 0 Then
          SfMatrix(i, j) = s
          SfMatrix(i, j + 1) = s
          Recursion SfMatrix, s + 1
          SfMatrix(i, j) = 0
          SfMatrix(i, j + 1) = 0
        End If
      End If
      If i < 5 Then
        If SfMatrix(i + 1, j) = 0 Then
          SfMatrix(i, j) = s
          SfMatrix(i + 1, j) = s
          Recursion SfMatrix, s + 1
          SfMatrix(i, j) = 0
          SfMatrix(i + 1, j) = 0
        End If
      End If
    End If
  Next j
Next i
ElseIf s <= 16 Then
  For i = 0 To 5
    For j = 0 To 5
      If SfMatrix(i, j) = 0 Then
        If j < 4 Then
          If SfMatrix(i, j + 1) = 0 And SfMatrix(i, j + 2) = 0 Then
            SfMatrix(i, j) = s
            SfMatrix(i, j + 1) = s
            SfMatrix(i, j + 2) = s
            Recursion SfMatrix, s + 1
            SfMatrix(i, j) = 0
            SfMatrix(i, j + 1) = 0
            SfMatrix(i, j + 2) = 0
          End If
        End If
        If i < 4 Then
          If SfMatrix(i + 1, j) = 0 And SfMatrix(i + 2, j) = 0 Then
            SfMatrix(i, j) = s
            SfMatrix(i + 1, j) = s
            SfMatrix(i + 2, j) = s
            Recursion SfMatrix, s + 1
            SfMatrix(i, j) = 0
            SfMatrix(i + 1, j) = 0
            SfMatrix(i + 2, j) = 0
          End If
        End If
      End If
    Next j
  Next i
Else
  PrintOut SfMatrix
End If
End Sub解的数量大得惊人。
本来不应该用递归的，太深了，有36层，但是约束条件很强，所以用递归解也不为过
觉得有不用递归的简单方法，还没想出来
p.s(给分到马甲)

Answer 6

加注释版本
Sub Recursion(Matrix() As Long, s As Long) 'Matrix代表矩阵情况，s代表方块Index
Dim SfMatrix(0 To 5, 0 To 5) As Long
Dim i As Long, j As Long
'使用0作为还没使用的标志，打印的时候-1即可。
'因为VB不支持数组的ByVal传递，所以只有这样了。
For i = 0 To 5
  For j = 0 To 5
    SfMatrix(i, j) = Matrix(i, j)
  Next j
Next i
If s <= 12 Then '1*2方块
For i = 0 To 5
  For j = 0 To 5
    If SfMatrix(i, j) = 0 Then
      If j < 5 Then
        If SfMatrix(i, j + 1) = 0 Then '平放
          SfMatrix(i, j) = s
          SfMatrix(i, j + 1) = s
          Recursion SfMatrix, s + 1 '递归
          SfMatrix(i, j) = 0
          SfMatrix(i, j + 1) = 0
        End If
      End If
      If i < 5 Then
        If SfMatrix(i + 1, j) = 0 Then '竖直
          SfMatrix(i, j) = s
          SfMatrix(i + 1, j) = s
          Recursion SfMatrix, s + 1 '递归
          SfMatrix(i, j) = 0
          SfMatrix(i + 1, j) = 0
        End If
      End If
    End If
  Next j
Next i
ElseIf s <= 16 Then '1*3方块
  For i = 0 To 5
    For j = 0 To 5
      If SfMatrix(i, j) = 0 Then
        If j < 4 Then
          If SfMatrix(i, j + 1) = 0 And SfMatrix(i, j + 2) = 0 Then '平放
            SfMatrix(i, j) = s
            SfMatrix(i, j + 1) = s
            SfMatrix(i, j + 2) = s
            Recursion SfMatrix, s + 1 '递归
            SfMatrix(i, j) = 0
            SfMatrix(i, j + 1) = 0
            SfMatrix(i, j + 2) = 0
          End If
        End If
        If i < 4 Then
          If SfMatrix(i + 1, j) = 0 And SfMatrix(i + 2, j) = 0 Then '竖直
            SfMatrix(i, j) = s
            SfMatrix(i + 1, j) = s
            SfMatrix(i + 2, j) = s
            Recursion SfMatrix, s + 1 '递归
            SfMatrix(i, j) = 0
            SfMatrix(i + 1, j) = 0
            SfMatrix(i + 2, j) = 0
          End If
        End If
      End If
    Next j
  Next i
Else
  PrintOut SfMatrix '打印输出
End If
End Sub

Answer 7

调用方法：
Dim Matrix(0 To 5, 0 To 5) As Long
Recursion Matrix, 1