出个题目.

sunya_0529

WPS里的JSA练习一下，虽然算出来了，但是时长将近2分钟，一定还有很大的优化空间，空了再琢磨琢磨——

gaozengxun

我连意思还没搞懂，好像是太难了，等待大老们结果。

大灰狼1976

根据自己的想法写，能出结果的都对，但有一大半没出结果，总时间4秒多，继续排查。

一招秒杀

感觉真是闲得蛋疼，搞这么无聊的要累死电脑的题目，就如 姜萍 参加 阿里的数学大赛，那些鬼东西现实是 很难派上用场，有这时间 学习点新知识 它不香吗？

lxdexcel

1. Option Explicit
   
2. 
   
3. Private Function minerr(str As String, x As Long, y As Long) As Long
   
4.   Dim i&, m1&, m&, s1&, s2&, k&
   
5.   Dim arr() As Long
   
6.   
   
7.   m1 = 0
   
8.   m = 0
   
9.   i = 1
   
10.   ReDim arr(0 To 20)
    
11.   
    
12.   Do While i <= Len(str)
    
13.      
    
14.     If Mid(str, i, 1) = "0" Then
    
15.       For k = 0 To m
    
16.         arr(k) = arr(k) + y * (m1 + k)
    
17.       
    
18.       Next
    
19.     ElseIf Mid(str, i, 1) = "1" Then
    
20.       For k = 0 To m
    
21.          arr(k) = arr(k) + x * (i - (m1 + k) - 1)
    
22.          
    
23.       Next
    
24.       m1 = m1 + 1
    
25.      
    
26.     Else
    
27.       If m >= UBound(arr) Then ReDim Preserve arr(0 To UBound(arr) + 20)
    
28.       arr(m + 1) = arr(m) + x * (i - (m1 + m) - 1)
    
29.      
    
30.       For k = m To 1 Step -1
    
31.        s1 = arr(k) + y * (m1 + k)
    
32.        s2 = arr(k - 1) + x * (i - (m1 + k - 1) - 1)
    
33.        arr(k) = IIf(s1 < s2, s1, s2)
    
34.       Next
    
35.       
    
36.        arr(0) = arr(0) + y * m1
    
37.       
    
38.       m = m + 1
    
39.      
    
40.     End If
    
41.       i = i + 1
    
42.   Loop
    
43.     minerr = arr(0)
    
44.     For k = 1 To m
    
45.       If arr(k) < minerr Then
    
46.         minerr = arr(k)
    
47.       End If
    
48.     Next
    
49. End Function
    
50. 
    
51. Private Sub CommandButton1_Click()
    
52. Dim t As Double
    
53. Dim i&, last&
    
54. 
    
55. 
    
56. t = Timer()
    
57. last = Range("A65536").End(xlUp).Row
    
58. For i = 1 To last
    
59.     Cells(i, 4) = minerr(Cells(i, 1), Val(Cells(i, 2)), Val(Cells(i, 3)))
    
60. Next
    
61. Cells(1, 5) = Timer() - t
    
62. End Sub
    
63. 
    

复制代码

ynzsvt

一招秒杀 发表于 2024-9-28 22:48
感觉真是闲得蛋疼，搞这么无聊的要累死电脑的题目，就如 姜萍 参加 阿里的数学大赛，那些鬼东西现实是 很难 ...

不累的呀，100题只不过几秒就完成图了。

779846526

一招秒杀 发表于 2024-9-28 22:48
感觉真是闲得蛋疼，搞这么无聊的要累死电脑的题目，就如 姜萍 参加 阿里的数学大赛，那些鬼东西现实是 很难 ...

本贴能回复解答方法的都是大佬级别的，相当于他们在搞学术研究一样，应该是级别比较高的问题，比普通求助的问题难得多。

kevinchengcw

数学渣渣，数学解法不会，语文解法来一波

1. Sub test()
   
2. Dim N&, I&, K&, J&, P&, Arr, Arrt$(1), S$, T$, Y$, A&, B&, C&, D&, E&, mTimer#
   
3. mTimer = Timer
   
4. With ThisWorkbook.ActiveSheet
   
5.   Arr = .Range("a1:c" & .Cells(.Rows.Count, 1).End(3).Row).Value
   
6.   For N = LBound(Arr) To UBound(Arr)
   
7.     S = Arr(N, 1): A = Arr(N, 2): B = Arr(N, 3): P = 0
   
8.     If A > B Then Arrt(0) = "1": Arrt(1) = "0" Else Arrt(0) = "0": Arrt(1) = "1"
   
9.     J = countSS(Replace(S, "!", Arrt(0)), A, B)
   
10.     K = countSS(Replace(S, "!", Arrt(1)), A, B)
    
11.     If J > K Then
    
12.       T = Replace(S, "!", Arrt(1)): Y = Arrt(0): C = 1: D = Len(S): E = 1
    
13.     Else
    
14.       T = Replace(S, "!", Arrt(0)): K = J: Y = Arrt(1): C = Len(S): D = 1: E = -1
    
15.     End If
    
16.     For I = C To D Step E
    
17.       If Mid(S, I, 1) = "!" Then
    
18.         Mid(T, I, 1) = Y: J = countSS(T, A, B)
    
19.         If J <= K Then
    
20.           K = J
    
21.         'ElseIf J > K Then  '这个跳出条件有些情况下不对，如果能实现跳出会大幅提速
    
22.         '  Exit For
    
23.         End If
    
24.       End If
    
25.     Next I
    
26.     Arr(N, 1) = K
    
27.   Next N
    
28.   .[d1].Resize(UBound(Arr)).Value = Arr
    
29. End With
    
30. Debug.Print Timer - mTimer
    
31. End Sub
    
32. 
    
33. Function countSS(T$, A&, B&)
    
34. Dim C&, I&, D&, E&, F&, G&
    
35. For I = 1 To Len(T)
    
36.   If Mid(T, I, 1) = "1" Then
    
37.     E = E + C: G = G + 1
    
38.   Else
    
39.     C = C + 1: F = F + G
    
40.   End If
    
41. Next I
    
42. countSS = A * E + B * F
    
43. End Function

复制代码

不规则结构

突击百度“子序列”相关概念，目前囫囵吞枣，待消化ing！！