diff --git a/PacletInfo.wl b/PacletInfo.wl index 96c4912b..4c060cdd 100644 --- a/PacletInfo.wl +++ b/PacletInfo.wl @@ -1,7 +1,7 @@ PacletObject[ <| "Name" -> "Wolfram/Chatbook", "PublisherID" -> "Wolfram", - "Version" -> "1.3.2", + "Version" -> "1.3.3", "WolframVersion" -> "13.3+", "Description" -> "Wolfram Notebooks + LLMs", "License" -> "MIT", diff --git a/Scripts/Common.wl b/Scripts/Common.wl index b2ad9cc8..60216f26 100644 --- a/Scripts/Common.wl +++ b/Scripts/Common.wl @@ -141,7 +141,7 @@ releaseID[ dir_ ] := FirstCase[ (* ::Subsection::Closed:: *) (*releaseURL*) releaseURL[ file_ ] := Enclose[ - Enclose @ Module[ { pac, repo, ver }, + Module[ { pac, repo, ver }, pac = PacletObject @ Flatten @ File @ file; repo = ConfirmBy[ Environment[ "GITHUB_REPOSITORY" ], StringQ ]; ver = ConfirmBy[ pac[ "Version" ], StringQ ]; diff --git a/Source/Chatbook/ChatMessages.wl b/Source/Chatbook/ChatMessages.wl index 0ec16383..886dccbe 100644 --- a/Source/Chatbook/ChatMessages.wl +++ b/Source/Chatbook/ChatMessages.wl @@ -17,6 +17,7 @@ Wolfram`Chatbook`CellToChatMessage; `constructMessages; `expandMultimodalString; `getTokenizer; +`getTokenizerName; `resizeMultimodalImage; Begin[ "`Private`" ]; @@ -70,6 +71,10 @@ $styleRoles = <| "ChatSystemInput" -> "System" |>; +$cachedTokenizerNames = { "chat-bison", "claude", "gpt-2", "gpt-3.5", "gpt-4-vision", "gpt-4" }; +$cachedTokenizers = <| |>; +$fallbackTokenizer = "gpt-2"; + (* ::**************************************************************************************************************:: *) (* ::Section::Closed:: *) (*CellToChatMessage*) @@ -1079,58 +1084,120 @@ argumentTokenToString // endDefinition; (* ::**************************************************************************************************************:: *) (* ::Section::Closed:: *) (*Tokenization*) -$tokenizer := gpt2Tokenizer; +$tokenizer := $gpt2Tokenizer; + +(* ::**************************************************************************************************************:: *) +(* ::Subsection::Closed:: *) +(*getTokenizerName*) +getTokenizerName // beginDefinition; + +getTokenizerName[ KeyValuePattern[ "TokenizerName"|"Tokenizer" -> name_String ] ] := + tokenizerName @ name; + +getTokenizerName[ KeyValuePattern[ "Tokenizer" -> Except[ $$unspecified ] ] ] := + "Custom"; + +getTokenizerName[ KeyValuePattern[ "Model" -> model_ ] ] := + With[ { name = tokenizerName @ toModelName @ model }, + If[ MemberQ[ $cachedTokenizerNames, name ], + name, + $fallbackTokenizer + ] + ]; + +getTokenizerName // endDefinition; (* ::**************************************************************************************************************:: *) (* ::Subsection::Closed:: *) (*getTokenizer*) getTokenizer // beginDefinition; getTokenizer[ KeyValuePattern[ "Tokenizer" -> tokenizer: Except[ $$unspecified ] ] ] := tokenizer; -getTokenizer[ KeyValuePattern[ "Model" -> model_ ] ] := getTokenizer @ model; -getTokenizer[ model_ ] := cachedTokenizer @ toModelName @ model; +getTokenizer[ KeyValuePattern[ "TokenizerName" -> name_String ] ] := cachedTokenizer @ name; +getTokenizer[ KeyValuePattern[ "Model" -> model_ ] ] := cachedTokenizer @ toModelName @ model; getTokenizer // endDefinition; (* ::**************************************************************************************************************:: *) (* ::Subsubsection::Closed:: *) (*cachedTokenizer*) cachedTokenizer // beginDefinition; -cachedTokenizer[ All ] := AssociationMap[ cachedTokenizer, $cachedTokenizerNames ]; -cachedTokenizer[ name_String ] := cachedTokenizer0 @ tokenizerName @ toModelName @ name; + +cachedTokenizer[ All ] := + AssociationMap[ cachedTokenizer, $cachedTokenizerNames ]; + +cachedTokenizer[ id_String ] := + With[ { tokenizer = $cachedTokenizers[ tokenizerName @ toModelName @ id ] }, + tokenizer /; ! MatchQ[ tokenizer, $$unspecified ] + ]; + +cachedTokenizer[ id_String ] := Enclose[ + Module[ { name, tokenizer }, + name = ConfirmBy[ tokenizerName @ toModelName @ id, StringQ, "Name" ]; + tokenizer = findTokenizer @ name; + If[ MissingQ @ tokenizer, + (* Fallback to the GPT-2 tokenizer: *) + tokenizer = ConfirmMatch[ $gpt2Tokenizer, Except[ $$unspecified ], "GPT2Tokenizer" ]; + If[ TrueQ @ Wolfram`ChatbookInternal`$BuildingMX, + tokenizer, (* Avoid caching fallback values into MX definitions *) + cacheTokenizer[ name, tokenizer ] + ], + cacheTokenizer[ name, ConfirmMatch[ tokenizer, Except[ $$unspecified ], "Tokenizer" ] ] + ] + ], + throwInternalFailure +]; + cachedTokenizer // endDefinition; +(* ::**************************************************************************************************************:: *) +(* ::Subsubsubsection::Closed:: *) +(*cacheTokenizer*) +cacheTokenizer // beginDefinition; -cachedTokenizer0 // beginDefinition; +cacheTokenizer[ name_String, tokenizer: Except[ $$unspecified ] ] := ( + $cachedTokenizerNames = Union[ $cachedTokenizerNames, { name } ]; + $cachedTokenizers[ name ] = tokenizer +); -cachedTokenizer0[ "chat-bison" ] = ToCharacterCode[ #, "UTF8" ] &; +cacheTokenizer // endDefinition; -cachedTokenizer0[ "gpt-4-vision" ] := - If[ graphicsQ[ # ], - gpt4ImageTokenizer[ # ], - cachedTokenizer[ "gpt-4" ][ # ] - ] &; +(* ::**************************************************************************************************************:: *) +(* ::Subsubsubsection::Closed:: *) +(*findTokenizer*) +findTokenizer // beginDefinition; -cachedTokenizer0[ model_String ] := Enclose[ +findTokenizer[ model_String ] := Enclose[ Quiet @ Module[ { name, tokenizer }, initTools[ ]; Quiet @ Needs[ "Wolfram`LLMFunctions`Utilities`Tokenization`" -> None ]; name = ConfirmBy[ tokens`FindTokenizer @ model, StringQ, "Name" ]; tokenizer = ConfirmMatch[ tokens`LLMTokenizer[ Method -> name ], Except[ _tokens`LLMTokenizer ], "Tokenizer" ]; ConfirmMatch[ tokenizer[ "test" ], _List, "TokenizerTest" ]; - cachedTokenizer0[ model ] = tokenizer + tokenizer ], - gpt2Tokenizer & + Missing[ "NotFound" ] & ]; -cachedTokenizer0 // endDefinition; +findTokenizer // endDefinition; + +(* ::**************************************************************************************************************:: *) +(* ::Subsubsubsection::Closed:: *) +(*Pre-cached small tokenizer functions*) +$cachedTokenizers[ "chat-bison" ] = ToCharacterCode[ #, "UTF8" ] &; +$cachedTokenizers[ "gpt-4-vision" ] = If[ graphicsQ[ # ], gpt4ImageTokenizer[ # ], cachedTokenizer[ "gpt-4" ][ # ] ] &; (* ::**************************************************************************************************************:: *) (* ::Subsubsection::Closed:: *) (*tokenizerName*) tokenizerName // beginDefinition; -tokenizerName[ name_String ] := SelectFirst[ $cachedTokenizerNames, StringContainsQ[ name, # ] &, name ]; -tokenizerName // endDefinition; -$cachedTokenizerNames = { "gpt-4-vision", "gpt-4", "gpt-3.5", "gpt-2", "claude-2", "claude-instant-1", "chat-bison" }; +tokenizerName[ name_String ] := + SelectFirst[ + ReverseSortBy[ $cachedTokenizerNames, StringLength ], + StringContainsQ[ name, #, IgnoreCase -> True ] &, + name + ]; + +tokenizerName // endDefinition; (* ::**************************************************************************************************************:: *) (* ::Subsection::Closed:: *) @@ -1182,13 +1249,19 @@ gpt4ImageTokenCount0 // endDefinition; (* ::**************************************************************************************************************:: *) (* ::Subsection::Closed:: *) (*Fallback Tokenizer*) -gpt2Tokenizer := gpt2Tokenizer = ResourceFunction[ "GPTTokenizer" ][ ]; +$gpt2Tokenizer := $gpt2Tokenizer = gpt2Tokenizer[ ]; + +(* https://resources.wolframcloud.com/FunctionRepository/resources/GPTTokenizer *) +importResourceFunction[ gpt2Tokenizer, "GPTTokenizer" ]; (* ::**************************************************************************************************************:: *) (* ::Section::Closed:: *) (*Package Footer*) If[ Wolfram`ChatbookInternal`$BuildingMX, cachedTokenizer[ All ]; + $gpt2Tokenizer; + (* This is only needed to generate $gpt2Tokenizer once, so it can be removed to reduce MX file size: *) + Remove[ "Wolfram`Chatbook`ResourceFunctions`GPTTokenizer`GPTTokenizer" ]; ]; (* :!CodeAnalysis::EndBlock:: *) diff --git a/Source/Chatbook/Formatting.wl b/Source/Chatbook/Formatting.wl index 80ab93fb..976171ad 100644 --- a/Source/Chatbook/Formatting.wl +++ b/Source/Chatbook/Formatting.wl @@ -1137,11 +1137,12 @@ inlineInteractiveCodeCell // beginDefinition; inlineInteractiveCodeCell[ display_, string_ ] /; $dynamicText := display; +(* TODO: make this switch dynamically depending on $cloudNotebooks (likely as a TemplateBox)*) inlineInteractiveCodeCell[ display_, string_ ] := inlineInteractiveCodeCell[ display, string, contentLanguage @ string ]; inlineInteractiveCodeCell[ display_, string_, lang_ ] /; $cloudNotebooks := - Mouseover[ display, Column @ { display, floatingButtonGrid[ string, lang ] } ]; + cloudInlineInteractiveCodeCell[ display, string, lang ]; inlineInteractiveCodeCell[ display_, string_, lang_ ] := DynamicModule[ { $CellContext`attached, $CellContext`cell }, @@ -1167,6 +1168,54 @@ inlineInteractiveCodeCell[ display_, string_, lang_ ] := inlineInteractiveCodeCell // endDefinition; +(* ::**************************************************************************************************************:: *) +(* ::Subsubsection::Closed:: *) +(*cloudInlineInteractiveCodeCell*) +cloudInlineInteractiveCodeCell // beginDefinition; + +cloudInlineInteractiveCodeCell[ display_, string_, lang_ ] := + Module[ { padded, buttons }, + + padded = Pane[ display, ImageSize -> { { 100, Automatic }, { 30, Automatic } } ]; + + buttons = Framed[ + floatingButtonGrid[ string, lang ], + Background -> White, + FrameMargins -> { { 1, 0 }, { 0, 1 } }, + FrameStyle -> White, + ImageMargins -> 1, + RoundingRadius -> 3 + ]; + + Mouseover[ + buttonOverlay[ padded, Invisible @ buttons ], + buttonOverlay[ padded, buttons ], + ContentPadding -> False, + FrameMargins -> 0, + ImageMargins -> 0, + ImageSize -> All + ] + ]; + +cloudInlineInteractiveCodeCell // endDefinition; + +(* ::**************************************************************************************************************:: *) +(* ::Subsubsection::Closed:: *) +(*buttonOverlay*) +buttonOverlay // beginDefinition; + +buttonOverlay[ a_, b_ ] := Overlay[ + { a, b }, + All, + 2, + Alignment -> { Left, Bottom }, + ContentPadding -> False, + FrameMargins -> 0, + ImageMargins -> 0 +]; + +buttonOverlay // endDefinition; + (* ::**************************************************************************************************************:: *) (* ::Subsection::Closed:: *) (*makeInlineCodeCell*) diff --git a/Source/Chatbook/Main.wl b/Source/Chatbook/Main.wl index f527f1a9..2a62801c 100644 --- a/Source/Chatbook/Main.wl +++ b/Source/Chatbook/Main.wl @@ -6,6 +6,7 @@ BeginPackage[ "Wolfram`Chatbook`" ]; (* ::**************************************************************************************************************:: *) (* ::Subsection::Closed:: *) (*Declare Symbols*) +`$AvailableTools; `$ChatHandlerData; `$ChatPost; `$ChatPre; diff --git a/Source/Chatbook/Prompting.wl b/Source/Chatbook/Prompting.wl index a01f488f..7b81f476 100644 --- a/Source/Chatbook/Prompting.wl +++ b/Source/Chatbook/Prompting.wl @@ -35,6 +35,10 @@ $basePromptOrder = { "Checkboxes", "CheckboxesIndeterminate", "ConversionFormatting", + "SpecialURI", + "SpecialURIAudio", + "SpecialURIVideo", + "SpecialURIDynamic", "VisibleUserInput", "TrivialCode", "Packages", @@ -51,6 +55,7 @@ $basePromptClasses = <| "Math" -> { "MathExpressions" }, "Formatting" -> { "CodeBlocks", "MathExpressions", "EscapedCharacters" }, "MessageConversion" -> { "ConversionLargeOutputs", "ConversionGraphics", "ConversionFormatting" }, + "SpecialURIs" -> { "SpecialURIAudio", "SpecialURIVideo", "SpecialURIDynamic" }, "All" -> $basePromptOrder |>; @@ -71,6 +76,10 @@ $basePromptDependencies = Append[ "GeneralInstructionsHeader" ] /@ <| "ConversionGraphics" -> { "MessageConversionHeader" }, "MarkdownImageBox" -> { "MessageConversionHeader" }, "ConversionFormatting" -> { "MessageConversionHeader" }, + "SpecialURI" -> { }, + "SpecialURIAudio" -> { "SpecialURI" }, + "SpecialURIVideo" -> { "SpecialURI" }, + "SpecialURIDynamic" -> { "SpecialURI" }, "VisibleUserInput" -> { }, "TrivialCode" -> { }, "WolframSymbolCapitalization" -> { }, @@ -159,6 +168,19 @@ $basePromptComponents[ "ConversionFormatting" ] = "\ ``Cell[TextData[{StyleBox[\"Styled\", FontSlant -> \"Italic\"], \" message\"}], \"ChatInput\"]`` \ becomes ``Styled message``."; +$basePromptComponents[ "SpecialURI" ] = "\ +* You will occasionally see markdown links with special URI schemes, e.g. ![label](scheme://content-id) that represent \ +interactive interface elements. You can use these in your responses to display the same elements to the user."; + +$basePromptComponents[ "SpecialURIAudio" ] = "\ + * ![label](audio://content-id) represents an interactive audio player."; + +$basePromptComponents[ "SpecialURIVideo" ] = "\ + * ![label](video://content-id) represents an interactive video player."; + +$basePromptComponents[ "SpecialURIDynamic" ] = "\ + * ![label](dynamic://content-id) represents an embedded dynamic UI."; + $basePromptComponents[ "VisibleUserInput" ] = "\ * The user can still see their input, so there's no need to repeat it in your response"; diff --git a/Source/Chatbook/Sandbox.wl b/Source/Chatbook/Sandbox.wl index b095a12a..954bc983 100644 --- a/Source/Chatbook/Sandbox.wl +++ b/Source/Chatbook/Sandbox.wl @@ -27,13 +27,19 @@ Needs[ "Wolfram`Chatbook`Utils`" ]; $SandboxKernel = None; $sandboxPingTimeout := toolOptionValue[ "WolframLanguageEvaluator", "PingTimeConstraint" ]; $sandboxEvaluationTimeout := toolOptionValue[ "WolframLanguageEvaluator", "EvaluationTimeConstraint" ]; - +$cloudEvaluatorLocation = "/Chatbook/Tools/WolframLanguageEvaluator/Evaluate"; +$cloudLineNumber = 1; (* Tests for expressions that lose their initialized status when sending over a link: *) $initializationTests = HoldComplete[ + AudioQ, + BoundaryMeshRegionQ, DateObjectQ, GraphQ, - SparseArrayQ + MeshRegionQ, + SparseArrayQ, + TreeQ, + VideoQ ]; @@ -231,9 +237,10 @@ sandboxEvaluate // beginDefinition; sandboxEvaluate[ KeyValuePattern[ "code" -> code_ ] ] := sandboxEvaluate @ code; sandboxEvaluate[ code_String ] := sandboxEvaluate @ toSandboxExpression @ code; sandboxEvaluate[ HoldComplete[ xs__, x_ ] ] := sandboxEvaluate @ HoldComplete @ CompoundExpression[ xs, x ]; +sandboxEvaluate[ HoldComplete[ evaluation_ ] ] /; $CloudEvaluation := cloudSandboxEvaluate @ HoldComplete @ evaluation; sandboxEvaluate[ HoldComplete[ evaluation_ ] ] := Enclose[ - Module[ { kernel, null, packets, $timedOut, results, flat, initialized }, + Module[ { kernel, null, packets, $sandboxTag, $timedOut, results, flat, initialized }, $lastSandboxEvaluation = HoldComplete @ evaluation; @@ -241,16 +248,27 @@ sandboxEvaluate[ HoldComplete[ evaluation_ ] ] := Enclose[ ConfirmMatch[ linkWriteEvaluation[ kernel, evaluation ], Null, "LinkWriteEvaluation" ]; - { null, { packets } } = Reap[ - TimeConstrained[ - While[ ! MatchQ[ Sow @ LinkRead @ kernel, _ReturnExpressionPacket ] ], - 2 * $sandboxEvaluationTimeout, - $timedOut - ] + { null, { packets } } = ConfirmMatch[ + Reap[ + Sow[ Nothing, $sandboxTag ]; + TimeConstrained[ + While[ ! MatchQ[ Sow[ LinkRead @ kernel, $sandboxTag ], _ReturnExpressionPacket ] ], + 2 * $sandboxEvaluationTimeout, + $timedOut + ], + $sandboxTag + ], + { _, { _List } }, + "LinkRead" ]; If[ null === $timedOut, - AppendTo[ packets, ReturnExpressionPacket @ HoldComplete @ $TimedOut ] + AppendTo[ + packets, + With[ { fail = timeConstraintFailure @ $sandboxEvaluationTimeout }, + ReturnExpressionPacket @ HoldComplete @ fail + ] + ] ]; results = Cases[ packets, ReturnExpressionPacket[ expr_ ] :> expr ]; @@ -272,6 +290,138 @@ sandboxEvaluate[ HoldComplete[ evaluation_ ] ] := Enclose[ sandboxEvaluate // endDefinition; +(* ::**************************************************************************************************************:: *) +(* ::Subsubsection::Closed:: *) +(*cloudSandboxEvaluate*) +cloudSandboxEvaluate // beginDefinition; + +cloudSandboxEvaluate[ HoldComplete[ evaluation_ ] ] := Enclose[ + Catch @ Module[ { api, held, wxf, response, result, packets, initialized }, + + $lastSandboxEvaluation = HoldComplete @ evaluation; + + api = ConfirmMatch[ getCloudEvaluatorAPI[ ], _CloudObject|_Failure, "CloudEvaluator" ]; + If[ FailureQ @ api, Throw @ api ]; + held = ConfirmMatch[ makeCloudEvaluation @ evaluation, HoldComplete[ _ ], "Evaluation" ]; + wxf = ConfirmBy[ BinarySerialize[ held, PerformanceGoal -> "Size" ], ByteArrayQ, "WXF" ]; + + response = ConfirmMatch[ + URLExecute[ + api, + { "Evaluation" -> BaseEncode @ wxf, "TimeConstraint" -> $sandboxEvaluationTimeout }, + "WXF" + ], + KeyValuePattern[ (Rule|RuleDelayed)[ "Result", _HoldComplete ] ] | _Failure, + "Response" + ]; + + If[ FailureQ @ response, Throw @ response ]; + + result = ConfirmMatch[ Lookup[ response, "Result" ], _HoldComplete, "Result" ]; + packets = { }; (* TODO: create packets from messages and print outputs *) + initialized = initializeExpressions @ result; + + $lastSandboxResult = <| + "String" -> sandboxResultString[ initialized, packets ], + "Result" -> sandboxResult @ initialized, + "Packets" -> packets + |> + ], + throwInternalFailure +]; + +cloudSandboxEvaluate // endDefinition; + +(* ::**************************************************************************************************************:: *) +(* ::Subsubsection::Closed:: *) +(*makeCloudEvaluation*) +makeCloudEvaluation // beginDefinition; +makeCloudEvaluation // Attributes = { HoldAllComplete }; + +makeCloudEvaluation[ evaluation_ ] := + With[ { line = $cloudLineNumber++ }, + makeLinkWriteEvaluation[ $Line = line; evaluation ] + ]; + +makeCloudEvaluation // endDefinition; + +(* ::**************************************************************************************************************:: *) +(* ::Subsubsection::Closed:: *) +(*getCloudEvaluatorAPI*) +getCloudEvaluatorAPI // beginDefinition; + +getCloudEvaluatorAPI[ ] := + getCloudEvaluatorAPI @ CloudObject @ $cloudEvaluatorLocation; + +getCloudEvaluatorAPI[ target_CloudObject ] := + Module[ { deployed }, + deployed = deployCloudEvaluator @ target; + If[ validCloudEvaluatorQ @ deployed, + getCloudEvaluatorAPI[ ] = deployed, + getCloudEvaluatorAPI[ ] = Failure[ + "CloudEvaluatorUnavailable", + <| + "MessageTemplate" -> "No cloud evaluator available.", + "MessageParameters" -> { } + |> + ] + ] + ]; + +getCloudEvaluatorAPI // endDefinition; + +(* ::**************************************************************************************************************:: *) +(* ::Subsubsubsection::Closed:: *) +(*validCloudEvaluatorQ*) +validCloudEvaluatorQ // beginDefinition; + +validCloudEvaluatorQ[ obj_CloudObject ] := MatchQ[ + URLExecute[ obj, { "Evaluation" -> BaseEncode @ BinarySerialize @ HoldComplete[ 1 + 1 ] }, "WXF" ], + KeyValuePattern[ (Rule|RuleDelayed)[ "Result", HoldComplete[ 2 ] ] ] +]; + +validCloudEvaluatorQ // endDefinition; + +(* ::**************************************************************************************************************:: *) +(* ::Subsubsubsection::Closed:: *) +(*deployCloudEvaluator*) +deployCloudEvaluator // beginDefinition; + +deployCloudEvaluator[ target_CloudObject ] := With[ { messages = $messageOverrides }, + CloudDeploy[ + APIFunction[ + { "Evaluation" -> "String", "TimeConstraint" -> "Number" -> $sandboxEvaluationTimeout }, + Function[ + ReleaseHold @ messages; + BinarySerialize[ + EvaluationData[ + HoldComplete @@ { + TimeConstrained[ + BinaryDeserialize[ BaseDecode[ #Evaluation ], ReleaseHold ], + #TimeConstraint, + Failure[ + "EvaluationTimeExceeded", + <| + "MessageTemplate" -> "Evaluation exceeded the `1` second time limit.", + "MessageParameters" -> { #TimeConstraint } + |> + ] + ] + } + ], + PerformanceGoal -> "Size" + ] + ], + "Binary" + ], + target, + EvaluationPrivileges -> None, + Permissions -> "Private" + ] +]; + +deployCloudEvaluator // endDefinition; + (* ::**************************************************************************************************************:: *) (* ::Subsubsection::Closed:: *) (*initializeExpressions*) @@ -282,6 +432,9 @@ initializeExpressions[ flat: HoldComplete @ Association @ OrderlessPatternSequen ReplacePart[ flat, Thread[ pos -> Extract[ flat, pos ] ] ] ]; +initializeExpressions[ failed: HoldComplete[ _Failure ] ] := + failed; + initializeExpressions // endDefinition; (* ::**************************************************************************************************************:: *) @@ -522,6 +675,14 @@ sandboxResultString[ HoldComplete[ ] ] := "Null"; sandboxResultString // endDefinition; +(* ::**************************************************************************************************************:: *) +(* ::Subsubsection::Closed:: *) +(*initializedQ*) +initializedQ // beginDefinition; +initializedQ // Attributes = { HoldAllComplete }; +initializedQ[ expr_ ] := $initializationTest @ Unevaluated @ expr; +initializedQ // endDefinition; + (* ::**************************************************************************************************************:: *) (* ::Subsubsection::Closed:: *) (*simpleResultQ*) @@ -535,7 +696,7 @@ simpleResultQ // endDefinition; (*fancyResultQ*) fancyResultQ // beginDefinition; fancyResultQ // Attributes = { HoldAllComplete }; -fancyResultQ[ _Manipulate|_DynamicModule ] := True; +fancyResultQ[ _Manipulate|_DynamicModule|_Video|_Audio|_Tree ] := True; fancyResultQ[ gfx_ ] := graphicsQ @ Unevaluated @ gfx; fancyResultQ // endDefinition; diff --git a/Source/Chatbook/SendChat.wl b/Source/Chatbook/SendChat.wl index 3eef60e9..85402828 100644 --- a/Source/Chatbook/SendChat.wl +++ b/Source/Chatbook/SendChat.wl @@ -1212,7 +1212,14 @@ resolveAutoSettings[ settings_Association ] := resolveAutoSettings0 @ <| settings, "HandlerFunctions" -> getHandlerFunctions @ settings, "LLMEvaluator" -> getLLMEvaluator @ settings, - "ProcessingFunctions" -> getProcessingFunctions @ settings + "ProcessingFunctions" -> getProcessingFunctions @ settings, + If[ StringQ @ settings[ "Tokenizer" ], + <| + "TokenizerName" -> getTokenizerName @ settings, + "Tokenizer" -> Automatic + |>, + "TokenizerName" -> Automatic + ] |>; resolveAutoSettings // endDefinition; @@ -1253,6 +1260,7 @@ resolveAutoSetting0[ as_, "NotebookWriteMethod" ] := "PreemptiveLink"; resolveAutoSetting0[ as_, "ShowMinimized" ] := Automatic; resolveAutoSetting0[ as_, "StreamingOutputMethod" ] := "PartialDynamic"; resolveAutoSetting0[ as_, "Tokenizer" ] := getTokenizer @ as; +resolveAutoSetting0[ as_, "TokenizerName" ] := getTokenizerName @ as; resolveAutoSetting0[ as_, "ToolCallFrequency" ] := Automatic; resolveAutoSetting0[ as_, "ToolsEnabled" ] := toolsEnabledQ @ as; resolveAutoSetting0[ as_, "TrackScrollingWhenPlaced" ] := scrollOutputQ @ as; @@ -1267,7 +1275,8 @@ $autoSettingKeyDependencies = <| "MaxOutputCellStringLength" -> "MaxCellStringLength", "MaxTokens" -> "Model", "Multimodal" -> { "EnableLLMServices", "Model" }, - "Tokenizer" -> "Model", + "Tokenizer" -> "TokenizerName", + "TokenizerName" -> "Model", "Tools" -> { "LLMEvaluator", "ToolsEnabled" }, "ToolsEnabled" -> { "Model", "ToolCallFrequency" } |>; @@ -2201,7 +2210,7 @@ makeCompactChatData[ BaseEncode @ BinarySerialize[ DeleteCases[ Association[ - smallSettings @ KeyDrop[ as, "OpenAIKey" ], + smallSettings @ as, "MessageTag" -> tag, "Data" -> Association[ data, @@ -2219,20 +2228,27 @@ makeCompactChatData // endDefinition; (* ::Subsubsection::Closed:: *) (*smallSettings*) smallSettings // beginDefinition; +smallSettings[ as_Association ] := smallSettings0 @ KeyDrop[ as, { "OpenAIKey", "Tokenizer" } ] /. $exprToNameRules; +smallSettings // endDefinition; -smallSettings[ as_Association ] := - smallSettings[ as, as[ "LLMEvaluator" ] ]; +smallSettings0 // beginDefinition; -smallSettings[ as_, KeyValuePattern[ "LLMEvaluatorName" -> name_String ] ] := +smallSettings0[ as_Association ] := + smallSettings0[ as, as[ "LLMEvaluator" ] ]; + +smallSettings0[ as_, KeyValuePattern[ "LLMEvaluatorName" -> name_String ] ] := If[ AssociationQ @ GetCachedPersonaData @ name, Append[ as, "LLMEvaluator" -> name ], as ]; -smallSettings[ as_, _ ] := +smallSettings0[ as_, _ ] := as; -smallSettings // endDefinition; +smallSettings0 // endDefinition; + + +$exprToNameRules := AssociationMap[ Reverse, $AvailableTools ]; (* ::**************************************************************************************************************:: *) (* ::Subsubsection::Closed:: *) diff --git a/Source/Chatbook/Serialization.wl b/Source/Chatbook/Serialization.wl index 179b2d85..b6d71e80 100644 --- a/Source/Chatbook/Serialization.wl +++ b/Source/Chatbook/Serialization.wl @@ -79,7 +79,7 @@ $defaultWindowWidth = 625; $maxMarkdownBoxes = 5; (* Whether to generate a transcript and preview images for Video[...] expressions: *) -$serializeVideo = False; +$generateVideoPrompt = False; (* Whether to collect data that can help discover missing definitions *) $CellToStringDebug = False; @@ -666,17 +666,27 @@ rasterizeGraphics // endDefinition; (* ::**************************************************************************************************************:: *) (* ::Subsubsubsection::Closed:: *) (*Video*) -fasterCellToString0[ box: TemplateBox[ _, "VideoBox2", ___ ] ] /; $multimodalMessages && $serializeVideo := - With[ { video = ToExpression[ box, StandardForm ] }, - serializeVideo @ video /; VideoQ @ video - ]; +fasterCellToString0[ box: TemplateBox[ _, "VideoBox2", ___ ] ] /; $multimodalMessages && $generateVideoPrompt := + generateVideoPrompt @ box; + +fasterCellToString0[ box: TemplateBox[ _, "VideoBox2", ___ ] ] := + serializeVideo @ box; (* ::**************************************************************************************************************:: *) (* ::Subsubsubsubsection::Closed:: *) -(*serializeVideo*) -serializeVideo // beginDefinition; +(*generateVideoPrompt*) +generateVideoPrompt // beginDefinition; + +generateVideoPrompt[ box: TemplateBox[ _, "VideoBox2", ___ ] ] := generateVideoPrompt[ box ] = + With[ { video = Quiet @ ToExpression[ box, StandardForm ] }, + If[ VideoQ @ video, + generateVideoPrompt @ video, + "\\!\\(\\*VideoBox[...]\\)" + ] + ]; + -serializeVideo[ video_? VideoQ ] := Enclose[ +generateVideoPrompt[ video_? VideoQ ] := Enclose[ Module[ { small, audio, transcript, w, h, t, d, frames, preview }, small = ConfirmBy[ ImageResize[ video, { UpTo[ 150 ], UpTo[ 150 ] } ], VideoQ, "Resize" ]; @@ -690,18 +700,59 @@ serializeVideo[ video_? VideoQ ] := Enclose[ frames = ConfirmMatch[ VideoExtractFrames[ small, t ], { __Image }, "Frames" ]; preview = ToBoxes @ ConfirmBy[ ImageAssemble[ Partition[ frames, w ], Spacings -> 3 ], ImageQ, "Assemble" ]; - serializeVideo[ video ] = StringJoin[ + StringJoin[ "VIDEO TRANSCRIPT\n-----\n", transcript, "\n\nVIDEO PREVIEW\n-----\n", ConfirmBy[ toMarkdownImageBox @ preview, StringQ, "Preview" ] ] ], - throwInternalFailure[ serializeVideo @ video, ##1 ] & + throwInternalFailure +]; + +generateVideoPrompt // endDefinition; + +(* ::**************************************************************************************************************:: *) +(* ::Subsubsubsubsection::Closed:: *) +(*serializeVideo*) +serializeVideo // beginDefinition; + +serializeVideo[ box: TemplateBox[ _, "VideoBox2", ___ ] ] := serializeVideo[ box ] = + serializeVideo[ box, Quiet @ ToExpression[ box, StandardForm ] ]; + +serializeVideo[ box_, video_ ] := Enclose[ + If[ VideoQ @ video, + "\\!\\(\\*VideoBox[\"" <> ConfirmBy[ MakeExpressionURI @ video, StringQ, "URI" ] <> "\"]\\)", + "\\!\\(\\*VideoBox[...]\\)" + ], + throwInternalFailure ]; serializeVideo // endDefinition; +(* ::**************************************************************************************************************:: *) +(* ::Subsubsubsection::Closed:: *) +(*Audio*) +fasterCellToString0[ box: TagBox[ _, _Audio`AudioBox, ___ ] ] := serializeAudio @ box; + +(* ::**************************************************************************************************************:: *) +(* ::Subsubsubsubsection::Closed:: *) +(*serializeAudio*) +serializeAudio // beginDefinition; + +serializeAudio[ box: TagBox[ content_, _Audio`AudioBox, ___ ] ] := serializeAudio[ box ] = + serializeAudio[ content, Quiet @ ToExpression[ box, StandardForm ] ]; + +serializeAudio[ content_, audio_ ] := Enclose[ + If[ AudioQ @ audio, + "\\!\\(\\*AudioBox[\"" <> ConfirmBy[ MakeExpressionURI @ audio, StringQ, "URI" ] <> "\"]\\)", + "\\!\\(\\*AudioBox[...]\\)" + ], + throwInternalFailure +]; + +serializeAudio // endDefinition; + (* ::**************************************************************************************************************:: *) (* ::Subsubsubsection::Closed:: *) (*Template Boxes*) @@ -993,6 +1044,9 @@ checkbox // endDefinition; (*Other*) fasterCellToString0[ Cell[ _, "ObjectNameTranslation", ___ ] ] := ""; +fasterCellToString0[ PaneSelectorBox[ { ___, False -> b_, ___ }, Dynamic[ CurrentValue[ "MouseOver" ], ___ ], ___ ] ] := + fasterCellToString0 @ b; + fasterCellToString0[ TagBox[ _, "MarkdownImage", ___, TaggingRules -> KeyValuePattern[ "CellToStringData" -> string_String ], ___ ] ] := string; @@ -1019,11 +1073,13 @@ fasterCellToString0[ cell: Cell[ a_, ___ ] ] := fasterCellToString0 @ a ]; -fasterCellToString0[ InterpretationBox[ _, expr_, ___ ] ] := +fasterCellToString0[ InterpretationBox[ _, expr_, ___ ] ] := Quiet[ With[ { held = replaceCellContext @ HoldComplete @ expr }, needsBasePrompt[ "WolframLanguage" ]; Replace[ held, HoldComplete[ e_ ] :> inputFormString @ Unevaluated @ e ] - ]; + ], + Rule::rhs +]; fasterCellToString0[ Cell[ TextData @ { _, _, text_String, _, Cell[ _, "ExampleCount", ___ ] }, ___ ] ] := fasterCellToString0 @ text; diff --git a/Source/Chatbook/Tools.wl b/Source/Chatbook/Tools.wl index 9549e080..57510426 100644 --- a/Source/Chatbook/Tools.wl +++ b/Source/Chatbook/Tools.wl @@ -113,7 +113,7 @@ $toolBox = <| |>; $toolEvaluationResults = <| |>; $toolOptions = <| |>; -$cloudUnsupportedTools = { "WolframLanguageEvaluator", "DocumentationSearcher" }; +$cloudUnsupportedTools = { "DocumentationSearcher" }; $defaultToolOrder = { "DocumentationLookup", @@ -1591,11 +1591,11 @@ Basic Examples [system] Out[n]= Piecewise[...] -![Formatted Result](expression://result-{id}) +![Formatted Result](expression://content-{id}) [assistant] The half-order fractional derivative of $x^n$ with respect to $x$ is given by: -![Fractional Derivative](expression://result-{id}) +![Fractional Derivative](expression://content-{id}) "; (* ::**************************************************************************************************************:: *) @@ -1612,11 +1612,11 @@ Plot sin(x) from -5 to 5 ], " [system] -Out[n]= ![image](attachment://result-{id}) +Out[n]= ![image](attachment://content-{id}) [assistant] Here's the plot of $\\sin{x}$ from -5 to 5: -![Plot](attachment://result-{id})" +![Plot](attachment://content-{id})" ]; (* ::**************************************************************************************************************:: *) @@ -1645,7 +1645,8 @@ The temporary directory is located at C:\\Users\\UserName\\AppData\\Local\\Temp. (* ::**************************************************************************************************************:: *) (* ::Section::Closed:: *) (*Expression URIs*) -$$expressionScheme = "attachment"|"expression"; +$expressionSchemes = { "attachment", "audio", "dynamic", "expression", "video" }; +$$expressionScheme = Alternatives @@ $expressionSchemes; Chatbook::URIUnavailable = "The expression URI `1` is no longer available."; @@ -1813,7 +1814,7 @@ makeExpressionURI[ scheme_, Automatic, expr_ ] := makeExpressionURI[ scheme, expressionURILabel @ expr, Unevaluated @ expr ]; makeExpressionURI[ scheme_, label_, expr_ ] := - With[ { id = "result-" <> Hash[ Unevaluated @ expr, Automatic, "HexString" ] }, + With[ { id = "content-" <> Hash[ Unevaluated @ expr, Automatic, "HexString" ] }, $attachments[ id ] = HoldComplete @ expr; "![" <> TextString @ label <> "](" <> TextString @ scheme <> "://" <> id <> ")" ]; @@ -1825,9 +1826,31 @@ makeExpressionURI // endDefinition; (*expressionURILabel*) expressionURILabel // beginDefinition; expressionURILabel // Attributes = { HoldAllComplete }; -expressionURILabel[ _Graphics|_Graphics3D|_Image|_Image3D|_Legended|_RawBoxes ] := "image"; -expressionURILabel[ _List|_Association ] := "data"; -expressionURILabel[ _ ] := "result"; + +(* Audio *) +expressionURILabel[ Audio[ path_String, ___ ] ] := "Audio Player: " <> path; +expressionURILabel[ Audio[ File[ path_String ], ___ ] ] := "Audio Player: " <> path; +expressionURILabel[ _Audio ] := "Embedded Audio Player"; + +(* Video *) +expressionURILabel[ Video[ path_String, ___ ] ] := "Video Player: " <> path; +expressionURILabel[ Video[ File[ path_String ], ___ ] ] := "Video Player: " <> path; +expressionURILabel[ _Video ] := "Embedded Video Player"; + +(* Dynamic *) +expressionURILabel[ _Manipulate ] := "Embedded Interactive Content"; + +(* Graphics *) +expressionURILabel[ _Graph|_Graph3D ] := "Graph"; +expressionURILabel[ _Tree ] := "Tree"; +expressionURILabel[ _Graphics|_Graphics3D|_Image|_Image3D|_Legended|_RawBoxes ] := "Image"; + +(* Data *) +expressionURILabel[ _List|_Association ] := "Data"; + +(* Other *) +expressionURILabel[ _ ] := "Content"; + expressionURILabel // endDefinition; (* ::**************************************************************************************************************:: *) @@ -1835,7 +1858,10 @@ expressionURILabel // endDefinition; (*expressionURIScheme*) expressionURIScheme // beginDefinition; expressionURIScheme // Attributes = { HoldAllComplete }; -expressionURIScheme[ _Graphics|_Graphics3D|_Image|_Image3D|_Legended|_RawBoxes ] := "attachment"; +expressionURIScheme[ _Video ] := (needsBasePrompt[ "SpecialURIVideo" ]; "video"); +expressionURIScheme[ _Audio ] := (needsBasePrompt[ "SpecialURIAudio" ]; "audio"); +expressionURIScheme[ _Manipulate|_DynamicModule|_Dynamic ] := (needsBasePrompt[ "SpecialURIDynamic" ]; "dynamic"); +expressionURIScheme[ _Graph|_Graph3D|_Graphics|_Graphics3D|_Image|_Image3D|_Legended|_Tree|_RawBoxes ] := "attachment"; expressionURIScheme[ _ ] := "expression"; expressionURIScheme // endDefinition;