From d66a9662df12f14e864afdea3e355c8e7213ee77 Mon Sep 17 00:00:00 2001 From: Rick Hennigan Date: Mon, 13 Jan 2025 12:49:46 -0500 Subject: [PATCH 1/7] Optimized reranking prompt to reduce output token counts --- Source/Chatbook/Handlers.wl | 18 ++ Source/Chatbook/LLMUtilities.wl | 18 +- .../PromptGenerators/RelatedDocumentation.wl | 220 ++++++++++++++++-- 3 files changed, 229 insertions(+), 27 deletions(-) diff --git a/Source/Chatbook/Handlers.wl b/Source/Chatbook/Handlers.wl index 3f9091bf..17e6bc70 100644 --- a/Source/Chatbook/Handlers.wl +++ b/Source/Chatbook/Handlers.wl @@ -27,6 +27,11 @@ addHandlerArguments // beginDefinition; addHandlerArguments[ args_ ] := addHandlerArguments[ $ChatHandlerData, Association @ args ]; +addHandlerArguments[ current_? AssociationQ, new_? AssociationQ ] /; AnyTrue[ new, AssociationQ ] := Enclose[ + $ChatHandlerData = ConfirmBy[ combineNestedHandlerData[ current, new ], AssociationQ, "AddHandlerArguments" ], + throwInternalFailure +]; + addHandlerArguments[ current_? AssociationQ, new_? AssociationQ ] := $ChatHandlerData = <| current, new |>; @@ -37,6 +42,19 @@ addHandlerArguments[ current_, new_? AssociationQ ] := ( addHandlerArguments // endDefinition; +(* ::**************************************************************************************************************:: *) +(* ::Subsubsection::Closed:: *) +(*combineNestedHandlerData*) +combineNestedHandlerData // beginDefinition; +combineNestedHandlerData[ as1_Association, as2_Association ] := combineNestedHandlerData0 @ { as1, as2 }; +combineNestedHandlerData // endDefinition; + +combineNestedHandlerData0 // beginDefinition; +combineNestedHandlerData0[ { as1_Association, as2_Association } ] := Merge[ { as1, as2 }, combineNestedHandlerData0 ]; +combineNestedHandlerData0[ { value_ } ] := value; +combineNestedHandlerData0[ { _, value_ } ] := value; +combineNestedHandlerData0 // endDefinition; + (* ::**************************************************************************************************************:: *) (* ::Subsection::Closed:: *) (*applyHandlerFunction*) diff --git a/Source/Chatbook/LLMUtilities.wl b/Source/Chatbook/LLMUtilities.wl index 291ffbab..558ea326 100644 --- a/Source/Chatbook/LLMUtilities.wl +++ b/Source/Chatbook/LLMUtilities.wl @@ -70,12 +70,16 @@ llmSynthesizeSubmit[ prompt: $$llmPrompt, callback_ ] := llmSynthesizeSubmit[ prompt, <| |>, callback ]; llmSynthesizeSubmit[ prompt0: $$llmPrompt, evaluator0_Association, callback_ ] := Enclose[ - Module[ { evaluator, prompt, messages, config, chunks, handlers, keys }, + Module[ { evaluator, prompt, messages, config, chunks, handlers, keys, auth }, - evaluator = ConfirmBy[ - <| $defaultLLMSynthesizeEvaluator, DeleteCases[ evaluator0, Automatic | _Missing ] |>, - AssociationQ, - "Evaluator" + evaluator = Replace[ + ConfirmBy[ + <| $defaultLLMSynthesizeEvaluator, DeleteCases[ evaluator0, Automatic | _Missing ] |>, + AssociationQ, + "Evaluator" + ], + Verbatim[ Verbatim ][ value_ ] :> value, + { 1 } ]; prompt = ConfirmMatch[ truncatePrompt[ prompt0, evaluator ], $$llmPrompt, "Prompt" ]; @@ -106,10 +110,12 @@ llmSynthesizeSubmit[ prompt0: $$llmPrompt, evaluator0_Association, callback_ ] : keys = { "BodyChunk", "BodyChunkProcessed", "StatusCode", "EventName" }; + auth = Lookup[ evaluator, "Authentication", $llmSynthesizeAuthentication ]; + setServiceCaller @ LLMServices`ChatSubmit[ messages, config, - Authentication -> $llmSynthesizeAuthentication, + Authentication -> auth, HandlerFunctions -> handlers, HandlerFunctionsKeys -> keys, "TestConnection" -> False diff --git a/Source/Chatbook/PromptGenerators/RelatedDocumentation.wl b/Source/Chatbook/PromptGenerators/RelatedDocumentation.wl index 970d1067..4c5f66af 100644 --- a/Source/Chatbook/PromptGenerators/RelatedDocumentation.wl +++ b/Source/Chatbook/PromptGenerators/RelatedDocumentation.wl @@ -22,7 +22,15 @@ $documentationSnippetsCacheDirectory := $documentationSnippetsCacheDirectory = $resourceSnippetsCacheDirectory := $resourceSnippetsCacheDirectory = ChatbookFilesDirectory @ { "DocumentationSnippets", "ResourceSystem" }; -$rerankMethod := CurrentChatSettings[ "DocumentationRerankMethod" ]; +$rerankMethod := $rerankMethod = CurrentChatSettings[ "DocumentationRerankMethod" ]; + +$rerankScoreThreshold = 3; + +$bestDocumentationPromptMethod := $bestDocumentationPromptMethod = CurrentChatSettings[ "RerankPromptStyle" ]; +$bestDocumentationPrompt := If[ $bestDocumentationPromptMethod === "JSON", + $bestDocumentationPromptLarge, + $bestDocumentationPromptSmall + ]; $defaultSources = { "DataRepository", "Documentation", "FunctionRepository" }; @@ -54,11 +62,12 @@ $RelatedDocumentationSources := $defaultSources; (*RelatedDocumentation*) RelatedDocumentation // beginDefinition; RelatedDocumentation // Options = { - "FilteredCount" -> Automatic, - "FilterResults" -> Automatic, - "MaxItems" -> Automatic, - "RerankMethod" -> Automatic, - "Sources" :> $RelatedDocumentationSources + "FilteredCount" -> Automatic, + "FilterResults" -> Automatic, + "MaxItems" -> Automatic, + "RerankPromptStyle" -> Automatic, + "RerankMethod" -> Automatic, + "Sources" :> $RelatedDocumentationSources }; GeneralUtilities`SetUsage[ RelatedDocumentation, "\ @@ -172,7 +181,11 @@ RelatedDocumentation[ prompt_, "Prompt", n_Integer, opts: OptionsPattern[ ] ] := { $rerankMethod = Replace[ OptionValue[ "RerankMethod" ], - $$unspecified :> CurrentChatSettings[ "DocumentationRerankMethod" ] + $$unspecified :> $rerankMethod + ], + $bestDocumentationPromptMethod = Replace[ + OptionValue[ "RerankPromptStyle" ], + $$unspecified :> $bestDocumentationPromptMethod ], $RelatedDocumentationSources = getSources @ OptionValue[ "Sources" ] }, @@ -383,22 +396,26 @@ filterSnippets[ messages_, results0_List, True, filterCount_Integer? Positive ] response = StringTrim @ ConfirmBy[ LogChatTiming[ - llmSynthesize[ instructions, <| "StopTokens" -> "\"CasualChat\"" |> ], + llmSynthesize[ instructions, $filteringLLMConfig ], "WaitForFilterSnippetsTask" ] // withApproximateProgress[ 0.5 ], StringQ, "Response" ]; - $lastFilterInstructions = instructions; - $lastFilterResponse = response; - uriToSnippet = <| #Value -> #Snippet & /@ results |>; uris = ConfirmMatch[ Keys @ uriToSnippet, { ___String }, "URIs" ]; - selected = ConfirmMatch[ selectSnippetsFromJSON[ response, uris ], { ___String }, "Pages" ]; + selected = ConfirmMatch[ LogChatTiming @ selectSnippetsFromResponse[ response, uris ], { ___String }, "Pages" ]; pages = ConfirmMatch[ Lookup[ uriToSnippet, selected ], { ___String }, "Pages" ]; - addHandlerArguments[ "RelatedDocumentation" -> <| "Results" -> uris, "Filtered" -> selected |> ]; + addHandlerArguments[ + "RelatedDocumentation" -> <| + "Results" -> uris, + "Filtered" -> selected, + "Response" -> response, + "Instructions" -> instructions + |> + ]; pages ], @@ -410,7 +427,11 @@ filterSnippets // endDefinition; -$bestDocumentationPrompt = StringTemplate[ "\ +$filteringLLMConfig = <| "StopTokens" -> "CasualChat" |>; + + + +$bestDocumentationPromptLarge = StringTemplate[ "\ Your task is to read a chat transcript between a user and assistant, and then select any relevant Wolfram Language \ documentation snippets that could help the assistant answer the user's latest message. @@ -461,6 +482,50 @@ If there are no relevant pages, respond with []. +$bestDocumentationPromptSmall = StringTemplate[ "\ +Your task is to read a chat transcript and select relevant Wolfram Language documentation snippets to help answer the \ +user's latest message. + +On the first line of your response, write one of these assistant types: +Computational - For computational responses +Knowledge - For knowledge-based responses +CasualChat - For casual conversation + +Then on each subsequent line, write a score (1-5) and id pair, separated by a space: + + +Scoring guide: +1: Irrelevant/useless +2: Related but unnecessary +3: Helpful +4: Very relevant +5: Essential + + +Computational +4 Plus31258 +3 ArithmeticFunctions6736786 + + +Here is the chat transcript: + + +%%Transcript%% + + +Available documentation snippets: + + +%%Snippets%% + + +Choose up to %%FilteredCount%% most relevant snippets. Skip irrelevant or redundant ones. +If no relevant pages exist, output a single dash (-). +Respond only in the specified format and do not include any other text.\ +", Delimiters -> "%%" ]; + + + $documentationRerankPrompt = StringTemplate[ "\ Read the chat transcript between a user and assistant, and then give me the best Wolfram Language documentation \ snippet that could help the assistant answer the user's latest message. @@ -478,14 +543,14 @@ Here is the chat transcript: (* ::**************************************************************************************************************:: *) (* ::Subsubsection::Closed:: *) -(*selectSnippetsFromJSON*) -selectSnippetsFromJSON // beginDefinition; +(*selectSnippetsFromResponse*) +selectSnippetsFromResponse // beginDefinition; -selectSnippetsFromJSON[ response_String, uris_List ] := Enclose[ +selectSnippetsFromResponse[ response_String, uris_List ] /; $bestDocumentationPromptMethod === "JSON" := Enclose[ Catch @ Module[ { jsonString, jsonData, selected }, jsonString = ConfirmBy[ First[ StringCases[ response, Longest[ "{" ~~ __ ~~ "}" ], 1 ], None ], StringQ ]; jsonData = ConfirmBy[ Quiet @ Developer`ReadRawJSONString @ jsonString, AssociationQ ]; - selected = ConfirmMatch[ Select[ jsonData[ "Snippets" ], #[ "Score" ] >= 3 & ], { __ } ]; + selected = ConfirmMatch[ Select[ jsonData[ "Snippets" ], #[ "Score" ] >= $rerankScoreThreshold & ], { __ } ]; ConfirmMatch[ Intersection[ Cases[ selected, KeyValuePattern[ "URI" -> uri_String ] :> StringTrim @ uri ], uris ], { __String } @@ -494,22 +559,135 @@ selectSnippetsFromJSON[ response_String, uris_List ] := Enclose[ selectSnippetsFromString[ response, uris ] & ]; -selectSnippetsFromJSON // endDefinition; +selectSnippetsFromResponse[ response_String, uris_List ] := + selectSnippetsFromResponseSmall[ response, uris, uriToSnippetID /@ uris ]; + +selectSnippetsFromResponse // endDefinition; + +(* ::**************************************************************************************************************:: *) +(* ::Subsubsection::Closed:: *) +(*selectSnippetsFromResponseSmall*) +selectSnippetsFromResponseSmall // beginDefinition; + +selectSnippetsFromResponseSmall[ response_String, uris_List, ids_List ] := Enclose[ + Module[ { scored, selected, selectedIDs, selectedURIs }, + + scored = ConfirmMatch[ + StringCases[ + response, + StartOfLine ~~ s: NumberString ~~ Whitespace ~~ id: ids ~~ WhitespaceCharacter... ~~ EndOfLine :> + <| "Score" -> ToExpression @ s, "ID" -> snippetIDToURI @ id |> + ], + { __Association } + ]; + + selected = ReverseSortBy[ + ConfirmMatch[ + Select[ scored, #[ "Score" ] >= $rerankScoreThreshold & ], + { __Association } + ], + Lookup[ "Score" ] + ]; + + selectedIDs = ConfirmMatch[ Lookup[ selected, "ID" ], { __String }, "SelectedIDs" ]; + selectedURIs = ConfirmMatch[ snippetIDToURI /@ selectedIDs, { __String }, "SelectedURIs" ]; + ConfirmMatch[ Cases[ selectedURIs, Alternatives @@ uris ], { __String } ] + ], + snippetIDToURI /@ selectSnippetsFromString[ response, ids ] & +]; + +selectSnippetsFromResponseSmall // endDefinition; + +(* ::**************************************************************************************************************:: *) +(* ::Subsubsection::Closed:: *) +(*scoreSnippetLine*) +scoreSnippetLine // beginDefinition; + +scoreSnippetLine[ "Computational"|"Knowledge"|"CasualChat" ] := Nothing; + +scoreSnippetLine[ line_String ] := Enclose[ + Module[ { scoreString, id, score }, + { scoreString, id } = ConfirmMatch[ StringSplit[ line, Whitespace ], { _String, _String }, "Split" ]; + score = ToExpression @ ConfirmBy[ scoreString, StringMatchQ @ NumberString, "Score" ]; + <| "Score" -> score, "ID" -> id |> + ], + $Failed & +]; + +scoreSnippetLine // endDefinition; (* ::**************************************************************************************************************:: *) (* ::Subsubsection::Closed:: *) (*selectSnippetsFromString*) selectSnippetsFromString // beginDefinition; -selectSnippetsFromString[ response_String, uris: { ___String } ] := StringCases[ response, uris ]; +selectSnippetsFromString[ response_String, ids: { ___String } ] := StringCases[ response, ids ]; selectSnippetsFromString // endDefinition; (* ::**************************************************************************************************************:: *) (* ::Subsubsection::Closed:: *) (*snippetXML*) snippetXML // beginDefinition; -snippetXML[ snippet_String ] := "\n" <> snippet <> "\n"; + +snippetXML[ snippet_String ] := + snippetXML[ snippet, $bestDocumentationPromptMethod ]; + +snippetXML[ snippet_String, "JSON" ] := + "\n"<>snippet<>"\n"; + +snippetXML[ snippet_String, "Small" ] := snippetXML[ snippet, "Small" ] = Enclose[ + StringReplace[ + snippet, + StartOfString ~~ header: Except[ "\n" ].. ~~ "\n" ~~ uri: Except[ "\n" ].. ~~ "\n" ~~ rest__ ~~ EndOfString :> + StringJoin[ + "\n", + header, "\n", + rest, "\n" + ] + ], + throwInternalFailure +]; + +snippetXML[ snippet_String, other_ ] := + snippetXML[ snippet, "Small" ]; + snippetXML // endDefinition; +(* ::**************************************************************************************************************:: *) +(* ::Subsubsection::Closed:: *) +(*uriToSnippetID*) +uriToSnippetID // beginDefinition; + +uriToSnippetID[ uri_String ] := Enclose[ + Module[ { split, base, counter, id }, + split = Last @ ConfirmMatch[ StringSplit[ uri, "/" ], { __String }, "Split" ]; + base = First @ StringSplit[ split, "#" ]; + counter = ConfirmBy[ getSnippetIDCounter @ uri, IntegerQ, "Counter" ]; + id = base <> ToString @ counter; + snippetIDToURI[ id ] = uri; + uriToSnippetID[ uri ] = id + ], + throwInternalFailure +]; + +uriToSnippetID // endDefinition; + +(* ::**************************************************************************************************************:: *) +(* ::Subsubsection::Closed:: *) +(*snippetIDToURI*) +snippetIDToURI // beginDefinition; +(* This is defined for individual ids during evaluation of uriToSnippetID. *) +snippetIDToURI[ id_String ] := id; +snippetIDToURI // endDefinition; + +(* ::**************************************************************************************************************:: *) +(* ::Subsubsection::Closed:: *) +(*getSnippetIDCounter*) +getSnippetIDCounter // beginDefinition; +getSnippetIDCounter[ uri_String ] := getSnippetIDCounter[ uri ] = $snippetIDCounter++; +getSnippetIDCounter // endDefinition; + +$snippetIDCounter = 1; + (* ::**************************************************************************************************************:: *) (* ::Section::Closed:: *) (*Documentation Snippets*) From 2d7e39e8557833242415e3974fe733112d2f40ef Mon Sep 17 00:00:00 2001 From: Rick Hennigan Date: Mon, 13 Jan 2025 12:59:22 -0500 Subject: [PATCH 2/7] Process config for easier debugging --- Source/Chatbook/PromptGenerators/RelatedDocumentation.wl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Source/Chatbook/PromptGenerators/RelatedDocumentation.wl b/Source/Chatbook/PromptGenerators/RelatedDocumentation.wl index 4c5f66af..a0a48e72 100644 --- a/Source/Chatbook/PromptGenerators/RelatedDocumentation.wl +++ b/Source/Chatbook/PromptGenerators/RelatedDocumentation.wl @@ -396,7 +396,7 @@ filterSnippets[ messages_, results0_List, True, filterCount_Integer? Positive ] response = StringTrim @ ConfirmBy[ LogChatTiming[ - llmSynthesize[ instructions, $filteringLLMConfig ], + llmSynthesize[ instructions, Replace[ $filteringLLMConfig, Automatic -> Verbatim @ Automatic, { 1 } ] ], "WaitForFilterSnippetsTask" ] // withApproximateProgress[ 0.5 ], StringQ, From 0d74442ce72acc512445fc66860f016d9e2f2038 Mon Sep 17 00:00:00 2001 From: Rick Hennigan Date: Mon, 13 Jan 2025 14:09:24 -0500 Subject: [PATCH 3/7] Bugfix: Avoid prepending "User: " to single message inputs when generating embeddings --- .../PromptGenerators/EmbeddingContext.wl | 2 +- .../PromptGenerators/VectorDatabases.wl | 12 ++++++++++-- Source/Chatbook/Utils.wl | 18 +++++++++++++++--- 3 files changed, 26 insertions(+), 6 deletions(-) diff --git a/Source/Chatbook/PromptGenerators/EmbeddingContext.wl b/Source/Chatbook/PromptGenerators/EmbeddingContext.wl index 961e3dde..4539aec8 100644 --- a/Source/Chatbook/PromptGenerators/EmbeddingContext.wl +++ b/Source/Chatbook/PromptGenerators/EmbeddingContext.wl @@ -22,7 +22,7 @@ $smallContextStringLength = 8000; (*getSmallContextString*) getSmallContextString // beginDefinition; -getSmallContextString // Options = { "IncludeSystemMessage" -> False }; +getSmallContextString // Options = { "IncludeSystemMessage" -> False, "SingleMessageTemplate" -> Automatic }; getSmallContextString[ messages0: { ___Association }, opts: OptionsPattern[ ] ] := Enclose[ Catch @ Module[ { messages, string }, diff --git a/Source/Chatbook/PromptGenerators/VectorDatabases.wl b/Source/Chatbook/PromptGenerators/VectorDatabases.wl index 23ad958d..7468e988 100644 --- a/Source/Chatbook/PromptGenerators/VectorDatabases.wl +++ b/Source/Chatbook/PromptGenerators/VectorDatabases.wl @@ -718,10 +718,18 @@ vectorDBSearch[ dbName: $$dbName, messages0: { __Association }, prop: "Values"|" If[ messages === { }, Throw @ { } ]; - conversationString = ConfirmBy[ getSmallContextString @ messages, StringQ, "ConversationString" ]; + conversationString = ConfirmBy[ + getSmallContextString[ messages, "SingleMessageTemplate" -> StringTemplate[ "`Content`" ] ], + StringQ, + "ConversationString" + ]; lastMessageString = ConfirmBy[ - getSmallContextString[ { Last @ messages }, "IncludeSystemMessage" -> True ], + getSmallContextString[ + { Last @ messages }, + "IncludeSystemMessage" -> True, + "SingleMessageTemplate" -> StringTemplate[ "`Content`" ] + ], StringQ, "LastMessageString" ]; diff --git a/Source/Chatbook/Utils.wl b/Source/Chatbook/Utils.wl index ec00a992..338db582 100644 --- a/Source/Chatbook/Utils.wl +++ b/Source/Chatbook/Utils.wl @@ -51,7 +51,8 @@ messagesToString // Options = { "IncludeSystemMessage" -> False, "IncludeTemporaryMessages" -> False, "MessageDelimiter" -> $messageToStringDelimiter, - "MessageTemplate" -> $messageToStringTemplate + "MessageTemplate" -> $messageToStringTemplate, + "SingleMessageTemplate" -> Automatic }; messagesToString[ { }, opts: OptionsPattern[ ] ] := @@ -72,7 +73,15 @@ messagesToString[ messages0_, opts: OptionsPattern[ ] ] := Enclose[ If[ ! temporary, messages = DeleteCases[ messages, KeyValuePattern[ "Temporary" -> True ] ] ]; If[ messages === { }, Throw[ "" ] ]; - template = ConfirmMatch[ OptionValue[ "MessageTemplate" ], _String|_TemplateObject|None, "Template" ]; + template = ConfirmMatch[ + If[ Length @ messages === 1, + Replace[ OptionValue[ "SingleMessageTemplate" ], Automatic -> OptionValue[ "MessageTemplate" ] ], + OptionValue[ "MessageTemplate" ] + ], + _String|_TemplateObject|None, + "Template" + ]; + delimiter = ConfirmMatch[ OptionValue[ "MessageDelimiter" ], _String, "Delimiter" ]; reverted = ConfirmMatch[ @@ -82,7 +91,10 @@ messagesToString[ messages0_, opts: OptionsPattern[ ] ] := Enclose[ ]; strings = ConfirmMatch[ - If[ template === None, Lookup[ reverted, "Content" ], TemplateApply[ template, # ] & /@ reverted ], + If[ template === None, + Lookup[ reverted, "Content" ], + TemplateApply[ template, # ] & /@ reverted + ], { __String }, "Strings" ]; From 138b7663188c2aa9b44eecd3c8397452747b60d9 Mon Sep 17 00:00:00 2001 From: Rick Hennigan Date: Mon, 13 Jan 2025 14:10:03 -0500 Subject: [PATCH 4/7] Bugfix: Need to allow empty responses when starting with a stop token --- Source/Chatbook/LLMUtilities.wl | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/Source/Chatbook/LLMUtilities.wl b/Source/Chatbook/LLMUtilities.wl index 558ea326..9f8e64b5 100644 --- a/Source/Chatbook/LLMUtilities.wl +++ b/Source/Chatbook/LLMUtilities.wl @@ -34,7 +34,11 @@ llmSynthesize[ prompt: $$llmPrompt ] := llmSynthesize[ prompt, <| |> ]; llmSynthesize[ prompt: $$llmPrompt, evaluator_Association ] := Enclose[ - ConfirmMatch[ llmSynthesize0[ prompt, evaluator, 1 ], Except[ "", _String ], "Result" ], + ConfirmMatch[ + llmSynthesize0[ prompt, evaluator, 1 ], + If[ MatchQ[ Flatten @ { evaluator[ "StopTokens" ] }, { __String } ], _String, Except[ "", _String ] ], + "Result" + ], throwInternalFailure ]; @@ -70,7 +74,7 @@ llmSynthesizeSubmit[ prompt: $$llmPrompt, callback_ ] := llmSynthesizeSubmit[ prompt, <| |>, callback ]; llmSynthesizeSubmit[ prompt0: $$llmPrompt, evaluator0_Association, callback_ ] := Enclose[ - Module[ { evaluator, prompt, messages, config, chunks, handlers, keys, auth }, + Module[ { evaluator, prompt, messages, config, chunks, allowEmpty, handlers, keys, auth }, evaluator = Replace[ ConfirmBy[ @@ -87,6 +91,8 @@ llmSynthesizeSubmit[ prompt0: $$llmPrompt, evaluator0_Association, callback_ ] : config = LLMConfiguration @ evaluator; chunks = Internal`Bag[ ]; + allowEmpty = MatchQ[ Flatten @ { evaluator[ "StopTokens" ] }, { __String } ]; + handlers = <| "BodyChunkReceived" -> Function[ Internal`StuffBag[ chunks, # ] @@ -97,7 +103,7 @@ llmSynthesizeSubmit[ prompt0: $$llmPrompt, evaluator0_Association, callback_ ] : $lastSynthesizeSubmitLog = data; strings = extractBodyChunks @ data; Which[ - MatchQ[ strings, { __String } ], + MatchQ[ strings, { __String } ] || (allowEmpty && strings === { }), With[ { s = StringJoin @ strings }, callback[ s, #1 ] ], FailureQ @ strings, callback[ strings, #1 ], From 2442f7a1e764939c61cfdc1d4e93188491476b06 Mon Sep 17 00:00:00 2001 From: Rick Hennigan Date: Mon, 13 Jan 2025 14:11:58 -0500 Subject: [PATCH 5/7] Use consistent instructions for both prompt styles --- .../PromptGenerators/RelatedDocumentation.wl | 20 +++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/Source/Chatbook/PromptGenerators/RelatedDocumentation.wl b/Source/Chatbook/PromptGenerators/RelatedDocumentation.wl index a0a48e72..84b9013c 100644 --- a/Source/Chatbook/PromptGenerators/RelatedDocumentation.wl +++ b/Source/Chatbook/PromptGenerators/RelatedDocumentation.wl @@ -487,19 +487,19 @@ Your task is to read a chat transcript and select relevant Wolfram Language docu user's latest message. On the first line of your response, write one of these assistant types: -Computational - For computational responses -Knowledge - For knowledge-based responses -CasualChat - For casual conversation + \"Computational\": The user's message requires a computational response. + \"Knowledge\": The user's message requires a knowledge-based response. + \"CasualChat\": The user's message is casual and could be answered by a non-specialist. For example, simple greetings or general questions. Then on each subsequent line, write a score (1-5) and id pair, separated by a space: -Scoring guide: -1: Irrelevant/useless -2: Related but unnecessary -3: Helpful -4: Very relevant -5: Essential +Specify the score as any number from 1 to 5 for your chosen snippets using the following rubric: + 1: The snippet is completely irrelevant to the user's message or has no usefulness. + 2: The snippet is somewhat related, but the assistant could easily answer the user's message without it. + 3: The snippet is related and might help the assistant answer the user's message. + 4: The snippet is very relevant and would significantly help the assistant answer the user's message. + 5: It would be impossible for the assistant to answer the user's message correctly without this snippet. Computational @@ -520,7 +520,7 @@ Available documentation snippets: Choose up to %%FilteredCount%% most relevant snippets. Skip irrelevant or redundant ones. -If no relevant pages exist, output a single dash (-). +If no relevant pages exist, only respond with the assistant type. Respond only in the specified format and do not include any other text.\ ", Delimiters -> "%%" ]; From 59b42e3f83df24a68b389da0edda20a1308011ba Mon Sep 17 00:00:00 2001 From: Rick Hennigan Date: Mon, 13 Jan 2025 14:33:40 -0500 Subject: [PATCH 6/7] Allow overriding the LLM evaluator in `RelatedDocumentation` --- .../Chatbook/PromptGenerators/RelatedDocumentation.wl | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/Source/Chatbook/PromptGenerators/RelatedDocumentation.wl b/Source/Chatbook/PromptGenerators/RelatedDocumentation.wl index 84b9013c..b81fe085 100644 --- a/Source/Chatbook/PromptGenerators/RelatedDocumentation.wl +++ b/Source/Chatbook/PromptGenerators/RelatedDocumentation.wl @@ -44,6 +44,8 @@ $sourceAliases = <| $minUnfilteredItems = 20; $unfilteredItemsPerSource = 10; +$filteringLLMConfig = <| "StopTokens" -> { "CasualChat" } |>; + (* ::**************************************************************************************************************:: *) (* ::Section::Closed:: *) (*Messages*) @@ -64,6 +66,7 @@ RelatedDocumentation // beginDefinition; RelatedDocumentation // Options = { "FilteredCount" -> Automatic, "FilterResults" -> Automatic, + "LLMEvaluator" -> Automatic, "MaxItems" -> Automatic, "RerankPromptStyle" -> Automatic, "RerankMethod" -> Automatic, @@ -187,6 +190,10 @@ RelatedDocumentation[ prompt_, "Prompt", n_Integer, opts: OptionsPattern[ ] ] := OptionValue[ "RerankPromptStyle" ], $$unspecified :> $bestDocumentationPromptMethod ], + $filteringLLMConfig = Replace[ + OptionValue[ "LLMEvaluator" ], + $$unspecified :> $filteringLLMConfig + ], $RelatedDocumentationSources = getSources @ OptionValue[ "Sources" ] }, relatedDocumentationPrompt[ @@ -427,10 +434,6 @@ filterSnippets // endDefinition; -$filteringLLMConfig = <| "StopTokens" -> "CasualChat" |>; - - - $bestDocumentationPromptLarge = StringTemplate[ "\ Your task is to read a chat transcript between a user and assistant, and then select any relevant Wolfram Language \ documentation snippets that could help the assistant answer the user's latest message. From 86d33cb0abf71e4be45eebff1aadf5e40f70e734 Mon Sep 17 00:00:00 2001 From: Rick Hennigan Date: Mon, 13 Jan 2025 14:43:35 -0500 Subject: [PATCH 7/7] Added a regression test for the "User: " prefix issue --- Tests/RelatedDocumentation.wlt | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/Tests/RelatedDocumentation.wlt b/Tests/RelatedDocumentation.wlt index dfb98913..22c3daf7 100644 --- a/Tests/RelatedDocumentation.wlt +++ b/Tests/RelatedDocumentation.wlt @@ -157,3 +157,13 @@ VerificationTest[ SameTest -> MatchQ, TestID -> "RelatedDocumentation-Prompt-Selection-Count@@Tests/RelatedDocumentation.wlt:154,1-159,2" ] + +(* ::**************************************************************************************************************:: *) +(* ::Subsection::Closed:: *) +(*Regression Tests*) +VerificationTest[ + RelatedDocumentation[ { <| "Role" -> "User", "Content" -> "Hello" |> }, "Prompt", "FilterResults" -> False ], + _String? (StringFreeQ[ "$Username" ]), + SameTest -> MatchQ, + TestID -> "RelatedDocumentation-Regression-UserPrefix@@Tests/RelatedDocumentation.wlt:164,1-169,2" +] \ No newline at end of file