Executing code in v.5.2 kernel from within v.7.01 session through MathLink

Question

I have Mathematica 7.01 and Mathematica 5.2 installed on the same machine. I wish to be able to evaluate code in the v.5.2 kernel from within Mathematica 7.01 session. I mean that running Mathematica 7.0.1 standard session I wish to have a command like kernel5Evaluate to evaluate some code in the 5.2 kernel and return the result into the 7.01 kernel and linked 7.01 FrontEnd notebook in such a way as this code would be executed in the 7.01 kernel.

For example (in the standard Mathematica v.7.01 session):

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-

In the both cases the result should be as if the v.5.2 kernel is set to be "Notebook's Kernel" in the v.7.01 FrontEnd. And of course solutionFrom5 variable should be set to the real solution returned by v.5.2 kernel.

Orchid

What you want is RunThrough, but it refuses to play nice with me... – Leola

@Leola I'm looking for a MathLink-solution. I wish to use v.5.2 kernel multiple times through kernel5Evaluate per session. – Orchid

I've never used MathLink before - but have been playing with it just now. It isn't as straightforward as I hoped it would be. – Leola

Answer 1

Here is working implementation of what I wanted. I have added checking for a dead MathLink connection as suggested by Todd Gayley here. Now kernel5Evaluate works reliable even if the slave kernel was terminated in unusual way. I also have much improved parsing of Messages and added some diagnostic messages for kernel5Evaluate. Here is the code:

$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]
  ]

And here are some test expressions:

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"}}]

Orchid

Answer 2

Here is an implementation based on Simon's code. It still requires improvement. The one unclear thing to me is how to handle Messages generated in the slave (v.5.2) kernel.

Here is my code:

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]]

Here are test expressions:

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"];]

It seems to work as expected. However it could be better...

Orchid

These types of things are always a little messy - but you're right, it does seem to work ok. +1 – Leola

@Leola I wonder is there a way to handle Messages more correctly? I'm forced to evaluate in the slave kernel $MessagePrePrint = InputForm; but I don't know how to expand HoldForm s in the generated strings. Try for example kernel5Evaluate[1/0;]. – Orchid

I have opened a separate question on this. – Orchid

Cool. Sorry I didn't reply, just a tad overrun with work at the moment! – Leola

Answer 3

Here's my attempt at what you want,

First I define linkEvaluate that takes an active Link and passes it an expression. If there's things for LinkRead still to read, then it reads them until there are no more. Then it writes the expression and waits for the results to come back. Then it reads the output until there's nothing left to read. Normally, it then returns the first ReturnExpressionPacket unless you have set the final, optional argument, all, to True - in which case it returns everything it read.

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]]]
    ]];

Then kernel5Evaluate first checks if the global $kern5 is defined as a LinkObject, if not then it defines it. It then simply passes the work over to linkEvaluate. You will have to replace "math5" with the filename and path of your Mma 5.2 kernel.

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]
  ]

Leola

There is a trouble with getting such things as InterpolatingFuntion object. I'm forced to use InputForm inside kernel5Evaluate but the output is very large: kernel5Evaluate[ InputForm@ NDSolve[{y'[x] == y[x] Cos[x + y[x]], y[0] == 1}, y, {x, 0, 30}]] – Orchid

@Alexey - I tested it with 7 and 8. Using 7 from within 8 is ok, but the other way around breaks. The docs say that InterpolatingFunction last changed in v3... so I don't know why it's not passing properly. Also, I didn't need InputForm to get it working when it did work. – Leola

@Alexey - Try just passing the Plot - that worked for me even when NDSolve failed. Plot[Evaluate[ y[x] /. NDSolve[{y'[x] == y[x] Cos[x + y[x]], y[0] == 1}, y, {x, 0, 30}]], {x, 0, 30}] – Leola

@Alexey - Maybe ask the WRI support crew about it. I think that it must be a problem of different data structures in the different versions. Since my code works fine when calling a kernel of the same version, I don't believe that the problem is on my end. – Leola

@Leola It seems that the problem has disappeared... Have a look on my code, please. I'm trying to parse all types of packets returned by the slave (v.5.2) kernel. – Orchid

@Alexey - I wonder what made the problem disappear... It's not obvious from your code. – Leola

@Leola It seems that the problem was incidental. The key decision was to use While[Not@MatchQ[packet = LinkRead[link], InputNamePacket[_]],... – Orchid