|
本帖最后由 jsxjd 于 2014-2-16 14:06 编辑
有向连通图欧拉路径问题:用Split稳定在 6.5 Secs 左右,用StrConv稳定在 4.5 Secs左右
- Public Function CheckLinkability() As Variant
- Dim t#: t = Timer
- On Error GoTo END_FUNC
- Dim aRes(1 To 3)
- Open ThisWorkbook.Path & "\单词接龙_测试数据.csv" For Input Access Read As #1
- ' ......
- Dim I&, n&, T1&, T2&, s$
- Input #1, n
- For I = 1 To n
- Input #1, T1, T2, s
- aRes(3) = aRes(3) & WordSolitaire(s)
- Next
- ' ......
- END_FUNC:
- Close #1
- aRes(1) = "jsxjd" ' <- 你的论坛ID
- aRes(2) = Timer - t
- If Err Then Err.Clear: aRes(2) = -1: On Error GoTo 0
- ' aRes(3) 为100个字母 T 或 F 的字符串,T 为能够接龙,F 为不能
- CheckLinkability = aRes
- End Function
- Private Function WordSolitaire$(WordStr$)
- Dim s, I&, J&, FinalVertex&, StartVertex&, nIn&, nOut&, nVertex&
- Dim newVertex As Boolean, k, Dict
- Dim Edges&(97 To 122, 97 To 122), Vertex&(97 To 122)
- For Each s In Split(WordStr, ",")
- I = Asc(s)
- J = Asc(Right(s, 1))
- Vertex(I) = 1: Vertex(J) = 1
- Edges(I, J) = Edges(I, J) + 1
- Next
- WordSolitaire = "F"
- For I = 97 To 122
- nIn = 0: nOut = 0
- For J = 97 To 122
- nIn = nIn + Edges(J, I)
- nOut = nOut + Edges(I, J)
- Next
- Select Case nOut - nIn
- Case -1
- If FinalVertex > 0 Then Exit Function
- FinalVertex = I
- Case 1
- If StartVertex > 0 Then Exit Function
- StartVertex = I
- Case 0
- Case Else
- Exit Function
- End Select
- Next
- For I = 97 To 122
- If Vertex(I) > 0 Then
- nVertex = nVertex + 1
- If StartVertex = 0 Then StartVertex = I
- End If
- Next
-
- Set Dict = CreateObject("Scripting.Dictionary")
- Dict(StartVertex) = 0
- Do
- newVertex = False
- For Each k In Dict.keys
- J = CLng(k)
- If Dict(J) = 0 Then
- For I = 97 To 122
- If J <> I Then
- If Edges(J, I) > 0 Then
- If Not Dict.Exists(I) Then Dict(I) = 0: newVertex = True
- End If
- End If
- Next
- Dict(J) = 1
- End If
- Next
- Loop Until newVertex = False
- If Dict.Count = nVertex Then WordSolitaire = "T"
- Set Dict = Nothing
- End Function
复制代码
以下不使用split,速度有所提高:稳定在 4.5 Secs 左右
- Public Function CheckLinkability() As Variant
- Dim t#: t = Timer
- On Error GoTo END_FUNC
- Dim aRes(1 To 3)
- Open ThisWorkbook.Path & "\单词接龙_测试数据.csv" For Input Access Read As #1
- ' ......
- Dim I&, N&, T1&, T2&, s$
- Input #1, N
- For I = 1 To N
- Input #1, T1, T2, s
- aRes(3) = aRes(3) & WordSolitaire(s)
- Next
- ' ......
- END_FUNC:
- Close #1
- aRes(1) = "jsxjd" ' <- 你的论坛ID
- aRes(2) = Timer - t
- If Err Then Err.Clear: aRes(2) = -1: On Error GoTo 0
- ' aRes(3) 为100个字母 T 或 F 的字符串,T 为能够接龙,F 为不能
- CheckLinkability = aRes
- End Function
- Private Function WordSolitaire$(WordStr$)
- Dim N&, I&, J&, FinalVertex&, StartVertex&, nIn&, nOut&, nVertex&
- Dim b() As Byte, newVertex As Boolean, k, Dict
- Dim Edges&(97 To 122, 97 To 122), Vertex&(97 To 122)
-
- b = StrConv(WordStr, vbFromUnicode)
- I = b(LBound(b))
- For N = LBound(b) + 1 To UBound(b)
- If b(N) = 44 Then
- J = b(N - 1)
- Vertex(I) = 1: Vertex(J) = 1
- Edges(I, J) = Edges(I, J) + 1
- I = b(N + 1)
- End If
- Next
- J = b(UBound(b))
- Vertex(I) = 1: Vertex(J) = 1
- Edges(I, J) = Edges(I, J) + 1
-
- WordSolitaire = "F"
- For I = 97 To 122
- nIn = 0: nOut = 0
- For J = 97 To 122
- nIn = nIn + Edges(J, I)
- nOut = nOut + Edges(I, J)
- Next
- Select Case nOut - nIn
- Case -1
- If FinalVertex > 0 Then Exit Function
- FinalVertex = I
- Case 1
- If StartVertex > 0 Then Exit Function
- StartVertex = I
- Case 0
- Case Else
- Exit Function
- End Select
- Next
- For I = 97 To 122
- If Vertex(I) > 0 Then
- nVertex = nVertex + 1
- If StartVertex = 0 Then StartVertex = I
- End If
- Next
- Set Dict = CreateObject("Scripting.Dictionary")
- Dict(StartVertex) = 0
- Do
- newVertex = False
- For Each k In Dict.keys
- J = CLng(k)
- If Dict(J) = 0 Then
- For I = 97 To 122
- If J <> I And Edges(J, I) > 0 Then
- If Not Dict.Exists(I) Then
- Dict(I) = 0: newVertex = True
- If Dict.Count = nVertex Then Exit Do
- End If
- End If
- Next
- Dict(J) = 1
- End If
- Next
- Loop Until newVertex = False
- If Dict.Count = nVertex Then WordSolitaire = "T"
- Set Dict = Nothing
- End Function
复制代码
|
评分
-
1
查看全部评分
-
|