[第101期_2]单词接龙[已总结]

eyeshot

eyeshot 发表于 2014-1-31 12:40

程序中去掉了Variable
不然没法运行

oyzhjr

oyzhjr 发表于 2014-2-14 18:15
楼主的题目没看懂意思，不过就算看懂，这两天也没时间来做了，双节嘛。
说下我的思路。
定义一个长度为26 ...

是的，这个提醒有道理，直接跳过的必要情况是，已经存在以这个字母开头或结尾的单词。
修改代码如下：
再建一个长度为26的数组DD（）。
首先对26个字母在单词的单未位进行查询，假定没有一个单词在首位或尾位是b,则DD（2）＝1。
若数组DD中有一个为1，则无法进行接龙。

但是前面匹配判断比较费时的。

wcymiss

我是完全靠的百度，现炒现卖：
http://bbs.csdn.net/topics/70505395

eyeshot

jsxjd 发表于 2014-2-14 20:05
有向连通图欧拉路径问题：用Split稳定在 6.5 Secs 左右，用StrConv稳定在 4.5 Secs左右

以下不使用split ...

麻烦版主写点注释。。便于学习

jsxjd

eyeshot 发表于 2014-3-7 09:53
麻烦版主写点注释。。便于学习

谢谢提醒，看来楼主抽不出时间总结，本人就越殂代疱一下

jsxjd

本期越殂代疱，总结如下：

        本题可以把单词的首末字母看作顶点(本题最多有26个顶点)，把整个单词看作以首字母为起点末字母为终点的一条有向边，这样就归结为有向连通图的欧拉路径问题。可搜索相关知识点，或查看楼主的主题贴：图论算法基础 之 七桥问题与欧拉路径

        如 word, excelhome, a, pump, cat 分别可用以下的有向边表示：



        一个有向图存在欧拉路径的充要条件是：最多有一个顶点的度为（离开度 - 进入度 = 1），并且最多有一个顶点的度为（进入度 - 离开度 = 1），其它的顶点有着相等的进入度和离开度，并且所有的度非零的顶点属于同一个连通分量。

        考察单词组：a,oa,ab,ba,ak,kh，可得到以下有向图



显然上图为一连通图，有5个顶点，其中：
        (1) k、a、b的进入度和离开度相等；
        (2) 顶点o没有进入度，离开度为1；
        (3) 顶点h没有离开度，进入度为1
符合存在欧拉路径的条件。可以o为起点，h为终点进行单词接龙，接龙过程为：oa → a → ab → ba → ak → kh。当然接龙的方法并不是唯一的。

        单词组 ab,bc,ca,cd,df,fg,ge,ed,dc 存在欧拉回路(所有顶点的进入度等于离开度，而且是连通的)，可以任一顶点(单词)作为起始进行单词接龙。图示如下：



以下是无法接龙的两种情况：
        (1) 非连通图：a,oa,ab,ba,ak,kh,m



         (2) 不满足度数条件：a,oa,ab,ba,ak,kh,om



        上图顶点o没有进入度，但离开度为2，所以不存在欧拉路径，无法完成单词接龙。当然也可以从“顶点h,m没有离开度，但进入度均为1”来判断。

编程主要过程如下：
        (1) 将单词组表示为一个有向图，可通过二维邻接矩阵实现
        (2) 计算各顶点的进入度和离开度，判断是否满足存在欧拉路径的条件，并获得起始点
        (3) 判断有向图的连通性，是否从起始点出发可到达任一其他顶点

        具体代码实现可参考7楼(代码结构相对8楼简明)，数据读入效率的提高可参考8楼，体会InputB函数一次性读入字节流的用法。

        本题需要联系“有向连通图”，参与者较少，正确的更少。考虑到大家花费了不少时间和精力，对结果不正确的会员给予适当财富奖励，也希望更多会员参与本论坛的竞赛活动。具体评分如下：

lee1892

jsxjd 发表于 2014-3-7 14:45
本期越殂代疱，总结如下：

        本题可以把单词的首末字母看作顶点(本题最多有26个顶点)，把整个单词 ...

你们太厉害了，都比我的快，不过都比我的代码长，呵呵~

1. Option Explicit
   
2. Option Base 1
   
3. Public Function CheckLinkability() As Variant
   
4.     Dim t#: t = Timer
   
5.     On Error GoTo END_FUNC
   
6.     Dim aRes(1 To 3)
   
7.     Open ThisWorkbook.Path & "\单词接龙_测试数据.csv" For Input Access Read As #1
   
8.     ' ......
   
9.     Dim sLine$, nLine&, nWords&, iInd%, aWords, i&
   
10.     Line Input #1, sLine
    
11.     nLine = CLng(sLine)
    
12.     For i = 1 To nLine
    
13.         Input #1, nWords, iInd, sLine
    
14.         aWords = Split(sLine, ",")
    
15.         aRes(3) = aRes(3) & WordsLinkable(aWords)
    
16.     Next
    
17.     ' ......
    
18. END_FUNC:
    
19.     Close #1
    
20.     aRes(1) = "Lee1892" ' <- 你的论坛ID
    
21.     aRes(2) = Timer - t
    
22.     If Err Then Err.Clear: aRes(2) = -1: On Error GoTo 0
    
23.     ' aRes(3) 为100个字母 T 或 F 的字符串，T 为能够接龙，F 为不能
    
24.     CheckLinkability = aRes
    
25. End Function
    
26. Private Function WordsLinkable(ByRef aWords) As String
    
27.     Dim sWrd, aDeg&(26), iFst%, iLst%, i%, J%, k%, bFlag As Boolean
    
28.     Dim aEdg(26, 26) As Boolean, aVtx(26) As Boolean
    
29.     For Each sWrd In aWords
    
30.         iFst = Asc(Left(sWrd, 1)) - 96
    
31.         iLst = Asc(Right(sWrd, 1)) - 96
    
32.         aDeg(iFst) = aDeg(iFst) + 1
    
33.         aDeg(iLst) = aDeg(iLst) - 1
    
34.         aEdg(iFst, iLst) = True
    
35.         aEdg(iLst, iFst) = True
    
36.         aVtx(iFst) = True
    
37.         aVtx(iLst) = True
    
38.     Next
    
39.     For k = 1 To 26
    
40.         For i = 1 To 26
    
41.             For J = 1 To 26
    
42.                 aEdg(i, J) = aEdg(i, J) Or (aEdg(i, k) And aEdg(k, J))
    
43.             Next
    
44.         Next
    
45.     Next
    
46.     For i = 1 To 26
    
47.         For J = 1 To 26
    
48.             If aVtx(i) And aVtx(J) And (Not aEdg(i, J)) Then
    
49.                 bFlag = False: GoTo EXIT_FUNC
    
50.             End If
    
51.         Next
    
52.     Next
    
53.     J = 0: k = 0
    
54.     For i = 1 To 26
    
55.         Select Case aDeg(i)
    
56.         Case -1
    
57.             If J > 0 Then bFlag = False: GoTo EXIT_FUNC
    
58.             J = i
    
59.         Case 1
    
60.             If k > 0 Then bFlag = False: GoTo EXIT_FUNC
    
61.             k = i
    
62.         Case Is <> 0
    
63.             bFlag = False: GoTo EXIT_FUNC
    
64.         End Select
    
65.     Next
    
66.     bFlag = (J = 0 And k = 0) Or (J > 0 And k > 0)
    
67. EXIT_FUNC:
    
68.     WordsLinkable = IIf(bFlag, "T", "F")
    
69.     Erase aDeg: Erase aEdg: Erase aVtx
    
70. End Function

复制代码

我这测试效果如下：

1. 答 题 人: Lee1892
   
2. 计算用时:  11.5
   
3. TTTFTFTFTTTTTFTFTFTTTTTFTFTFTTTTTFTFTFTTTTTFTFTFTTTTTFTFTFTTTTTFTFTFTTTTTFTFTFTTTTTFTFTFTTTTTFTFTFTT
   
4. 
   
5. 答 题 人: jsxjd_1
   
6. 计算用时:  10.28125
   
7. 答案正确: True
   
8. 
   
9. 答 题 人: jsxjd_2
   
10. 计算用时:  6.11328125
    
11. 答案正确: True
    
12. 
    
13. 答 题 人: wcymiss
    
14. 计算用时:  2.71484375
    
15. 答案正确: True

复制代码

liuguansky

吴姐好厉害。