我在同一台机器上安装了 Mathematica 7.01和 Mathematica 5.2。我希望能够在 Mathematica 7.01会话中评估v.5.2内核中的代码。我的意思是运行 Mathematica 7.0.1标准会话我希望有一个像kernel5Evaluate
这样的命令来评估5.2内核中的一些代码并将结果返回到7.01内核并链接7.01 FrontEnd笔记本以这种方式在7.01内核中执行此代码。
例如(在标准 Mathematica v.7.01会话中):
In[1]:= solutionFrom5 = kernel5Evaluate[NDSolve[{(y^\[Prime])[x]==y[x],y[1]==2},y,{x,0,3}]]
Out[1]= {{y -> InterpolatingFunction[{{0., 3.}}, <>]}}
In[2]:= kernel5Evaluate[Plot3D[Sin[x y],{x,-Pi,Pi},{y,-Pi,Pi}]]
During evaluation of In[2]:= GraphicsData["PostScript", "\<\............
Out[2]= -SurfaceGraphics-
在这两种情况下,结果应该好像v.5.2内核在v.7.01 FrontEnd中设置为“Notebook's Kernel”。当然solutionFrom5
变量应该设置为v.5.2内核返回的实际解决方案。
答案 0 :(得分:4)
这是一个基于Simon代码的实现。它仍然需要改进。我不清楚的是如何处理slave(v.5.2)内核中生成的消息。
这是我的代码:
Clear[linkEvaluate]
SetAttributes[linkEvaluate, HoldRest]
linkEvaluate[link_LinkObject, expr_] := Catch[
Module[{out = {}, postScript = {}, packet, outputs = {}},
While[LinkReadyQ[link],
Print["From the buffer:\t", LinkRead[link]]];
LinkWrite[link, Unevaluated[EnterExpressionPacket[expr]]];
While[Not@MatchQ[packet = LinkRead[link], InputNamePacket[_]],
Switch[packet,
DisplayPacket[_], AppendTo[postScript, First@packet],
DisplayEndPacket[_], AppendTo[postScript, First@packet];
CellPrint@
Cell[GraphicsData["PostScript", #], "Output",
CellLabel -> "Kernel 5.2 PostScript ="] &@
StringJoin[postScript]; postScript = {},
TextPacket[_],
If[StringMatchQ[First@packet,
WordCharacter .. ~~ "::" ~~ WordCharacter .. ~~ ": " ~~ __],
CellPrint@
Cell[BoxData@
RowBox[{StyleBox["Kernel 5.2 Message = ",
FontColor -> Blue], First@packet}], "Message"],
CellPrint@
Cell[First@packet, "Output", CellLabel -> "Kernel 5.2 Print"]],
OutputNamePacket[_], AppendTo[outputs, First@packet];,
ReturnExpressionPacket[_], AppendTo[outputs, First@packet];,
_, AppendTo[out, packet]
]
];
If[Length[out] > 0, Print[out]];
Which[
(l = Length[outputs]) == 0, Null,
l == 2, Last@outputs,
True, multipleOutput[outputs]
]
]];
Clear[kernel5Evaluate]
SetAttributes[kernel5Evaluate, HoldAll]
kernel5Evaluate[expr_] :=
If[TrueQ[MemberQ[Links[], $kern5]], linkEvaluate[$kern5, expr],
Clear[$kern5]; $kern5 = LinkLaunch[
"C:\\Program Files\\Wolfram Research\\Mathematica\\5.2\\MathKernel.exe -mathlink"];
LinkRead[$kern5];
LinkWrite[$kern5,
Unevaluated[EnterExpressionPacket[$MessagePrePrint = InputForm;]]];
LinkRead[$kern5]; kernel5Evaluate[expr]]
以下是测试表达式:
plot = kernel5Evaluate[Plot3D[Sin[x y], {x, 0, Pi}, {y, 0, Pi}]]
plot = kernel5Evaluate[Plot[Sin[x], {x, 0, Pi}]; Plot[Sin[x], {x, -Pi, Pi}]] //
DeleteCases[#, HoldPattern[DefaultFont :> $DefaultFont], Infinity] &
s = kernel5Evaluate[
NDSolve[{y'[x] == y[x] Cos[x + y[x]], y[0] == 1}, y, {x, 0, 30}]]
s // InputForm // Short
kernel5Evaluate[1/0; Print["s"];]
它似乎按预期工作。然而,它可能会更好......
答案 1 :(得分:2)
这是我对你想要的尝试,
首先,我定义linkEvaluate
采用活跃的Link
并将其传递给表达式。
如果有LinkRead
的内容仍然可以阅读,那么它会读取它们直到没有更多内容。
然后它写出表达式并等待结果返回。
然后它读取输出,直到没有什么可读的。
通常情况下,它会返回第一个ReturnExpressionPacket
,除非您将最终的可选参数all
设置为True
- 在这种情况下,它会返回它读取的所有内容。
Clear[linkEvaluate]
SetAttributes[linkEvaluate, HoldRest]
linkEvaluate[link_LinkObject, expr_, all : (True | False) : False] :=
Catch[Module[{out = {}},
While[LinkReadyQ[link], PrintTemporary[LinkRead[link]]];
If[LinkReadyQ[link], Throw["huh"]];
LinkWrite[link, Unevaluated[EnterExpressionPacket[expr]]];
While[! LinkReadyQ[link], Pause[.1]];
While[LinkReadyQ[link], AppendTo[out, LinkRead[link]]];
If[all, out, Cases[out, _ReturnExpressionPacket][[1, 1]]]
]];
然后kernel5Evaluate
首先检查全局$kern5
是否定义为LinkObject
,如果没有,则定义它。然后它将工作简单地传递给linkEvaluate
。
您必须将“math5”替换为Mma 5.2内核的文件名和路径。
Clear[kernel5Evaluate]
SetAttributes[kernel5Evaluate, HoldAll]
kernel5Evaluate[expr_, all:(True|False):False] := If[TrueQ[MemberQ[Links[], $kern5]],
linkEvaluate[$kern5, expr, all],
Clear[$kern5]; $kern5 = LinkLaunch["math5 -mathlink"]; kernel5Evaluate[expr,all]
]
答案 2 :(得分:2)
这是我想要的工作实现。我根据Todd Gayley here
的建议添加了对MathLink
连接的检查。现在kernel5Evaluate
即使从属内核以异常方式终止也能正常工作。我还对Message
的解析进行了大量改进,并为kernel5Evaluate
添加了一些诊断消息。这是代码:
$kern5Path = "C:\\Program Files\\Wolfram Research\\Mathematica\\5.2\\MathKernel.exe";
Clear[printMessage, printPrint, printPostScript]
printMessage[str_String] :=
CellPrint@
Cell[BoxData[
RowBox[StringSplit[str,
x : ("MyDelimeterStart" | "MyDelimeterEnd") :> x] //. {x___,
"MyDelimeterStart", y_, "MyDelimeterEnd", z___} :> {x,
ToExpression[y], z}]], "Message",
CellLabel -> "(Kernel 5.2)", ShowCellLabel -> True];
printPostScript =
CellPrint@
Cell[GraphicsData["PostScript", #], "Graphics",
CellLabel -> "(Kernel 5.2 PostScript)", ShowCellLabel -> True] &;
printPrint[str_String] :=
CellPrint@
Cell[If[StringTake[str, -1] === "\n", StringDrop[str, -1], str],
"Print", CellLabel -> "(Kernel 5.2 print, text mode)",
ShowCellLabel -> True];
Clear[linkEvaluate]
SetAttributes[linkEvaluate, HoldAllComplete]
linkEvaluate[link_LinkObject, expr_] := Catch[
Module[{out = {}, postScript = {}, packet, result = Null},
If[LinkReadyQ[link],
While[LinkReadyQ[link],
Print["Rest of the buffer:\t",
packet = LinkRead[link, Hold]]];
If[Not@MatchQ[packet, Hold[InputNamePacket[_]]],
Message[kernel5Evaluate::linkIsBusy]; Throw[$Failed]]];
LinkWrite[link, Unevaluated[EnterExpressionPacket[expr]]];
While[
Check[Not@
MatchQ[packet = LinkRead[link, Hold],
Hold[InputNamePacket[_]]],
Message[kernel5Evaluate::linkIsClosed]; Throw[$Failed]],
Switch[packet,
Hold@DisplayPacket[_String],
AppendTo[postScript, First@First@packet],
Hold@DisplayEndPacket[_String],
AppendTo[postScript, First@First@packet];
printPostScript@StringJoin[postScript]; postScript = {},
Hold@MessagePacket[__], ,
Hold@TextPacket[_String],
If[StringMatchQ[First@First@packet,
WordCharacter .. ~~ "::" ~~ WordCharacter .. ~~ ": " ~~ __],
printMessage[First@First@packet],
printPrint[First@First@packet]],
Hold@OutputNamePacket[_], ,
Hold@ReturnExpressionPacket[_], result = First[First[packet]],
_, AppendTo[out, packet]
]
];
If[Length[out] > 0, Print["Unparsed packets: ", out]];
result
]];
Clear[kernel5Evaluate]
SetAttributes[kernel5Evaluate, HoldAllComplete]
kernel5Evaluate::usage = "kernel5Evaluate[\!\(\*
StyleBox[\"expr\",\nFontFamily->\"Times New Roman\",\n\
FontSlant->\"Italic\"]\)] writes \!\(\*
StyleBox[\"expr\",\nFontFamily->\"Times New Roman\",\n\
FontSlant->\"Italic\"]\) to MathKernel 5.2, returns output and prints \
messages generated during computation.";
kernel5Evaluate::linkIsBusy =
"Kernel 5.2 is still running previous calculation.";
kernel5Evaluate::linkIsClosed = "Connection to Kernel 5.2 is lost.";
kernel5Evaluate::kernel5NotFound =
"Path `1` not found. Please set variable $kern5Path to correct path \
to MathKernel 5.2.";
kernel5Evaluate[expr_] :=
If[TrueQ[MemberQ[Links[], $kern5]],
If[LinkReadyQ[$kern5]; First[LinkError[$kern5]] == 0,
With[{$kern5 = $kern5}, linkEvaluate[$kern5, expr]],
LinkClose[$kern5]; kernel5Evaluate[expr]],
Clear[$kern5];
If[FileExistsQ[$kern5Path],
$kern5 = LinkLaunch[$kern5Path <> " -mathlink -noinit"];
LinkRead[$kern5]; LinkWrite[$kern5,
Unevaluated[
EnterExpressionPacket[$MessagePrePrint = ("MyDelimeterStart" <>
ToString[ToBoxes[#]] <> "MyDelimeterEnd") &;
SetOptions[$Output, {PageWidth -> Infinity}];]]];
LinkRead[$kern5]; kernel5Evaluate[expr],
Message[kernel5Evaluate::kernel5NotFound, $kern5Path]; $Failed]
]
以下是一些测试表达式:
kernel5Evaluate[Unevaluated[2 + 2]]
kernel5Evaluate[$Version]
kernel5Evaluate[Quit[]]
kernel5Evaluate[Print["some string"];]
kernel5Evaluate[Sin[1,]]
kernel5Evaluate[1/0]
kernel5Evaluate[{Plot[Sin[x], {x, 0, Pi}],
Plot[Sin[x], {x, -Pi, Pi}]}] //
DeleteCases[#, HoldPattern[DefaultFont :> $DefaultFont], Infinity] &
kernel5Evaluate[Plot3D[Sin[x y], {x, 0, Pi}, {y, 0, Pi}]];
ListPlot3D[First@%, Mesh -> Full, DataRange -> MeshRange /. Last[%]]
s = kernel5Evaluate[
NDSolve[{y'[x] == y[x] Cos[x + y[x]], y[0] == 1}, y, {x, 0, 30}]]
% // InputForm // Short
kernel5Evaluate[ContourPlot[Sin[x y], {x, -5, 5}, {y, -5, 5}]];
ListContourPlot[First@%, DataRange -> MeshRange /. Last[%],
Contours -> 10,
Method -> {"Refinement" -> {"CellDecomposition" -> "Quad"}}]