求算法：一组数中连续6个数递增或递减

[lanhai96]

求两个算法：
1、一组数中连续6个数递增或递减
例如：
1012 1002 1004 987 988 1016 970 982 990 1002 1011 1020 1015 1014 1021 1017 992 1027 1022 973 1026 991 1001 1016
其中的970 982 990 1002 1011 1020 ，即连续，又递增

2、一组数中连续5个数中有4个小于给定数的组合

求有4个数小于1000的连续的5个数
例如：
1012 1002 1004 987 988 1016 970 982 990 1002 1011 1020 1015 1014 1021 1017 992 1027 1022 973 1026 991 1001 1016
其中：987 988 1016 970 982满足该条件

一个比一个难啊，熬死我脑袋了，求各位大神救救命啊，在线急等。。。。分可商量

[赵4老师]

参考《编译原理》中的词法分析和有限状态自动机。

[一如既往哈]

用2重循环，笨法：

Sub Test1()
    ''''一组数中连续6个数递增或递减
    Dim i As Integer, lastNum As Integer, w2 As String, ww
    Dim k As Integer, S1 As String, nowNum As Integer
    ww = Array("1012", "1002", "1004", "987", "988", "1016", "970", "982", "990", "1002", "1011", "1020", "1015", "1014", "1021", "1017", "992", "1027", "1022", "973", "1026", "991", "1001", "1016")
    For i = 0 To UBound(ww) - 5
        S1 = ww(i)
        lastNum = CInt(ww(i))
        w2 = ""
        For k = i + 1 To i + 5
            S1 = S1 & "," & ww(k)
            nowNum = CInt(ww(k))
            If nowNum < lastNum Then w2 = w2 & "0"
            If nowNum > lastNum Then w2 = w2 & "1"
            lastNum = nowNum
        Next
        If w2 = "11111" Or w2 = "00000" Then
            Debug.Print S1
            Exit For
        End If
    Next
End Sub
Sub Test2()
    ''''一组数中连续5个数中有4个小于给定数的组合
    Dim i As Integer, nowNum As Integer, Target As Integer
    Dim k As Integer, n As Integer, S1 As String, ww
    ww = Array("1012", "1002", "1004", "987", "988", "1016", "970", "982", "990", "1002", "1011", "1020", "1015", "1014", "1021", "1017", "992", "1027", "1022", "973", "1026", "991", "1001", "1016")
    Target = 1000 ''指定的目标数
    For i = 0 To UBound(ww) - 4
        S1 = ww(i)
        n = 0
        If CInt(ww(i)) < Target Then n = 1
        For k = i + 1 To i + 4
            S1 = S1 & "," & ww(k)
            If CInt(ww(k)) < Target Then n = n + 1
        Next
        If n = 4 Then
            Debug.Print S1
            Exit For
        End If
    Next
End Sub

...

[Tiger_Zhao]

上午回答了一个帖子《一组数中找出连续14个数相邻大小交替的数》，类似的问题不会自己改啊。
你需要的是一个奶妈。

[lanhai96]

引用 3 楼 Tiger_Zhao 的回复:

上午回答了一个帖子《一组数中找出连续14个数相邻大小交替的数》，类似的问题不会自己改啊。 你需要的是一个奶妈。

不好意思，在做论文，实在太着急了，还有10个算法，还要根据数据动态画图，用c#用的多，vb很多都忘了。谢谢您给的上个算法，眼界开阔了很多，已经结贴了，分全给了，谢谢。

[of123]

Dim data1(), data2()

Private Sub Command1_Click()
data1() = Array(1012, 1002, 1004, 987, 988, 1016, 970, 982, 990, 1002, 1011, 1020, 1015, 1014, 1021, 1017, 992, 1027, 1022, 973, 1026, 991, 1001, 1016)
data2() = Array(1012, 1002, 1004, 987, 988, 1016, 1020, 1011, 1002, 990, 982, 970, 1015, 1014, 1021, 1017, 992, 1027, 1022, 973, 1026, 991, 1001, 1016)
Call Find_continuous_increasing_numbers(data1, 6)
Call Find_continuous_decreasing_numbers(data2, 6)
End Sub

Private Sub Find_continuous_increasing_numbers(data() As Variant, link_length As Integer)
Dim i As Integer, n As Integer, j As Integer

For i = 1 To UBound(data)
    If data(i) > data(i - 1) Then
        n = n + 1
    Else
        n = 0
    End If
    
    If n + 1 = link_length Then
        For j = n To 0 Step -1
            Debug.Print data(i - j),
        Next j
        Debug.Print
        Exit For
    End If
Next i
End Sub

Private Sub Find_continuous_decreasing_numbers(data() As Variant, link_length As Integer)
Dim i As Integer, n As Integer, j As Integer

For i = 1 To UBound(data)
    If data(i) < data(i - 1) Then
        n = n + 1
    Else
        n = 0
    End If
    
    If n + 1 = link_length Then
        For j = n To 0 Step -1
            Debug.Print data(i - j),
        Next j
        Debug.Print
        Exit For
    End If
Next i
End Sub

 970           982           990           1002          1011          1020         
 1020          1011          1002          990           982           970          

[of123]

Dim data1()

Private Sub Command1_Click()
data1() = Array(1012, 1002, 1004, 987, 988, 1016, 970, 982, 990, 1002, 1011, 1020, 1015, 1014, 1021, 1017, 992, 1027, 1022, 973, 1026, 991, 1001, 1016)
Call Find_continuous_smaller_numbers(data1, 1000, 5)
End Sub

Private Sub Find_continuous_smaller_numbers(data() As Variant, ceiling_number As Integer, link_length As Integer)
Dim i As Integer, n As Integer, m As Integer, j As Integer

For i = 1 To UBound(data)
    If data(i) < ceiling_number Then
        n = n + 1
    Else
        m = m + 1
        If (m > 1) Then
            m = 0
            n = 0
        End If
    End If
    
    If n + m = link_length Then
        For j = n To 0 Step -1
            Debug.Print data(i - j),
        Next j
        Debug.Print
        Exit For
    End If
Next i
End Sub

987           988           1016          970           982

[vansoft]

就是比大小，计数。连续大计数，计到5，就是成功。