Search code examples
wolfram-mathematicamathlink

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


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.


Solution

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