1. Running R in a Yesod application

    2016-09-01
    Source

    Basic demo

    This small app takes two numbers and returns their sum after performing the addition in R.

    This is an Haskell app created with Yesod, and R is called from Haskell with the help of the inline-R package. You may take a look at my inline-R demo and at my article Hello Yesod+Ajax before.

    1. {-# LANGUAGE DataKinds #-}
    2. {-# LANGUAGE GADTs #-}
    3. {-# LANGUAGE PartialTypeSignatures #-}
    4. {-# LANGUAGE OverloadedLists #-}
    5. {-# LANGUAGE ScopedTypeVariables #-}
    6. {-# LANGUAGE QuasiQuotes       #-}
    7. {-# LANGUAGE TemplateHaskell   #-}
    8. {-# LANGUAGE ViewPatterns      #-}
    9. {-# LANGUAGE OverloadedStrings, DeriveGeneric #-}
    10. {-# LANGUAGE TypeFamilies      #-}
    11.  
    12. import Yesod
    13. import GHC.Generics
    14. import qualified Language.R.Instance as R
    15. import H.Prelude.Interactive
    16.  
    17. data HelloInlineR = HelloInlineR
    18.  
    19. mkYesod "HelloInlineR" [parseRoutes|
    20. / HomeR GET
    21. /data DataR PUT
    22. |]
    23.  
    24. instance Yesod HelloInlineR
    25.  
    26. data Args = Args {
    27.     _x :: Double,
    28.     _y :: Double
    29. } deriving (Show,Generic)
    30.  
    31. instance FromJSON Args
    32.  
    33. getHomeR :: Handler ()
    34. getHomeR = sendFile typeHtml "static/raddition.html"
    35.  
    36. runR :: Double -> Double -> IO(Double)
    37. runR x y = 
    38.   do
    39.     r <-  [r|x_hs + y_hs|]
    40.     return $ (fromSomeSEXP r :: Double) 
    41.  
    42. putDataR :: Handler String
    43. putDataR = do
    44.     arguments <- requireJsonBody :: Handler Args
    45.     r <- liftIO $ runR (_x arguments) (_y arguments)
    46.     return $ show r
    47.  
    48. main :: IO ()
    49. main = do 
    50.     R.initialize R.defaultConfig
    51.     warp 3000 HelloInlineR

    File raddition.html:

    1. <html>
    2.     <head>
    3.          <script src="//ajax.googleapis.com/ajax/libs/jquery/2.1.0/jquery.min.js"></script>
    4.  
    5.         <script type="text/javascript">
    6.             function save() {
    7.                 $.ajax({
    8.                 url: "/data",
    9.                 type: "PUT",
    10.                 processData: false,
    11.                 data: JSON.stringify({
    12.                                         _x: Number($("#x").val()), 
    13.                                         _y: Number($("#y").val())
    14.                                     }),
    15.                 success: function (result) {
    16.                     alert (result);
    17.                 },
    18.                 error: function(xhr, status, error) {
    19.                   alert("Error: " + xhr.responseText);
    20.                 },
    21.                 dataType: "text",
    22.                 contentType: "application/json"
    23.                 }); 
    24.             }
    25.         </script>
    26.     </head>
    27.     <body>
    28.  
    29.         <h3>Enter two numbers:</h3>
    30.         <input id="x" type="number" />
    31.         <input id="y" type="number" />
    32.  
    33.         <br><br>
    34.         
    35.         <input id="submit" type="button" value="Addition" onclick="save()">
    36.  
    37.     </body>
    38. </html>

    Instead of requesting a html file, we can create its contents in the Haskell code:

    1. ...
    2.  
    3. import Yesod.Form.Jquery (YesodJquery (urlJqueryJs))
    4.  
    5. ...
    6.  
    7. instance Yesod HelloInlineR
    8. instance YesodJquery HelloInlineR
    9.  
    10. ...
    11.  
    12. getHomeR :: Handler Html
    13. getHomeR = defaultLayout $ do
    14.     setTitle "Yesod + Ajax"
    15.     getYesod >>= addScriptEither . urlJqueryJs
    16.     [whamlet|
    17.         <input #x type=number>
    18.         <input #y type=number>
    19.         <button #add>Addition
    20.     |]
    21.     toWidget script
    22.  
    23. script = [julius|
    24. $(function(){
    25.     $("#add").click(function(){
    26.         $.ajax({
    27.             contentType: "application/json",
    28.             processData: false,
    29.             url: "@{DataR}",
    30.             type: "PUT",
    31.             data: JSON.stringify({
    32.                                     _x: Number($("#x").val()), 
    33.                                     _y: Number($("#y").val())
    34.                                 }),
    35.             success: function(result) {
    36.                 alert(result);
    37.             },
    38.             dataType: "text"
    39.         });
    40.     });
    41. });
    42. |]
    43.  
    44. ...


    Passing a dataframe

    Get the dataframe as a stringified JSON object, and use the jsonlite package.

    1. getHomeR :: Handler Html
    2. getHomeR = defaultLayout $ do
    3.     setTitle "Yesod + Ajax"
    4.     getYesod >>= addScriptEither . urlJqueryJs
    5.     [whamlet|
    6.         <button #submit>Submit
    7.     |]
    8.     toWidget script
    9.  
    10. script = [julius|
    11. $(function(){
    12.     $("#submit").click(function(){
    13.         $.ajax({
    14.             contentType: "text",
    15.             processData: false,
    16.             url: "@{DataR}",
    17.             type: "PUT",
    18.             data: JSON.stringify(JSON.stringify([{name: "Alice", age: 25}, {name: "Bob", age: 30}])),
    19.             success: function(result) {
    20.                 alert(result);
    21.             },
    22.             dataType: "text"
    23.         });
    24.     });
    25. });
    26. |]
    27.  
    28. runR :: String -> IO(Int32) -- requires Data.Int
    29. runR dat = do
    30.     r <- [r|ncol(jsonlite::fromJSON(dat_hs))|]
    31.     return $ (fromSomeSEXP r :: Int32) 
    32.  
    33. putDataR :: Handler String
    34. putDataR = do
    35.     dat <- requireJsonBody :: Handler String
    36.     r <- liftIO $ runR dat
    37.     return $ show r