2.12.3

Plain Craft Launcher 2/Modules/Minecraft/ModComp.vb

@@ -846,6 +846,11 @@ NoSubtitle:
         ''' </summary>
         Public SearchText As String = Nothing
         ''' <summary>
+        ''' 在进行中文搜索时，CurseForge 的替代搜索文本。
+        ''' 由于 CurseForge API 在有任意关键词未匹配的时候就不显示结果，所以不能使用与 Modrinth 相同的算法。
+        ''' </summary>
+        Public CurseForgeAltSearchText As String = Nothing
+        ''' <summary>
         ''' 允许的来源。
         ''' </summary>
         Public Source As CompSourceType = CompSourceType.Any
@@ -884,7 +889,7 @@ NoSubtitle:
             If Tag <> "" Then Address += "&categoryId=" & Tag.BeforeFirst("/")
             If ModLoader <> CompModLoaderType.Any Then Address += "&modLoaderType=" & CType(ModLoader, Integer)
             If Not String.IsNullOrEmpty(GameVersion) Then Address += "&gameVersion=" & GameVersion
-            If Not String.IsNullOrEmpty(SearchText) Then Address += "&searchFilter=" & Net.WebUtility.UrlEncode(SearchText)
+            If Not String.IsNullOrEmpty(If(CurseForgeAltSearchText, SearchText)) Then Address += "&searchFilter=" & Net.WebUtility.UrlEncode(If(CurseForgeAltSearchText, SearchText))
             If Storage.CurseForgeOffset > 0 Then Address += "&index=" & Storage.CurseForgeOffset
             Return Address
         End Function
@@ -995,62 +1000,86 @@ NoSubtitle:
             '构造搜索请求
             Dim SearchEntries As New List(Of SearchEntry(Of CompDatabaseEntry))
             For Each Entry In CompDatabase
-                If Entry.ChineseName.Contains("动态的树") Then Continue For '这玩意儿附属太多了
                 SearchEntries.Add(New SearchEntry(Of CompDatabaseEntry) With {
                     .Item = Entry,
-                    .SearchSource = New List(Of KeyValuePair(Of String, Double)) From {
-                        New KeyValuePair(Of String, Double)(Entry.ChineseName & If(Entry.CurseForgeSlug, "") & If(Entry.ModrinthSlug, ""), 1)
+                    .SearchSource = New List(Of SearchSource) From {
+                        New SearchSource(Entry.ChineseName.BeforeFirst(" (").Split({"/"c}, StringSplitOptions.RemoveEmptyEntries), 1), '部分 Mod 有别名
+                        New SearchSource(Entry.ChineseName.AfterFirst(" (") & If(Entry.CurseForgeSlug, "") & If(Entry.ModrinthSlug, ""), 0.5)
                     }
                 })
             Next
-            '获取搜索结果
-            Dim SearchResults = Search(SearchEntries, Request.SearchText, 3)
+            Dim SearchResults = Search(SearchEntries, Request.SearchText, 40, 0.2)
             If Not SearchResults.Any() Then Throw New Exception("无搜索结果，请尝试搜索英文名称")
-            Dim SearchResult As String = ""
-            For i = 0 To Math.Min(4, SearchResults.Count - 1) '就算全是准确的，也最多只要 5 个
-                If Not SearchResults(i).AbsoluteRight AndAlso i >= Math.Min(2, SearchResults.Count - 1) Then Exit For '把 3 个结果拼合以提高准确度
-                If SearchResults(i).Item.CurseForgeSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.CurseForgeSlug.Replace("-", " ").Replace("/", " ") & " "
-                If SearchResults(i).Item.ModrinthSlug IsNot Nothing Then SearchResult += SearchResults(i).Item.ModrinthSlug.Replace("-", " ").Replace("/", " ") & " "
-                SearchResult += SearchResults(i).Item.ChineseName.AfterLast(" (").TrimEnd(") ").BeforeFirst(" - ").
-                    Replace(":", "").Replace("(", "").Replace(")", "").ToLower.Replace("/", " ") & " "
+            '提取可能的英文名
+            Dim ExtractWords =
+            Function(Result As SearchEntry(Of CompDatabaseEntry)) As String()
+                Dim Word As String = ""
+                If Result.Item.CurseForgeSlug IsNot Nothing Then Word += Result.Item.CurseForgeSlug.Replace("-", " ").Replace("/", " ") & " "
+                If Result.Item.ModrinthSlug IsNot Nothing Then Word += Result.Item.ModrinthSlug.Replace("-", " ").Replace("/", " ") & " "
+                Word += Result.Item.ChineseName.AfterLast(" (").TrimEnd(") ").BeforeFirst(" - ").
+                                    Replace(":", "").Replace("(", "").Replace(")", "").ToLower.Replace("/", " ").Replace("-", " ")
+                Dim Words = Word.ToLower.Split(" ")
+                Words = Words.Select(Function(w) w.TrimStart("{[(").TrimEnd("}])")).Where(
+                Function(w)
+                    If w.Length <= 1 Then Return False '单字词
+                    If {"the", "of", "mod", "and"}.Contains(w) Then Return False '常见词
+                    If Val(w) > 0 Then Return False '数字
+                    If w.Split(" ").Count > 3 AndAlso w.Contains("ftb") Then Return False '神秘 FTB
+                    Return True
+                End Function).Distinct.ToArray
+                Return Words
+            End Function
+            Dim WordWeights As New Dictionary(Of String, Double) '各个单词及其出现的权重
+            For Each Result In SearchResults
+                For Each Word In ExtractWords(Result)
+                    Dim Similarity = If(Result.SearchSource.Any(Function(s) s.Aliases.Contains(Request.SearchText)), 100000, Result.Similarity) '完全匹配为 100000
+                    If Not WordWeights.ContainsKey(Word) Then WordWeights.Add(Word, 0)
+                    WordWeights(Word) += Similarity
+                Next
             Next
-            Log("[Comp] 中文搜索原始关键词：" & SearchResult, LogLevel.Developer)
-            '去除常见连接词
-            Dim RealFilter As String = ""
-            For Each Word In SearchResult.Split(" ")
-                If {"the", "of", "a", "mod", "and"}.Contains(Word.ToLowerInvariant) OrElse Val(Word) > 0 Then Continue For
-                If SearchResult.Split(" ").Count > 3 AndAlso {"ftb"}.Contains(Word.ToLower) Then Continue For
-                RealFilter += Word.TrimStart("{[(").TrimEnd("}])") & " "
-            Next
-            Request.SearchText = RealFilter
-            Log("[Comp] 中文搜索最终关键词：" & RealFilter, LogLevel.Developer)
+            If Not WordWeights.Any() Then Throw New Exception("无搜索结果，请尝试搜索英文名称")
+            '根据权重选取英文单词
+            Dim SortedWords = WordWeights.OrderByDescending(Function(w) w.Value).ToList
+            If SortedWords.First.Value >= 100000 Then '如果有完全匹配的，就只选完全匹配的
+                Request.SearchText = SortedWords.Where(Function(w) w.Value >= 100000).Select(Function(w) w.Key).Join(" ")
+            Else '否则，CurseForge 选第一个结果，Modrinth 选前 5 个单词
+                Request.SearchText = SortedWords.Take(5).Select(Function(w) w.Key).Join(" ")
+                Request.CurseForgeAltSearchText = ExtractWords(SearchResults.First).Join(" ")
+                Log("[Comp] 中文搜索基础关键词（CurseForge）：" & Request.CurseForgeAltSearchText, LogLevel.Developer)
+            End If
+            Log("[Comp] 中文搜索基础关键词：" & Request.SearchText, LogLevel.Developer)
         End If
 
-        '驼峰英文请求关键字处理
-        Dim SpacedKeywords = Request.SearchText.RegexReplace("([A-Z]+|[a-z]+?)(?=[A-Z]+[a-z]+[a-z ]*)", "$& ")
-        Dim ConnectedKeywords = Request.SearchText.Replace(" ", "")
-        Dim AllPossibleKeywords = (SpacedKeywords & " " & If(IsChineseSearch, Request.SearchText, ConnectedKeywords & " " & RawFilter)).ToLower
-
         '最终处理关键字：分割、去重
-        Dim RightKeywords As New List(Of String)
-        For Each Keyword In AllPossibleKeywords.Split(" ")
-            Keyword = Keyword.Trim("["c, "]"c)
-            If Keyword = "" Then Continue For
-            If {"forge", "fabric", "for", "mod", "quilt"}.Contains(Keyword) Then '#208
-                Log("[Comp] 已跳过搜索关键词：" & Keyword, LogLevel.Developer)
-                Continue For
+        Dim ProcessKeywords =
+        Sub(ByRef Text As String)
+            If Text Is Nothing Then Return
+            Text = Text.ToLowerInvariant
+            Dim Words As New List(Of String)
+            For Each Keyword In Text.Split(" ")
+                Keyword = Keyword.Trim("["c, "]"c)
+                If Keyword = "" Then Continue For
+                If {"forge", "fabric", "for", "mod", "quilt"}.Contains(Keyword) Then '#208
+                    Log("[Comp] 已跳过搜索关键词：" & Keyword, LogLevel.Developer)
+                    Continue For
+                End If
+                Words.Add(Keyword)
+            Next
+            If RawFilter.Length > 0 AndAlso Not Words.Any() Then
+                Text = RawFilter '全都被过滤掉了
+            Else
+                Text = Join(Words.Distinct.ToList, " ")
             End If
-            RightKeywords.Add(Keyword)
-        Next
-        If RawFilter.Length > 0 AndAlso Not RightKeywords.Any() Then
-            Request.SearchText = RawFilter '全都被过滤掉了
-        Else
-            Request.SearchText = Join(RightKeywords.Distinct.ToList, " ").ToLower
-        End If
+            '例外项：OptiForge、OptiFabric（拆词后因为包含 Forge/Fabric 导致无法搜到实际的 Mod）
+            If RawFilter.Replace(" ", "").ContainsF("optiforge", True) Then Text = "optiforge"
+            If RawFilter.Replace(" ", "").ContainsF("optifabric", True) Then Text = "optifabric"
+        End Sub
 
-        '例外项：OptiForge、OptiFabric（拆词后因为包含 Forge/Fabric 导致无法搜到实际的 Mod）
-        If RawFilter.Replace(" ", "").ContainsF("optiforge", True) Then Request.SearchText = "optiforge"
-        If RawFilter.Replace(" ", "").ContainsF("optifabric", True) Then Request.SearchText = "optifabric"
+        If Request.CurseForgeAltSearchText IsNot Nothing Then
+            ProcessKeywords(Request.CurseForgeAltSearchText)
+            Log("[Comp] 工程列表搜索最终文本（CurseForge）：" & Request.CurseForgeAltSearchText, LogLevel.Debug)
+        End If
+        ProcessKeywords(Request.SearchText)
         Log("[Comp] 工程列表搜索最终文本：" & Request.SearchText, LogLevel.Debug)
         Task.Progress = 0.1
 
@@ -1195,7 +1224,7 @@ Retry:
                                                   Not Storage.Results.Any(Function(b) r.IsLike(b))).ToList
         '加入列表
         RealResults.AddRange(RawResults)
-        Log($"[Comp] 去重、筛选后累计新增结果 {RealResults.Count} 个")
+        Log($"[Comp] 去重、筛选后累计新增结果 {RealResults.Count} 个（目前已有结果 {Storage.Results.Count} 个）")
 
 #End Region
 
@@ -1241,16 +1270,19 @@ Retry:
             For Each Result As CompProject In RealResults
                 Scores.Add(Result, If(Result.WikiId > 0, 0.2, 0) +
                            Math.Log10(Math.Max(Result.DownloadCount, 1) * GetDownloadCountMult(Result)) / 9)
-                Entry.Add(New SearchEntry(Of CompProject) With {.Item = Result, .SearchSource = New List(Of KeyValuePair(Of String, Double)) From {
-                          New KeyValuePair(Of String, Double)(If(IsChineseSearch, Result.TranslatedName, Result.RawName), 1),
-                          New KeyValuePair(Of String, Double)(Result.Description, 0.05)}})
+                Entry.Add(New SearchEntry(Of CompProject) With {.Item = Result, .SearchSource = New List(Of SearchSource) From {
+                    New SearchSource(If(IsChineseSearch, Result.TranslatedName, Result.RawName).Split({"/"c}, StringSplitOptions.RemoveEmptyEntries), 1),
+                    New SearchSource(Result.Description, 0.05)}})
             Next
             Dim SearchResult = Search(Entry, RawFilter, 101, -1)
             For Each OneResult In SearchResult
-                Scores(OneResult.Item) += OneResult.Similarity / SearchResult(0).Similarity '最高 1 分的相似度分
+                Scores(OneResult.Item) +=
+                    If(OneResult.AbsoluteRight, 10, OneResult.Similarity) /
+                    If(SearchResult.First.AbsoluteRight, 10, SearchResult.First.Similarity) '最高 1 分的相似度分
             Next
         End If
         '根据排序分得出结果并添加
+        If Task.IsAborted Then Throw New ThreadInterruptedException '#8246
         Storage.Results.AddRange(
             Scores.OrderByDescending(Function(s) s.Value).Select(Function(r) r.Key))
 
@@ -1430,7 +1462,10 @@ Retry:
                     End If
                     'GameVersions
                     Dim RawVersions As List(Of String) = Data("gameVersions").Select(Function(t) t.ToString.Trim.ToLower).ToList
-                    GameVersions = RawVersions.Where(Function(v) McVersion.IsFormatFit(v)).Select(Function(v) v.Replace("-snapshot", " 预览版")).ToList
+                    GameVersions = RawVersions.
+                        Where(Function(v) McVersion.IsFormatFit(v)).
+                        Select(Function(v) v.Replace("-snapshot", " 预览版")).
+                        Distinct.ToList
                     If GameVersions.Count > 1 Then
                         GameVersions = GameVersions.SortByComparison(AddressOf CompareVersionGE).ToList
                         If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} '整合包理应只 “支持” 一个版本
@@ -1492,7 +1527,8 @@ Retry:
                     'GameVersions
                     Dim RawVersions As List(Of String) = Data("game_versions").Select(Function(t) t.ToString.Trim.ToLower).ToList
                     GameVersions = RawVersions.Where(Function(v) v.Contains(".")).
-                                               Select(Function(v) If(v.Contains("-"), v.BeforeFirst("-") & " 预览版", If(v.StartsWithF("b1."), "远古版本", v))).ToList
+                                               Select(Function(v) If(v.Contains("-"), v.BeforeFirst("-") & " 预览版", If(v.StartsWithF("b1."), "远古版本", v))).
+                                               Distinct.ToList
                     If GameVersions.Count > 1 Then
                         GameVersions = GameVersions.SortByComparison(AddressOf CompareVersionGE).ToList
                         If Type = CompType.ModPack Then GameVersions = New List(Of String) From {GameVersions(0)} '整合包理应只 “支持” 一个版本
@@ -1648,7 +1684,7 @@ Retry:
                 Next
             Else
                 'Modrinth
-                ResultJsonArray = DlModRequest($"https://api.modrinth.com/v2/project/{ProjectId}/version")
+                ResultJsonArray = DlModRequest($"https://api.modrinth.com/v2/project/{ProjectId}/version?include_changelog=false")
             End If
             CompFilesCache(ProjectId) = ResultJsonArray.Select(Function(a) New CompFile(a, TargetProject.Type)).
                 Where(Function(a) a.Available).ToList.