tìm các giá trị sao cho chúng gần nhau nhất

[lukhach123]

mong các bạn giúp bài toán này ạ:

Cho các bóng đèn đánh số từ d1 đến d8. chúng được gắn ngẫu nhiên trải từ a1 đến s1, có thể lặp lại .
yêu cầu: Tìm ra 3 bóng, sao cho khoảng trống mà chúng tạo ra là ít nhất( chiếu sáng tối đa)
Như trong ví dụ, thì kết quả là (d1,d3,d5) hoặc (d1,d5,d8) vì khoảng cách xa nhất mà chúng bị cách chỉ là 2 ô (c1-d1). Còn nếu chọn 3 bóng bất kỳ nào khác thì khoảng trống xa nhất sẽ lớn hơn 2 ô (hàng ví dụ hàng A10, nếu chọn (d1,d4,d6) thì khoảng trống lớn nhất sẽ là 4 ô. Nếu tô được màu luôn thì tốt nhất, còn không thì trả về kết quả là 0 và 1 cũng được ạ.

Xin cảm ơn.

 

[anhtuanle123]

bài này hình như áp dụng bài chỉnh hợp chập 3 của 8 phần tử á ,
mỗi lần chọn 3 bóng sẽ xét khoảng cách và ghi nhận giá trị khoảng cách nhỏ nhất giảm dần
nếu chạy đc thì kết hợp với các trường hợp loại trừ để cho nhanh !

vét cạn đc khoảng 6 kết quả !


phân tích ngoài !
kết quả thì thấy có vẻ thỏa yêu cầu rùi nhưng lượng bóng vẫn phân bổ không đều , vẫn có chỗ nhiều bóng , ít bóng , mình thấy kết quả (1,3,7) có vẻ là kết quả tốt nhất , vì có 8 khoảng trống cách nhau , vì thế ánh sáng phân bổ đều hơn !

 

[HieuCD]

mong các bạn giúp bài toán này ạ:

Cho các bóng đèn đánh số từ d1 đến d8. chúng được gắn ngẫu nhiên trải từ a1 đến s1, có thể lặp lại .
yêu cầu: Tìm ra 3 bóng, sao cho khoảng trống mà chúng tạo ra là ít nhất( chiếu sáng tối đa)
Như trong ví dụ, thì kết quả là (d1,d3,d5) hoặc (d1,d5,d8) vì khoảng cách xa nhất mà chúng bị cách chỉ là 2 ô (c1-d1). Còn nếu chọn 3 bóng bất kỳ nào khác thì khoảng trống xa nhất sẽ lớn hơn 2 ô (hàng ví dụ hàng A10, nếu chọn (d1,d4,d6) thì khoảng trống lớn nhất sẽ là 4 ô. Nếu tô được màu luôn thì tốt nhất, còn không thì trả về kết quả là 0 và 1 cũng được ạ.

Xin cảm ơn.

Chạy sub XYZ

Option Explicit
Sub XYZ()
  Dim TH, sArr(), res(), tmp$
  Dim N&, K&, i&, j&, sCol&, d&, dMax&, dMin&
 
  sArr = Range("A1").Resize(, Range("AAA1").End(xlToLeft).Column + 1).Value
  sCol = UBound(sArr, 2)
  For j = 1 To sCol - 1
    sArr(1, j) = Right(sArr(1, j), 1)
  Next j
  N = 8: K = 3
  TH = Tohop_N_Chap_K(N, K)
  dMin = N
  For i = 1 To UBound(TH)
    d = 0: dMax = 0
    tmp = Empty
    For j = 1 To N
      If Mid(TH(i, 1), j, 1) = 1 Then tmp = tmp & j
    Next j
    sArr(1, sCol) = tmp
    For j = 1 To sCol
      If InStr(1, tmp, sArr(1, j)) > 0 Then
        If d > dMin Then Exit For
        If dMax < d Then dMax = d
        d = 0
      Else
        d = d + 1
      End If
    Next j
    If j = sCol + 1 Then
      If dMin > dMax Then
        ReDim Preserve res(1 To 1)
        res(1) = tmp
        dMin = dMax
      ElseIf dMin = dMax Then
        ReDim Preserve res(1 To UBound(res) + 1)
        res(UBound(res)) = tmp
      End If
    End If
  Next i
  Range("A3").Resize(1000, sCol).Clear
  sArr = Range("A1").Resize(1, sCol - 1).Value
  For i = 1 To UBound(res)
    Range("A" & i + 2).Resize(1, sCol - 1) = sArr
    For j = 1 To sCol - 1
      If InStr(1, res(i), Mid(Cells(i + 2, j), 2, 1)) > 0 Then Cells(i + 2, j).Interior.ColorIndex = 8
    Next j
  Next i
End Sub

Private Function Tohop_N_Chap_K(ByVal N As Integer, ByVal K As Integer) As Variant
  'Tao to hop N chap K, bieu dien bang chuoi các ký tu "0" va "1"
  'Thu tu gia tri "1" là thu tu du lieu nguon lay du lieu
  Dim Arr() As String, tmp$, j&, p&, s&
  ReDim Arr(1 To Application.Combin(N, K), 1 To 1)
  tmp = String(K, "1") & String(N - K, "0")
  p = 1: Arr(p, 1) = tmp
  Do
    j = InStrRev(tmp, "1")
    Mid(tmp, j, 1) = "0"
    Mid(tmp, j + 1, s + 1) = String(s + 1, "1")
    s = 0: p = p + 1:   Arr(p, 1) = tmp
    If InStr(j + 1, tmp, "0") = 0 Then
      s = N - j
      Mid(tmp, j + 1, s) = String(s, "0")
    End If
  Loop Until s = K
  Tohop_N_Chap_K = Arr
End Function