Выполнение кода в ядре v.5.2 из сеанса v.7.01 через MathLink

У меня есть Mathematica 7.01 и Mathematica 5.2, установленные на одном компьютере. Я хочу иметь возможность оценивать код в ядре v.5.2 из сеанса Mathematica 7.01. Я имею в виду, что при запуске стандартного сеанса 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 установлено как "Ядро Notebook" в v.7.01 FrontEnd. И, конечно, переменная solutionFrom5 должна быть установлена ​​на реальное решение, возвращаемое ядром v.5.2.

ОТВЕТЫ

Ответ 1

Вот работающая реализация того, что я хотел. Я добавил проверку мертвого соединения MathLink, предложенного Тоддом Гейли here. Теперь kernel5Evaluate работает надежно, даже если подчиненное ядро ​​было прекращено необычным способом. Я также значительно улучшил синтаксический анализ Message и добавил некоторые диагностические сообщения для kernel5Evaluate. Вот код:

$kern5Path = "C:\\Program Files\\Wolfram Research\\Mathematica\\5.2\\MathKernel.exe";

Clear[printMessage, printPrint, printPostScript]
printMessage[str_String] := 
  [email protected]
   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 = 
  [email protected]
    Cell[GraphicsData["PostScript", #], "Graphics", 
     CellLabel -> "(Kernel 5.2 PostScript)", ShowCellLabel -> True] &;
printPrint[str_String] := 
  [email protected]
   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[[email protected][packet, Hold[InputNamePacket[_]]], 
      Message[kernel5Evaluate::linkIsBusy]; Throw[$Failed]]];
    LinkWrite[link, Unevaluated[EnterExpressionPacket[expr]]];
    While[
     Check[[email protected]
       MatchQ[packet = LinkRead[link, Hold], 
        Hold[InputNamePacket[_]]], 
      Message[kernel5Evaluate::linkIsClosed]; Throw[$Failed]],
     Switch[packet,
      [email protected][_String], 
      AppendTo[postScript, [email protected]@packet],
      [email protected][_String], 
      AppendTo[postScript, [email protected]@packet]; 
      [email protected][postScript]; postScript = {},
      [email protected][__], ,
      [email protected][_String], 
      If[StringMatchQ[[email protected]@packet, 
        WordCharacter .. ~~ "::" ~~ WordCharacter .. ~~ ": " ~~ __], 
       printMessage[[email protected]@packet], 
       printPrint[[email protected]@packet]],
      [email protected][_], ,
      [email protected][_], 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[[email protected]%, 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[[email protected]%, DataRange -> MeshRange /. Last[%], 
 Contours -> 10, 
 Method -> {"Refinement" -> {"CellDecomposition" -> "Quad"}}]

Ответ 2

Вот реализация, основанная на коде Саймона. Это все еще требует улучшения. Единственная непонятная вещь для меня - как обрабатывать сообщения, сгенерированные в ядре 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[[email protected][packet = LinkRead[link], InputNamePacket[_]],
     Switch[packet,
      DisplayPacket[_], AppendTo[postScript, [email protected]],
      DisplayEndPacket[_], AppendTo[postScript, [email protected]]; 
      [email protected]
         Cell[GraphicsData["PostScript", #], "Output", 
          CellLabel -> "Kernel 5.2 PostScript ="] &@
       StringJoin[postScript]; postScript = {},
      TextPacket[_], 
      If[StringMatchQ[[email protected], 
        WordCharacter .. ~~ "::" ~~ WordCharacter .. ~~ ": " ~~ __], 
       [email protected]
        Cell[[email protected]
          RowBox[{StyleBox["Kernel 5.2 Message = ", 
             FontColor -> Blue], [email protected]}], "Message"], 
       [email protected]
        Cell[[email protected], "Output", CellLabel -> "Kernel 5.2 Print"]],
      OutputNamePacket[_], AppendTo[outputs, [email protected]];,
      ReturnExpressionPacket[_], AppendTo[outputs, [email protected]];,
      _, AppendTo[out, packet]
      ]
     ];
    If[Length[out] > 0, Print[out]];
    Which[
     (l = Length[outputs]) == 0, Null,
     l == 2, [email protected],
     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"];]

Кажется, он работает так, как ожидалось. Однако это может быть лучше...

Ответ 3

Здесь моя попытка того, что вы хотите,

Сначала я определяю 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]
  ]