HD giúp thuật toán tìm cặp số liên tiếp thỏa dk!

ThuNghi · 3/2/12

Tôi có vấn đề này mà chưa giải quyết được thấu đáo. Cụ thể như sau:
Gt: Có 1 Arr=Array(2,2,3,5,2,4,3,3,3,1,3,3) có 12 phần tử số.
Tôi muốn có kết quả sau: Tìm những cặp số liên tiếp (>= 2 số hạng) mà có giá trị >1 và ghi vào kq như sau: vị trí tìm thấy:số lần xuất hiện ....
kq="1:2-7:3-11:2", chỉ cần có kq kg nhất thiết là chuổi hay arr.
Nghĩa là bắt đầu tại vị trí 1, vị trí 7 và vị trí 12 đều có những số >1 liền kề.
Xin cám ơn.

ndu96081631 · 3/2/12

ThuNghi đã viết:
Tôi có vấn đề này mà chưa giải quyết được thấu đáo. Cụ thể như sau:
Gt: Có 1 Arr=Array(2,2,3,5,2,4,3,3,3,1,3,3) có 12 phần tử số.
Tôi muốn có kết quả sau: Tìm những cặp số liên tiếp (>= 2 số hạng) mà có giá trị >1 và ghi vào kq như sau: vị trí tìm thấy:số lần xuất hiện ....
kq="1:2-7:3-11:2", chỉ cần có kq kg nhất thiết là chuổi hay arr.
Nghĩa là bắt đầu tại vị trí 1, vị trí 7 và vị trí 12 đều có những số >1 liền kề.
Xin cám ơn.

Dùng Dictionary chắc là được:

PHP:

Sub Test()
  Dim sArray, tmpArr1, tmpArr2, Arr(), Dic
  Dim k As Long, n As Long, tmp, lPos As Long, lCount As Long
  sArray = Array(2, 2, 3, 5, 2, 4, 3, 3, 3, 1, 3, 3)
  lCount = 1
  Set Dic = CreateObject("Scripting.Dictionary")
  For k = LBound(sArray) To UBound(sArray) - 1
    If sArray(k) = sArray(k + 1) Then
      lCount = lCount + 1
      If lPos = 0 Then lPos = k + 1
      If lCount > 1 Then
        If Not Dic.Exists(lPos) Then
          Dic.Add lPos, lCount
        Else
          Dic.Item(lPos) = Dic.Item(lPos) + 1
        End If
      End If
    Else
      lCount = 1: lPos = 0
    End If
    tmp = sArray(k)
  Next
  tmpArr1 = Dic.Keys
  tmpArr2 = Dic.Items
  ReDim Arr(Dic.Count - 1)
  For k = 0 To Dic.Count - 1
    Arr(k) = tmpArr1(k) & ":" & tmpArr2(k)
  Next
  MsgBox Join(Arr, ", ")
End Sub

Làm sơ qua thôi
Nghiên cứu tiếp xem có thể rút gọn bớt không
bài này hơi bị hay à nha!

concogia · 3/2/12

ThuNghi đã viết:
Tôi có vấn đề này mà chưa giải quyết được thấu đáo. Cụ thể như sau:
Gt: Có 1 Arr=Array(2,2,3,5,2,4,3,3,3,1,3,3) có 12 phần tử số.
Tôi muốn có kết quả sau: Tìm những cặp số liên tiếp (>= 2 số hạng) mà có giá trị >1 và ghi vào kq như sau: vị trí tìm thấy:số lần xuất hiện ....
kq="1:2-7:3-11:2", chỉ cần có kq kg nhất thiết là chuổi hay arr.
Nghĩa là bắt đầu tại vị trí 1, vị trí 7 và vị trí 12 đều có những số >1 liền kề.
Xin cám ơn.

Không dùng "Đít", chắc cũng được

Mã:

Public Sub ThiNgu()
    Dim Mg, DiemDau, DiemCuoi, I, K, Kq
    Mg = Array(2, 2, 3, 5, 2, 4, 3, 3, 3, 1, 3, 3)
        For I = 1 To UBound(Mg) - 1
            If Mg(I) > 1 Then
                If Mg(I) = Mg(I + 1) Then
                    K = K + 1
                    DiemDau = I + 1 - K
                End If
                    If DiemDau > 0 And Mg(I) <> Mg(I + 1) Then
                        DiemCuoi = I + 1 - DiemDau
                        Kq = Kq & DiemDau & ":" & DiemCuoi & "- "
                        DiemDau = 0: K = 0
                    ElseIf DiemDau > 0 And I = UBound(Mg) - 1 Then
                        DiemCuoi = I + 2 - DiemDau
                        Kq = Kq & DiemDau & ":" & DiemCuoi
                    End If
                End If
        Next I
    [A2] = Kq
End Sub

Thu Nghi kiểm tra giúp, hình như chưa chắc ăn

ThuNghi · 3/2/12

- Code của NDU thì ra đúng kq, nhưng NDU quên những số liên tiếp >1. Và biến

tmp = sArray(K)

chưa biết làm gì. Mình sẽ triển khai code của NDU lại, nghĩ rằng chỉ có dùng Dic mới lấy kq nhanh nhất.
- Code của Anh Cò thì ra kq chưa đúng, có khi sai khi xác định Lbound(Mg) = 0 chớ không phải là 1. Để em test lại và thông báo sau.Cám ơn hai anh nhiều.
Sorry, do yêu cầu bài hơi sai => kq cũng sai, nên 2 anh làm chưa đúng ý
.Gt: Có 1 Arr=Array(2,2,3,5,2,4,3,3,3,1,3,3) có 12 phần tử số.
Tôi muốn có kết quả sau: Tìm những cặp số liên tiếp (>= 2 số hạng) mà có giá trị >1 và ghi vào kq như sau: vị trí tìm thấy:số lần xuất hiện ....
kq="1:9-11:2".
Code của NDU sửa 1 chút là OK rồi.

PHP:

Sub Test()
  Dim sArray, tmpArr1, tmpArr2, Arr(), Dic
  Dim k As Long, n As Long, tmp, lPos As Long, lCount As Long
  sArray = Array(2, 2, 3, 5, 2, 4, 3, 3, 3, 1, 3, 3)
  lCount = 1
  Const lNum = 1
  Set Dic = CreateObject("Scripting.Dictionary")
  For k = LBound(sArray) To UBound(sArray) - 1
    If sArray(k) > lNum And sArray(k + 1) > lNum Then
    'If sArray(K) = sArray(K + 1) Then
      lCount = lCount + 1
      If lPos = 0 Then lPos = k + 1
      If lCount > 1 Then
        If Not Dic.Exists(lPos) Then
          Dic.Add lPos, lCount
        Else
          Dic.Item(lPos) = Dic.Item(lPos) + 1
        End If
      End If
    Else
      lCount = 1: lPos = 0
    End If
  Next
  tmpArr1 = Dic.Keys
  tmpArr2 = Dic.Items
  ReDim Arr(Dic.Count - 1)
  For k = 0 To Dic.Count - 1
    Arr(k) = tmpArr1(k) & ":" & tmpArr2(k)
  Next
  MsgBox Join(Arr, ", ")
End Sub

concogia · 3/2/12

ThuNghi đã viết:
- Code của NDU thì ra đúng kq, nhưng NDU quên những số liên tiếp >1. Và biến chưa biết làm gì. Mình sẽ triển khai code của NDU lại, nghĩ rằng chỉ có dùng Dic mới lấy kq nhanh nhất.
- Code của Anh Cò thì ra kq chưa đúng, có khi sai khi xác định Lbound(Mg) = 0 chớ không phải là 1. Để em test lại và thông báo sau.
Cám ơn hai anh nhiều.

Sorry, do yêu cầu bài hơi sai => kq cũng sai, nên 2 anh làm chưa đúng ý.
Gt: Có 1 Arr=Array(2,2,3,5,2,4,3,3,3,1,3,3) có 12 phần tử số.
Tôi muốn có kết quả sau: Tìm những cặp số liên tiếp (>= 2 số hạng) mà có giá trị >1 và ghi vào kq như sau: vị trí tìm thấy:số lần xuất hiện ....
kq="1:9-11:2", chỉ cần có kq kg nhất thiết là chuổi hay arr.

Trời ơi, mình copy code thiếu tý tẹo ( cái này nhìn Thu Nghi phải biết chứ nhỉ)
Nếu điều kiện thế này càng đơn giản hơn

Mã:

Option Explicit
Option Base 1Public Sub ThiNgu()
    Dim Mg, DiemDau, DiemCuoi, I, K, Kq
    Mg = Array(2, 2, 3, 5, 2, 4, 3, 3, 3, 1, 3, 3)
        For I = 1 To UBound(Mg) - 1
                If Mg(I) > 1 And Mg(I + 1) > 1 Then
                    K = K + 1
                    DiemDau = I + 1 - K
                End If
                    If DiemDau > 0 And Mg(I) <= 1 Then
                        DiemCuoi = I - DiemDau
                        Kq = Kq & DiemDau & ":" & DiemCuoi & "- "
                        DiemDau = 0: K = 0
                    ElseIf DiemDau > 0 And I = UBound(Mg) - 1 And Mg(UBound(Mg)) > 1 Then
                        DiemCuoi = I + 2 - DiemDau
                        Kq = Kq & DiemDau & ":" & DiemCuoi
                    End If
        Next I
    [A2] = Kq
End Sub

Híc

ndu96081631 · 3/2/12

ThuNghi đã viết:
- Code của NDU thì ra đúng kq, nhưng NDU quên những số liên tiếp >1. Và biến chưa biết làm gì. Mình sẽ triển khai code của NDU lại, nghĩ rằng chỉ có dùng

Sorry! Chưa đọc kỹ đề bài
Giờ cải tiến dùng 1 vòng lập + 2 Dic

PHP:

Sub Test()
  Dim sArray, Arr(), Dic1, Dic2
  Dim k As Long, tmp, lPos As Long, n As Long
  sArray = Array(2, 2, 3, 5, 2, 4, 3, 3, 3, 1, 3, 3)
  Set Dic1 = CreateObject("Scripting.Dictionary")
  Set Dic2 = CreateObject("Scripting.Dictionary")
  For k = LBound(sArray) To UBound(sArray) - 1
    If sArray(k) > 1 And sArray(k + 1) > 1 Then
      If lPos = 0 Then lPos = k + 1
      If Not Dic1.Exists(lPos) Then
        n = n + 1
        Dic1.Add lPos, 2
        Dic2.Add lPos, n
        ReDim Preserve Arr(1 To n)
        Arr(n) = lPos & ":2"
      Else
        Dic1.Item(lPos) = Dic1.Item(lPos) + 1
        Arr(Dic2.Item(lPos)) = lPos & ":" & Dic1.Item(lPos)
      End If
    Else
      lPos = 0
    End If
    tmp = sArray(k)
  Next
  If n Then MsgBox Join(Arr, ", ")
End Sub

huuthang_bd · 3/2/12

http://a.comBài này không cần dic cũng được. Dùng dic chưa chắc đã nhanh hơn.

PHP:

Option Base 1
Sub Test()
Dim sArray, Arr(), Dic1, Dic2
Dim K As Long, ViTri As Long, SoLan As Long, KetQua(), Str As String
sArray = Array(2, 2, 3, 5, 2, 4, 3, 3, 3, 1, 2, 3)
ViTri = 1
For K = LBound(sArray) To UBound(sArray) - 1
    If sArray(K) <= 1 Then
        If K - ViTri > 1 Then
            Str = Str & " - " & ViTri & ":" & K - ViTri
        End If
        ViTri = K + 1
    End If
Next
If sArray(UBound(sArray)) > 1 Then
    If UBound(sArray) - ViTri > 0 Then
        Str = Str & " - " & ViTri & ":" & K - ViTri + 1
    End If
End If
Str = Replace(Str, " - ", "", 1, 1)
MsgBox Str
End Sub

ndu96081631 · 3/2/12

Nhân đây xin đố 1 câu: Làm sao làm được bài này mà hoàn toàn không có tí nào thao tác nối chuối ---> Tức có thể dùng hàm Join nhưng không được dùng toán tử & để nối chuổi
Ẹc... Ẹc...

huuthang_bd · 4/2/12

ndu96081631 đã viết:
Nhân đây xin đố 1 câu: Làm sao làm được bài này mà hoàn toàn không có tí nào thao tác nối chuối ---> Tức có thể dùng hàm Join nhưng không được dùng toán tử & để nối chuổi
Ẹc... Ẹc...

Có thể cách này có thể không giống như đáp án của anh nó cũng thỏa yêu cầu bài toán.

PHP:

Option Base 1
Sub Test()
Dim Arr1, Arr(), k As Long, x As Long, i As Long, str As String
Arr1 = Array(2, 2, 3, 5, 2, 4, 3, 3, 3, 1, 2, 3)
i = 1
For k = LBound(Arr1) To UBound(Arr1) - 1
    If Arr1(k) <= 1 Then
        If k - i > 1 Then
            x = x + 2
            ReDim Preserve Arr(1 To x)
            Arr(x - 1) = -i
            Arr(x) = k - i
        End If
        i = k + 1
    End If
Next
If Arr1(UBound(Arr1)) > 1 Then
    If UBound(Arr1) - i > 0 Then
        x = x + 2
        ReDim Preserve Arr(1 To x)
        Arr(x - 1) = -i
        Arr(x) = k - i + 1
    End If
End If
str = Replace(Join(Arr, ":"), ":-", " - ")
str = Replace(str, "-", "", 1, 1)
MsgBox str
End Sub

ndu96081631 · 4/2/12

huuthang_bd đã viết:

Có thể cách này có thể không giống như đáp án của anh nó cũng thỏa yêu cầu bài toán.

PHP:

Option Base 1
Sub Test()
Dim Arr1, Arr(), k As Long, x As Long, i As Long, str As String
Arr1 = Array(2, 2, 3, 5, 2, 4, 3, 3, 3, 1, 2, 3)
i = 1
For k = LBound(Arr1) To UBound(Arr1) - 1
    If Arr1(k) <= 1 Then
        If k - i > 1 Then
            x = x + 2
            ReDim Preserve Arr(1 To x)
            Arr(x - 1) = -i
            Arr(x) = k - i
        End If
        i = k + 1
    End If
Next
If Arr1(UBound(Arr1)) > 1 Then
    If UBound(Arr1) - i > 0 Then
        x = x + 2
        ReDim Preserve Arr(1 To x)
        Arr(x - 1) = -i
        Arr(x) = k - i + 1
    End If
End If
str = Replace(Join(Arr, ":"), ":-", " - ")
str = Replace(str, "-", "", 1, 1)
MsgBox str
End Sub

Cũng được!
Còn tôi dùng phương pháp mảng trong mảng: Một mảng lớn với những phần tử là mảng nhỏ 2 phần tử ---> Join các mảng nhỏ, ta được dạng xx:yy ---> Join toàn bộ mảng lớn, ta được chuổi x1:y1, x2:y2, ..... xn:yn
Vậy thôi

huuthang_bd · 4/2/12

ndu96081631 đã viết:
Cũng được!
Còn tôi dùng phương pháp mảng trong mảng: Một mảng lớn với những phần tử là mảng nhỏ 2 phần tử ---> Join các mảng nhỏ, ta được dạng xx:yy ---> Join toàn bộ mảng lớn, ta được chuổi x1:y1, x2:y2, ..... xn:yn
Vậy thôi

Có lẽ anh muốn ví dụ về mảng trong mảng chứ theo em thì việc duyệt qua các phần tử của mảng lớn để Join các mảng nhỏ có lẽ mất nhiều thời gian hơn cách làm thông thường.

ndu96081631 · 4/2/12

huuthang_bd đã viết:
Có lẽ anh muốn ví dụ về mảng trong mảng chứ theo em thì việc duyệt qua các phần tử của mảng lớn để Join các mảng nhỏ có lẽ mất nhiều thời gian hơn cách làm thông thường.

Không đâu! Điều này đã được chứng minh nhiều lần rồi ---> Dù code có dài hơn nhưng hàm Join luôn cho tốc độ nhanh hơn phép nối chuổi thông thường

HD giúp thuật toán tìm cặp số liên tiếp thỏa dk!

ThuNghi

Hãy cho rồi sẽ nhận!

ndu96081631

Huyền thoại GPE

concogia

Gội rồi mới Cạo

ThuNghi

Hãy cho rồi sẽ nhận!

concogia

Gội rồi mới Cạo

ndu96081631

Huyền thoại GPE

huuthang_bd

Chuyên gia GPE

ndu96081631

Huyền thoại GPE

huuthang_bd

Chuyên gia GPE

ndu96081631

Huyền thoại GPE

huuthang_bd

Chuyên gia GPE

ndu96081631

Huyền thoại GPE

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian