jacobi-roots-0.1.0.0: compute_roots.nb

(* Content-type: application/vnd.wolfram.mathematica *)

(*** Wolfram Notebook File ***)
(* http://www.wolfram.com/nb *)

(* CreatedBy='Mathematica 8.0' *)

(*CacheID: 234*)
(* Internal cache information:
NotebookFileLineBreakTest
NotebookFileLineBreakTest
NotebookDataPosition[       157,          7]
NotebookDataLength[     12371,        294]
NotebookOptionsPosition[     12000,        276]
NotebookOutlinePosition[     12357,        292]
CellTagsIndexPosition[     12314,        289]
WindowFrame->Normal*)

(* Beginning of Notebook Content *)
Notebook[{

Cell[CellGroupData[{
Cell[BoxData[{
 RowBox[{
  RowBox[{"order", "=", "300"}], ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{
   RowBox[{"precision", "=", "25"}], ";"}], "\[IndentingNewLine]", 
  "\[IndentingNewLine]", 
  RowBox[{"(*", 
   RowBox[{
    RowBox[{
     RowBox[{"makeRoots", "[", 
      RowBox[{"\[Alpha]_", ",", "\[Beta]_"}], "]"}], ":=", 
     RowBox[{"Table", "[", 
      RowBox[{
       RowBox[{"Sort", "[", 
        RowBox[{"Re", "[", 
         RowBox[{"x", "/.", 
          RowBox[{"{", 
           RowBox[{"ToRules", "[", 
            RowBox[{"NRoots", "[", 
             RowBox[{
              RowBox[{"0", "==", 
               RowBox[{"JacobiP", "[", 
                RowBox[{"n", ",", "\[Alpha]", ",", "\[Beta]", ",", 
                 RowBox[{
                  RowBox[{"2", "x"}], "-", "1"}]}], "]"}]}], ",", "x", ",", 
              RowBox[{"PrecisionGoal", "\[Rule]", "precision"}]}], "]"}], 
            "]"}], "}"}]}], "]"}], "]"}], ",", 
       RowBox[{"{", 
        RowBox[{"n", ",", "1", ",", "order"}], "}"}]}], "]"}]}], ";"}], 
   "*)"}]}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{
   RowBox[{
    RowBox[{"makeRoots", "[", 
     RowBox[{"\[Alpha]_", ",", "\[Beta]_"}], "]"}], ":=", 
    RowBox[{"Table", "[", 
     RowBox[{
      RowBox[{"Sort", "[", 
       RowBox[{"Re", "[", 
        RowBox[{"N", "[", 
         RowBox[{
          RowBox[{"x", "/.", 
           RowBox[{"{", 
            RowBox[{"ToRules", "[", 
             RowBox[{"Roots", "[", 
              RowBox[{
               RowBox[{"0", "==", 
                RowBox[{"JacobiP", "[", 
                 RowBox[{"n", ",", "\[Alpha]", ",", "\[Beta]", ",", 
                  RowBox[{
                   RowBox[{"2", "x"}], "-", "1"}]}], "]"}]}], ",", "x"}], 
              "]"}], "]"}], "}"}]}], ",", "precision"}], "]"}], "]"}], "]"}], 
      ",", 
      RowBox[{"{", 
       RowBox[{"n", ",", "1", ",", "order"}], "}"}]}], "]"}]}], ";"}], 
  "\[IndentingNewLine]"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{
   RowBox[{"funName", "[", "name_", "]"}], ":=", 
   RowBox[{"\"\<shifted\>\"", "<>", "name", "<>", "\"\<Roots\>\""}]}], 
  ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{
   RowBox[{
    RowBox[{"toHaskell", "[", "roots_", "]"}], " ", ":=", 
    RowBox[{"StringReplace", "[", 
     RowBox[{
      RowBox[{"ToString", "[", "roots", "]"}], ",", 
      RowBox[{"{", 
       RowBox[{
        RowBox[{"\"\<{{\>\"", "\[Rule]", "\"\<  [ [\>\""}], ",", 
        RowBox[{"\"\<{\>\"", "\[Rule]", "\"\<[\>\""}], ",", 
        RowBox[{"\"\<},\>\"", "\[Rule]", "\"\<]\\n  ,\>\""}], ",", 
        RowBox[{"\"\<}}\>\"", "\[Rule]", "\"\<]\\n  ]\\n\>\""}]}], "}"}]}], 
     "]"}]}], ";"}], "\[IndentingNewLine]", "\[IndentingNewLine]", 
  RowBox[{"(*", 
   RowBox[{
    RowBox[{
     RowBox[{"specialize", "[", 
      RowBox[{"name_", ",", "type_"}], "]"}], ":=", 
     RowBox[{"\"\<{-# SPECIALIZE \>\"", "<>", 
      RowBox[{"funName", "[", "name", "]"}], "<>", "\"\< :: [[\>\"", "<>", 
      "type", "<>", "\"\<]] #-}\\n\>\""}]}], ";"}], 
   "*)"}]}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{
   RowBox[{
    RowBox[{"specialize", "[", 
     RowBox[{"name_", ",", "type_"}], "]"}], ":=", "\"\<\>\""}], ";"}], 
  "\[IndentingNewLine]"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{
   RowBox[{
    RowBox[{"doc", "[", 
     RowBox[{"name_", ",", "\[Alpha]_", ",", "\[Beta]_"}], "]"}], ":=", 
    RowBox[{"\"\<-- | roots of shifted Jacobi polynomials with alpha=\>\"", "<>", 
     RowBox[{"ToString", "[", "\[Alpha]", "]"}], "<>", "\"\<, beta=\>\"", "<>", 
     RowBox[{"ToString", "[", "\[Beta]", "]"}], "<>", "\"\<\\n\>\""}]}], 
   ";"}], "\[IndentingNewLine]", "\n", 
  RowBox[{"(*", 
   RowBox[{
    RowBox[{"typeSignature", "[", "name_", "]"}], ":=", 
    RowBox[{
     RowBox[{"funName", "[", "name", "]"}], "<>", 
     "\"\< :: Fractional a => [[a]]\\n\>\""}]}], 
   "*)"}]}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{
   RowBox[{"typeSignature", "[", "name_", "]"}], ":=", 
   RowBox[{
    RowBox[{"funName", "[", "name", "]"}], "<>", 
    "\"\< :: [[Double]]\\n\>\""}]}], 
  "\[IndentingNewLine]"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{
   RowBox[{
    RowBox[{"writeFun", "[", 
     RowBox[{"name_", ",", "\[Alpha]_", ",", "\[Beta]_"}], "]"}], ":=", 
    RowBox[{
     RowBox[{"doc", "[", 
      RowBox[{"name", ",", "\[Alpha]", ",", "\[Beta]"}], "]"}], "<>", 
     RowBox[{"specialize", "[", 
      RowBox[{"name", ",", "\"\<Double\>\""}], "]"}], "<>", 
     RowBox[{"specialize", "[", 
      RowBox[{"name", ",", "\"\<Float\>\""}], "]"}], "<>", 
     RowBox[{"typeSignature", "[", "name", "]"}], "<>", 
     RowBox[{"funName", "[", "name", "]"}], "<>", "\"\< =\\n\>\"", "<>", 
     RowBox[{"toHaskell", "[", 
      RowBox[{"makeRoots", "[", 
       RowBox[{"\[Alpha]", ",", "\[Beta]"}], "]"}], "]"}]}]}], ";"}], 
  "\[IndentingNewLine]"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{
   RowBox[{"header", " ", "=", " ", 
    RowBox[{"\"\<{-# OPTIONS_GHC -Wall #-}\\n\\nmodule JacobiRoots ( \>\"", "<>", 
     RowBox[{"funName", "[", "\"\<Legendre\>\"", "]"}], "<>", "\"\<, \>\"", "<>", 
     RowBox[{"funName", "[", "\"\<Radau\>\"", "]"}], "<>", 
     "\"\< ) where\\n\>\""}]}], ";"}], 
  "\[IndentingNewLine]"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"t0", "=", 
   RowBox[{"AbsoluteTime", "[", "]"}]}], ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"radauFun", "=", 
   RowBox[{"writeFun", "[", 
    RowBox[{"\"\<Radau\>\"", ",", "1", ",", "0"}], "]"}]}], 
  ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"t1", "=", 
   RowBox[{"AbsoluteTime", "[", "]"}]}], ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"\"\<Radau roots computed in \>\"", "<>", 
   RowBox[{"ToString", "[", 
    RowBox[{"t1", "-", "t0"}], "]"}], "<>", "\"\< seconds\>\""}], 
  "\[IndentingNewLine]"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"t0", "=", 
   RowBox[{"AbsoluteTime", "[", "]"}]}], ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"legendreFun", "=", 
   RowBox[{"writeFun", "[", 
    RowBox[{"\"\<Legendre\>\"", ",", "0", ",", "0"}], "]"}]}], 
  ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"t1", "=", 
   RowBox[{"AbsoluteTime", "[", "]"}]}], ";"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"\"\<Legendre roots computed in \>\"", "<>", 
   RowBox[{"ToString", "[", 
    RowBox[{"t1", "-", "t0"}], "]"}], "<>", "\"\< seconds\>\""}], 
  "\[IndentingNewLine]"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{
   RowBox[{"module", "=", 
    RowBox[{
    "header", "<>", "\"\<\\n\>\"", "<>", "legendreFun", "<>", "\"\<\\n\>\"", "<>",
      "radauFun"}]}], ";"}], "\[IndentingNewLine]"}], "\[IndentingNewLine]", 
 RowBox[{
  RowBox[{"Export", "[", 
   RowBox[{
    RowBox[{
     RowBox[{"NotebookDirectory", "[", "]"}], "<>", 
     "\"\<JacobiRoots.hs\>\""}], ",", "module", ",", "\"\<String\>\""}], 
   "]"}], ";"}]}], "Input",
 CellChangeTimes->{{3.587987975710743*^9, 3.587988018967742*^9}, {
   3.587988140782954*^9, 3.58798815728058*^9}, {3.587988288124055*^9, 
   3.587988349210535*^9}, {3.587988379483639*^9, 3.587988428435318*^9}, {
   3.587988493374807*^9, 3.5879885734639883`*^9}, {3.587988695081253*^9, 
   3.587988734229541*^9}, {3.587988865274241*^9, 3.587988979918384*^9}, {
   3.588001661667081*^9, 3.588001728500626*^9}, {3.5880018633441963`*^9, 
   3.588001890943791*^9}, {3.5880020068197412`*^9, 3.588002038838415*^9}, {
   3.588002089726606*^9, 3.5880021325805883`*^9}, {3.588002172992288*^9, 
   3.58800217307922*^9}, {3.588002213454361*^9, 3.588002279387953*^9}, {
   3.588002350248667*^9, 3.5880024943154173`*^9}, {3.588002630498912*^9, 
   3.588002631511115*^9}, {3.5880029196560383`*^9, 3.588002951505674*^9}, {
   3.588004697938921*^9, 3.588004722783022*^9}, {3.588004789505599*^9, 
   3.588004823229576*^9}, {3.5880048870142727`*^9, 3.588004908847272*^9}, {
   3.5880049682049093`*^9, 3.5880052077328568`*^9}, {3.588005251568804*^9, 
   3.5880053373734827`*^9}, {3.5880053864576397`*^9, 
   3.5880054119355707`*^9}, {3.588005451539935*^9, 3.588005629273572*^9}, {
   3.588005689584756*^9, 3.588006007874154*^9}, {3.5880060538803883`*^9, 
   3.588006205209202*^9}, {3.588006235848426*^9, 3.588006236049505*^9}, {
   3.58800637719137*^9, 3.588006457248946*^9}, {3.5880065009983187`*^9, 
   3.588006558138997*^9}, {3.5880067293048277`*^9, 3.588006736157967*^9}, {
   3.588006768789572*^9, 3.588006798879805*^9}, {3.588006843746955*^9, 
   3.588006879852024*^9}, {3.588007027445711*^9, 3.5880071241559896`*^9}, {
   3.588007160002849*^9, 3.588007421200338*^9}, {3.5880074555519953`*^9, 
   3.588007535525272*^9}, {3.5880075917679977`*^9, 3.588007600266787*^9}, {
   3.5880077610077753`*^9, 3.588007772777643*^9}, {3.588007867623734*^9, 
   3.5880080831228848`*^9}, {3.5880081252706633`*^9, 
   3.5880081255666733`*^9}, {3.5880082004576817`*^9, 3.588008323615759*^9}, {
   3.588008359184072*^9, 3.588008408149602*^9}, {3.5880085622403727`*^9, 
   3.588008568690647*^9}, {3.58800906710776*^9, 3.588009067174198*^9}, {
   3.588009133300729*^9, 3.5880091507937517`*^9}, {3.588009335941353*^9, 
   3.588009362568541*^9}, {3.5880098476616917`*^9, 3.5880099976681633`*^9}, {
   3.5880100734483433`*^9, 3.588010079878395*^9}, {3.5880110737662973`*^9, 
   3.588011081957842*^9}, {3.588011840942165*^9, 3.5880118735178547`*^9}, {
   3.5880120205554247`*^9, 3.58801202077311*^9}, {3.588012245741781*^9, 
   3.588012294963297*^9}, {3.588012340439755*^9, 3.58801242595753*^9}, {
   3.58801311680119*^9, 3.588013117756857*^9}, 3.5880131923337584`*^9, {
   3.588013648110627*^9, 3.5880136488415728`*^9}, {3.588014068917886*^9, 
   3.5880140700659447`*^9}, {3.588014359221745*^9, 3.588014405729136*^9}, {
   3.58801452596495*^9, 3.588014551366109*^9}, {3.588014596391746*^9, 
   3.588014610027115*^9}, {3.58801466565938*^9, 3.588014668065784*^9}, {
   3.5880147392723427`*^9, 3.588014777918192*^9}, {3.588014817892084*^9, 
   3.5880148429148293`*^9}, {3.5880148848554173`*^9, 
   3.5880149096937437`*^9}, {3.588015249321007*^9, 3.588015250099921*^9}, {
   3.588015742672408*^9, 3.588015751994816*^9}, {3.58801578267706*^9, 
   3.588015964903317*^9}, {3.5880160012766333`*^9, 3.588016029194995*^9}, {
   3.5880163126420937`*^9, 3.588016312947206*^9}}],

Cell[BoxData["\<\"Radau roots computed in 99.155180 seconds\"\>"], "Output",
 CellChangeTimes->{
  3.5880141771904573`*^9, 3.588014379606248*^9, 3.588014422221437*^9, {
   3.588014530934038*^9, 3.588014551780951*^9}, 3.588014651040941*^9, {
   3.588014736435153*^9, 3.588014740789653*^9}, 3.5880147784416428`*^9, {
   3.588014818472938*^9, 3.5880148466863537`*^9}, 3.588014890897044*^9, 
   3.588014959037346*^9, 3.588015596428967*^9, 3.588015916598996*^9, {
   3.5880159517687273`*^9, 3.588015965603405*^9}, 3.588016008640575*^9, 
   3.588016058468951*^9, 3.5880164175632877`*^9, 3.588017582282074*^9}],

Cell[BoxData["\<\"Legendre roots computed in 362.251589 seconds\"\>"], \
"Output",
 CellChangeTimes->{
  3.5880141771904573`*^9, 3.588014379606248*^9, 3.588014422221437*^9, {
   3.588014530934038*^9, 3.588014551780951*^9}, 3.588014651040941*^9, {
   3.588014736435153*^9, 3.588014740789653*^9}, 3.5880147784416428`*^9, {
   3.588014818472938*^9, 3.5880148466863537`*^9}, 3.588014890897044*^9, 
   3.588014959037346*^9, 3.588015596428967*^9, 3.588015916598996*^9, {
   3.5880159517687273`*^9, 3.588015965603405*^9}, 3.588016008640575*^9, 
   3.588016058468951*^9, 3.5880164175632877`*^9, 3.58801794453237*^9}]
}, Open  ]]
},
WindowSize->{807, 874},
WindowMargins->{{11, Automatic}, {Automatic, 10}},
FrontEndVersion->"8.0 for Mac OS X x86 (32-bit, 64-bit Kernel) (February 23, \
2011)",
StyleDefinitions->"Default.nb"
]
(* End of Notebook Content *)

(* Internal cache information *)
(*CellTagsOutline
CellTagsIndex->{}
*)
(*CellTagsIndex
CellTagsIndex->{}
*)
(*NotebookFileOutline
Notebook[{
Cell[CellGroupData[{
Cell[579, 22, 10188, 230, 658, "Input"],
Cell[10770, 254, 603, 8, 27, "Output"],
Cell[11376, 264, 608, 9, 27, "Output"]
}, Open  ]]
}
]
*)

(* End of internal cache information *)