求教，四个方块，有多少种排列方法？ - VB6论坛

楼主

已结贴√ 问题点数：20 回复次数：7

求教，四个方块，有多少种排列方法？

如题，这个排列方法还有要求，就是不管是边，还是角，四个方块一定要连接，不得分断开。
如何用编程方式得出答案？同时输出图形？
附件为手工人脑排列出的图形，怕有遗漏。

图片附件: 游客没有浏览图片的权限，请登录或注册

[此贴子已经被作者于2022-11-14 14:36编辑过]

搜索更多相关主题的帖子: 图形　多少　排列　方法　手工　

第 2 楼

得分:7

换算成 4*4的方块中，排列组合 4 个方块，组合后计算，每个方块的 8个坐标内必须有其他方块。
为防止出错，定义空间时，是 0-5 ，0-5 （6*6的空间），但只使用 1-4，1-4 空间（4*4）的空间，判断时，可以直接在拿 6*6 空间里判断，不需要在代码中特别注意坐标。

白天没时间写代码了。

授人于鱼，不如授人于渔
早已停用QQ了

第 3 楼

得分:7

等效于12个0和4个1排满16位，总的排列方式有C(16,12)*C(4,4)=1820个排列方式，再在这1820个中筛四个全部连接的排列，由于是二进制，可以参考https://bbs.bccn.net/thread-510483-4-1.html中35楼我的代码。16位二进制可以直接使用long型数据做递增。
当然，最高效的还是四层循环嵌套，代码如下：

程序代码：

Private Sub Command1_Click()
  Dim i As Integer, j As Integer, k As Integer, l As Integer, s As Integer
  s = 0
  For i = 0 To 12
    For j = i + 1 To 13
      For k = j + 1 To 14
        For l = k + 1 To 15
          s = s + 1
        Next
      Next
    Next
  Next
  MsgBox s
End Sub

这个代码可以算出总排列s是1820，ijkl就是四个小方块位置，要获取他们的行列值公式是x=i mod 4,y=i/4

[此贴子已经被作者于2022-11-14 23:25编辑过]

收到的鲜花

yuma 于 2022-12-10 18:22 送鲜花 20朵附言：AAAAAAAAAAAAAAA

能编个毛线衣吗？

第 4 楼

得分:0

回复 3楼 wmf2014

得到四个点的排列组合后，无需写太复杂的代码，只需要判断各点是否有邻居，就像写扫雷的那个，只要一个点没邻居，就说明没有连接。
接下来，还要判断图形相似，比如四个点组成的方块就有9个，这可以通过邻居特征值区别，只要邻居特征值设置合理，可以用一个integer数表达出来一个图形，就可以筛掉相似的图形。

能编个毛线衣吗？

第 5 楼

得分:7

回复 3楼 wmf2014

解释了排列组合与嵌套的关系。这很容转化成VFP语言。

素数问题的解决是我学习编程永恒的动力。

第 6 楼

得分:0

判断四个方格是否连接还是有些复杂的，一个点没有邻居是不连接的，四个点都有邻居，据此判断四个点连通是不正确的，连通的判断还是要想些办法的。

程序代码：

Option Explicit
   
Private Sub printcell(x() As Long, y() As Long, ByVal n As Long)

  Static i As Long
  
  Dim r As Long
  Dim c As Long
  Dim k As Long
  Dim w As Long
  Dim w1 As Long
  Dim w2 As Long
  Dim w3 As Long
  Dim ox As Long
  Dim oy As Long
  Dim w4 As Long
  
  w4 = 12
  w3 = (w4 \ 2) * 12
  ox = 5 * 12
  oy = 5 * 12
  w1 = 17 * 12
  w2 = 15 * 12
  w = (17 * n + w4) * 12
  r = (i \ 14) * w
  c = (i Mod 14) * w

 

 For k = 0 To n - 1
  
   Me.Picture1.Line (ox + c + w3 + y(k) * w1, oy + r + w3 + x(k) * w1)-(ox + c + w3 + y(k) * w1 + w2, oy + r + w3 + x(k) * w1 + w2), &HFF0000, BF

 Next

 

 i = i + 1

 
End Sub

Private Sub printline(ByVal nums As Long, ByVal n As Long)
  
  Dim w As Long
  Dim w1 As Long
  Dim r As Long
  Dim c As Long
  Dim ox As Long
  Dim oy As Long
  Dim x As Long
  Dim y As Long
  Dim w4 As Long
  
  w4 = 12
  r = nums \ 14
  c = 14
  ox = 5 * 12
  oy = 5 * 12
  w = (17 * n + w4) * 12
  
  For y = 0 To r + 1
  
    Me.Picture1.Line (ox, oy + y * w)-(ox + 14 * w, oy + y * w), &H80FF&
  
  Next
  For x = 0 To c
  
    Me.Picture1.Line (ox + x * w, oy)-(ox + x * w, oy + (r + 1) * w), &H80FF&
  
  Next

 
End Sub
Private Function isConnected(x() As Long, y() As Long, nums As Long) As Boolean
   Dim p As Long
   Dim p1 As Long
   Dim p2 As Long
   Dim pAll() As Long
   Dim tmp As Long
   Dim flg As Boolean
   
   ReDim pAll(nums - 1)
   For p = 0 To nums - 1
      pAll(p) = p
   Next
   p1 = 0
   p2 = 1
   isConnected = True
   Do While p1 < nums - 1
     flg = False
     p = p1
     Do While p >= 0
       If Abs(x(pAll(p)) - x(pAll(p2))) <= 1 And _
       Abs(y(pAll(p)) - y(pAll(p2))) <= 1 Then
          flg = True
          Exit Do
       End If
       p = p - 1
     Loop
     If flg Then
        p1 = p1 + 1
        If p1 <> p2 Then
           tmp = pAll(p1)
           pAll(p1) = pAll(p2)
           pAll(p2) = tmp
        End If
        p2 = p1 + 1
      Else
        p2 = p2 + 1
      
        If p2 = nums Then
           isConnected = False
       
           Exit Do
         End If
     End If
   Loop
   
End Function


 Private Function isOK(x() As Long, y() As Long, ByVal num As Long) As Boolean
  
     Dim i As Long
     Dim numx As Long
     Dim numy As Long
     
     numx = 0
     numy = 0
     For i = 0 To num - 1
         If x(i) = 0 Then numx = numx + 1
         If y(i) = 0 Then numy = numy + 1
     Next
     
     If numx = 0 Or numy = 0 Then
        isOK = False
        Exit Function
     End If
    
    isOK = isConnected(x, y, num)
    

 End Function

 Private Function number(ByVal num As Long) As Long
  Dim x() As Long
  Dim y() As Long
  
  ReDim x(num - 1) As Long
  ReDim y(num - 1) As Long
  
  number = comb(num, num * num, num, 0, x, y)
  
  printline number, num
  
End Function


 Private Function comb(ByVal num As Long, ByVal n As Long, ByVal k As Long, ByVal i As Long, x() As Long, y() As Long)
    x(i) = (n - 1) \ num
    y(i) = (n - 1) Mod num
    If k = 1 Then
       If isOK(x, y, num) Then
         
         comb = comb + 1
         printcell x, y, num
         
       End If
     
       If n > k Then comb = comb + comb(num, n - 1, k, i, x, y)
       
   End If
     
   If k > 1 Then
     
     comb = comb + comb(num, n - 1, k - 1, i + 1, x, y)
     
     If n > k Then comb = comb + comb(num, n - 1, k, i, x, y)
     
   End If
        

 End Function
Private Sub Command1_Click()

  Label1.Caption = number(4)
  
End Sub