Skip to content

Instantly share code, notes, and snippets.

@christlc

christlc/functional_prog_fun.R

Created January 2, 2018 07:50
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save christlc/2ed118cb5f7ecebd4ac8a4bed4f90f27 to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save christlc/2ed118cb5f7ecebd4ac8a4bed4f90f27 to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. @invalid-email-address Anonymous created this gist Jan 2, 2018.
    202 changes: 202 additions & 0 deletions functional_prog_fun.R
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,202 @@
    # R version of
    #https://hackernoon.com/functional-computational-thinking-what-is-a-monad-2adea91154e
    library(magrittr)
    readLines("./file1") %>% readLines()

    readFileCPS <- function(path, cb){
    cb(readLines(path))
    }

    composeCPS <- function(g,f){
    function(x, cb){
    g(x, function(y){
    f(y, function(z) cb(z))
    })
    }
    }

    composeCPS(readFileCPS, readFileCPS)('file1', print)


    readFileHOF <- function(path){
    function(cb){
    readFileCPS(path, cb)
    }
    }

    composeHOF <- function(g,f){
    function(x){
    function(cb){
    g(x)(function(y) f(y)(cb))
    }
    }
    }

    composeHOF(readFileHOF, readFileHOF)('./file1')(print)


    readFileEXEC <- function(path){
    return(
    list(
    exec = function(cb){
    readFileCPS(path, cb)
    }
    )
    )
    }


    composeEXEC <- function(g, f){
    function(x){
    list(
    exec = function(cb){
    g(x)$exec(function(y){
    f(y)$exec(cb)
    })
    }
    )
    }
    }

    composeEXEC(readFileEXEC, readFileEXEC)('file1')$exec(print)


    # Original

    createExecObj <- function(exec){
    list(
    exec = exec,
    bind = function(f){
    createExecObj(
    function(cb){
    exec(function(y){
    f(y)$exec(cb)
    })
    }
    )
    }
    )
    }


    readFileEXEC2 <- function(path){
    createExecObj(function(cb){
    readFileCPS(path, cb)
    })
    }


    ########### First iterations

    createExecObj <- function(exec){
    list(
    exec = exec,
    bind = function(f){
    createExecObj(
    function(cb){
    exec(function(y){
    f(y)$exec(cb)
    })
    }
    )
    }
    )
    }

    callback_fun <- function(f){
    function(...){
    createExecObj(function(cb){
    cb(f(...))
    })
    }
    }

    cbReadLines <- callback_fun(readLines)
    cbReadLines("./file1")$bind(cbReadLines)$exec(print)



    ########### Second iterations

    createExecObj <- function(exec){
    output <- list(
    exec = exec
    )
    class(output)<-"cb"
    output
    }

    compute.cb <- function(g, f){
    g$exec(f)
    }


    plot.cb <- function(g, f){
    createExecObj(
    function(cb){
    g$exec(function(y){
    f(y)$exec(cb)
    })
    }
    )
    }

    callback_fun <- function(f){
    function(...){
    createExecObj(function(cb){
    cb(f(...))
    })
    }
    }

    cbReadLines <- callback_fun(readLines)
    cbReadLines("./file1") %>% plot(cbReadLines) %>% compute(print)



    ########### Third iterations

    createExecObj <- function(exec){
    output <- list(
    exec = exec
    )
    class(output)<-"cb"
    output
    }

    compute.cb <- function(g, f){
    g$exec(f)
    }

    then.cb <- function(g, f){
    myf <- f
    if(!("cbfun" %in% class(f))){
    myf <- callback_fun(f)
    }
    createExecObj(
    function(cb){
    g$exec(function(y){
    myf(y)$exec(cb)
    })
    }
    )
    }

    then <- function(x, ...){
    UseMethod("then", x)
    }

    callback_fun <- function(f){
    a <- function(...){
    createExecObj(function(cb){
    cb(f(...))
    })
    }
    class(a) <- "cbfun"
    a
    }

    cbReadLines <- callback_fun(readLines)
    cbReadLines("./file1") %>% then(cbReadLines) %>% compute(print)
    cbReadLines("./file1") %>% then(readLines) %>% compute(print)