Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge remote-tracking branch 'upstream/master'

Conflicts:
	.gitignore
	README.md
  • Loading branch information...
commit 1dc8afa9a2a9d4724ee3eb2854d6ef94c0b624f5 2 parents 52195be + 1d2a806
Karthik Ram karthik authored
1  .Rbuildignore
View
@@ -1 +1,2 @@
*.ipynb
+*.ipynb_checkpoints
2  .gitignore
View
@@ -1 +1 @@
-*.ipynb
+.ipynb_checkpoints
22 DESCRIPTION
View
@@ -1,8 +1,18 @@
-Package: IR_kernel
-Title:
-Description:
+Package: ipyr
+Title: Native R kernel for the IPython notebook
+Description: This package provides a native interface to the R kernel from the
+ IPython notebook
Version: 0.1
-Authors@R: 'Karthik Ram <karthik.ram@gmail.com> [aut, cre]'
-Depends: R (>= 3.0.2)
-License: CC0
+Authors@R: c(person("Thomas", "Kluver", role = c("aut", "cre"),
+ email = "takowl@gmail.com"),
+ person("Karthik", "Ram", role = "aut",
+ email = "karthik.ram@gmail.com"))
+Depends:
+ R (>= 3.0.2)
+License: MIT + License
LazyData: true
+Imports:
+ rzmq,
+ rjson,
+ uuid,
+ digest
8 Makefile
View
@@ -0,0 +1,8 @@
+docs:
+ Rscript -e "library(devtools); document('.'); check_doc()"
+
+check:
+ Rscript -e "library(devtools); check()"
+
+test:
+ Rscript -e "library(testthat); test()"
0  NAMESPACE
View
No changes.
299 R/kernel.r
View
@@ -1,174 +1,189 @@
-library(rzmq)
-library(rjson)
-library(uuid)
-library(digest) # for HMAC
-
-
-
+#'<brief desc>
+#'
+#'<full description>
+#' @export
+#' @import rzmq
+#' @import uuid
+#' @import digest
+#' @importFrom rjson fromJSON toJSON
hb_reply <- function() {
- data = receive.socket(hb_socket, unserialize=FALSE)
- send.socket(hb_socket, data, serialize=FALSE)
+ data <- receive.socket(hb_socket, unserialize = FALSE)
+ send.socket(hb_socket, data, serialize = FALSE)
}
+#'<brief desc>
+#'
+#'<full description>
+#' @param msg_lst <what param does>
+#' @export
sign_msg <- function(msg_lst) {
- concat = paste(msg_lst, collapse="")
- return(hmac(connection_info$key, concat, "sha256"))
+ concat <- paste(msg_lst, collapse = "")
+ return(hmac(connection_info$key, concat, "sha256"))
}
-
+#'<brief desc>
+#'
+#'<full description>
+#' @param socket <what param does>
+#' @export
recv_multipart <- function(socket) {
- parts = rawToChar(receive.socket(socket, unserialize=FALSE))
- while(get.rcvmore(socket)) {
- parts = append(parts, rawToChar(receive.socket(socket, unserialize=FALSE)))
- }
- return(parts)
+ parts <- rawToChar(receive.socket(socket, unserialize = FALSE))
+ while (get.rcvmore(socket)) {
+ parts <- append(parts, rawToChar(receive.socket(socket, unserialize = FALSE)))
+ }
+ return(parts)
}
-
+#'<brief desc>
+#'
+#'<full description>
+#' @param socket <what param does>
+#' @param parts <what param does>
+#' @export
send_multipart <- function(socket, parts) {
- for (part in parts[1:(length(parts)-1)]) {
- send.raw.string(socket, part, send.more=TRUE)
- }
- send.raw.string(socket, parts[length(parts)], send.more=FALSE)
+ for (part in parts[1:(length(parts) - 1)]) {
+ send.raw.string(socket, part, send.more = TRUE)
+ }
+ send.raw.string(socket, parts[length(parts)], send.more = FALSE)
}
-
+#'<brief desc>
+#'
+#'<full description>
+#' @param parts <what param does>
+#' @import rjson
+#' @export
wire_to_msg <- function(parts) {
- i = 1
- #print(parts)
- while(parts[i] != "<IDS|MSG>") {
- i = i+1
- }
- signature = parts[i+1]
- expected_signature = sign_msg(parts[(i+2):(i+5)])
- stopifnot(identical(signature, expected_signature))
-
- header = fromJSON(parts[i+2])
- parent_header = fromJSON(parts[i+3])
- metadata = fromJSON(parts[i+4])
- content = fromJSON(parts[i+5])
-
- if (i > 1) {
- identities = parts[1:(i-1)]
- } else {
- identities = NULL
- }
-
- return(list(header=header, parent_header=parent_header, metadata=metadata,
- content=content, identities=identities))
+ i <- 1
+ # print(parts)
+ while (parts[i] != "<IDS|MSG>") {
+ i <- i + 1
+ }
+ signature <- parts[i + 1]
+ expected_signature <- sign_msg(parts[(i + 2):(i + 5)])
+ stopifnot(identical(signature, expected_signature))
+ header <- fromJSON(parts[i + 2])
+ parent_header <- fromJSON(parts[i + 3])
+ metadata <- fromJSON(parts[i + 4])
+ content <- fromJSON(parts[i + 5])
+ if (i > 1) {
+ identities <- parts[1:(i - 1)]
+ } else {
+ identities <- NULL
+ }
+ return(list(header = header, parent_header = parent_header, metadata = metadata,
+ content = content, identities = identities))
}
-
+#'<brief desc>
+#'
+#'<full description>
+#' @param msg <what param does>
+#' @export
msg_to_wire <- function(msg) {
- bodyparts = c(toJSON(msg$header), toJSON(msg$parent_header),
- toJSON(msg$metadata), toJSON(msg$content))
- # Hack: an empty R list becomes [], not {}, which is what we want
- if (length(msg$metadata) == 0) {
- bodyparts[3] = "{}"
- }
- signature = sign_msg(bodyparts)
- #print(msg$identities)
- return(c(msg$identities, "<IDS|MSG>", signature, bodyparts))
+ bodyparts <- c(toJSON(msg$header), toJSON(msg$parent_header), toJSON(msg$metadata),
+ toJSON(msg$content))
+ # Hack: an empty R list becomes [], not {}, which is what we want
+ if (length(msg$metadata) == 0) {
+ bodyparts[3] <- "{}"
+ }
+ signature <- sign_msg(bodyparts)
+ # print(msg$identities)
+ return(c(msg$identities, "<IDS|MSG>", signature, bodyparts))
}
-
+#'<brief desc>
+#'
+#'<full description>
+#' @param msg_type <what param does>
+#' @param parent_msg <what param does>
+#' @export
new_reply <- function(msg_type, parent_msg) {
- header = list(msg_id=UUIDgenerate(), username=parent_msg$header$username,
- session=parent_msg$header$session, msg_type=msg_type)
- return(list(header=header, parent_header=parent_msg$header,
- identities=parent_msg$identities, metadata=list()))
+ header <- list(msg_id = UUIDgenerate(), username = parent_msg$header$username,
+ session = parent_msg$header$session, msg_type = msg_type)
+ return(list(header = header, parent_header = parent_msg$header, identities = parent_msg$identities,
+ metadata = list()))
}
-
+#'<brief desc>
+#'
+#'<full description>
+#' @param msg_type <what param does>
+#' @param parent_msg <what param does>
+#' @param socket <what param does>
+#' @param content <what param does>
+#' @export
send_response <- function(msg_type, parent_msg, socket, content) {
- msg = new_reply(msg_type, parent_msg)
- msg$content = content
- send_multipart(socket, msg_to_wire(msg))
+ msg <- new_reply(msg_type, parent_msg)
+ msg$content <- content
+ send_multipart(socket, msg_to_wire(msg))
}
-
+#'<brief desc>
+#'
+#'<full description>
+#' @param <what param does>
+#' @export
handle_shell <- function() {
- print("Shell msg")
- parts = recv_multipart(shell_socket)
- msg = wire_to_msg(parts)
- if (msg$header$msg_type == "execute_request") {
- execute(msg)
- } else if (msg$header$msg_type == "kernel_info_request") {
- kernel_info(msg)
- } else {
- print(c("Got unhandled msg_type:", msg$header$msg_type))
- }
+ print("Shell msg")
+ parts <- recv_multipart(shell_socket)
+ msg <- wire_to_msg(parts)
+ if (msg$header$msg_type == "execute_request") {
+ execute(msg)
+ } else if (msg$header$msg_type == "kernel_info_request") {
+ kernel_info(msg)
+ } else {
+ print(c("Got unhandled msg_type:", msg$header$msg_type))
+ }
}
-
-execution_count = 1
-userenv = new.env()
-
+execution_count <- 1
+userenv <- new.env()
execute <- function(request) {
- send_response("status", request, iopub_socket, list(execution_state="busy"))
- send_response("pyin", request, iopub_socket,
- list(code=request$code, execution_count=execution_count))
-
- code = sprintf("withVisible({%s})", request$content$code)
- print(code)
- expr = parse(text=code)
- result = eval(expr, envir=userenv)
- print(userenv)
- print(result)
-
- if (result$visible) {
- data = list()
- data['text/plain'] = toString(result$value)
- send_response("pyout", request, iopub_socket,
- list(data=data, metadata=list(), execution_count=execution_count))
- }
-
- send_response("status", request, iopub_socket, list(execution_state="idle"))
-
- reply_content = list(status='ok', execution_count=execution_count,
- payload=list(), user_variables=list(), user_expressions=list())
- send_response("execute_reply", request, shell_socket, reply_content)
-
- assign("execution_count", execution_count+1, envir=.GlobalEnv)
+ send_response("status", request, iopub_socket, list(execution_state = "busy"))
+ send_response("pyin", request, iopub_socket, list(code = request$code, execution_count = execution_count))
+ code <- sprintf("withVisible({%s})", request$content$code)
+ print(code)
+ expr <- parse(text = code)
+ result <- eval(expr, envir = userenv)
+ print(userenv)
+ print(result)
+ if (result$visible) {
+ data <- list()
+ data["text/plain"] <- toString(result$value)
+ send_response("pyout", request, iopub_socket, list(data = data, metadata = list(),
+ execution_count = execution_count))
+ }
+ send_response("status", request, iopub_socket, list(execution_state = "idle"))
+ reply_content <- list(status = "ok", execution_count = execution_count, payload = list(),
+ user_variables = list(), user_expressions = list())
+ send_response("execute_reply", request, shell_socket, reply_content)
+ assign("execution_count", execution_count + 1, envir = .GlobalEnv)
}
-
kernel_info <- function(request) {
- send_response("kernel_info_reply", request, shell_socket,
- list(protocol_version=c(4, 0), language="R"))
+ send_response("kernel_info_reply", request, shell_socket, list(protocol_version = c(4,
+ 0), language = "R"))
}
-
-argv = commandArgs(trailingOnly=TRUE)
-connection_info = fromJSON(file=argv[1])
-
+argv <- commandArgs(trailingOnly = TRUE)
+connection_info <- fromJSON(file = argv[1])
print(connection_info)
-
-url = paste(connection_info$transport, "://", connection_info$ip, sep="")
-
+url <- paste(connection_info$transport, "://", connection_info$ip, sep = "")
url_with_port <- function(port_name) {
- return(paste(url, ":", connection_info[port_name], sep=""))
+ return(paste(url, ":", connection_info[port_name], sep = ""))
}
-
# ZMQ Socket setup
-zmqctx = init.context()
-
-hb_socket = init.socket(zmqctx, "ZMQ_REP")
+zmqctx <- init.context()
+hb_socket <- init.socket(zmqctx, "ZMQ_REP")
bind.socket(hb_socket, url_with_port("hb_port"))
-
-iopub_socket = init.socket(zmqctx, "ZMQ_DEALER")
+iopub_socket <- init.socket(zmqctx, "ZMQ_DEALER")
bind.socket(iopub_socket, url_with_port("iopub_port"))
-
-control_socket = init.socket(zmqctx, "ZMQ_DEALER")
+control_socket <- init.socket(zmqctx, "ZMQ_DEALER")
bind.socket(control_socket, url_with_port("control_port"))
-
-stdin_socket = init.socket(zmqctx, "ZMQ_DEALER")
+stdin_socket <- init.socket(zmqctx, "ZMQ_DEALER")
bind.socket(stdin_socket, url_with_port("stdin_port"))
-
-shell_socket = init.socket(zmqctx, "ZMQ_DEALER")
+shell_socket <- init.socket(zmqctx, "ZMQ_DEALER")
bind.socket(shell_socket, url_with_port("shell_port"))
-
-
-while(1) {
- events = poll.socket(list(hb_socket, shell_socket, control_socket),
- list("read", "read", "read"),
- timeout=-1L)
-
- if (events[[1]]$read) { # heartbeat
- hb_reply()
- }
-
- if (events[[2]]$read) { # Shell socket
- handle_shell()
- }
-}
+while (1) {
+ events <- poll.socket(list(hb_socket, shell_socket, control_socket), list("read",
+ "read", "read"), timeout = -1L)
+ if (events[[1]]$read) {
+ # heartbeat
+ hb_reply()
+ }
+ if (events[[2]]$read) {
+ # Shell socket
+ handle_shell()
+ }
+}
26 README.md
View
@@ -1,9 +1,20 @@
+DO NOT USE. SUPER ALPHA, MUCH UNSAFE, VERY DISASTER. WOW.
+
# Native R kernel for IPython
+code using the IPython interface.
__Installing__
+First you'll need the latest version of zmq. Install with homebrew:
-__Installing dependencies__
+```coffee
+brew install zmq
+# or upgrade
+brew update
+brew upgrade zmq
+```
+
+__Installing dependencies__ (This will all change soon too)
```coffee
install.packages(c("rjson", "uuid", "digest"))
@@ -12,16 +23,9 @@ install.packages(c("rjson", "uuid", "digest"))
```
-__Dependencies for `rzmq`__
+# Running the notebook
```coffee
-git clone git://github.com/zeromq/libzmq.git
-cd libzmq
-./autogen.sh
-./configure # add other options here
-make
-make check
-sudo make install
+# This is in flux, will change soon
+ipython qtconsole --KernelManager.kernel_cmd="['Rscript', 'kernel.r', '{connection_file}']"
```
-libzmq also requires `pkg-config`. See more info on getting libzmq set up [here](http://zeromq.org/docs:source-git).
-
91 kernel.r
View
@@ -1,10 +1,11 @@
+# To start this, use a command like:
+# ipython qtconsole --KernelManager.kernel_cmd="['Rscript', '/home/takluyver/Code/ir_kernel/kernel.r', '{connection_file}']"
+
library(rzmq)
library(rjson)
library(uuid)
library(digest) # for HMAC
-
-
hb_reply <- function() {
data = receive.socket(hb_socket, unserialize=FALSE)
send.socket(hb_socket, data, serialize=FALSE)
@@ -81,13 +82,14 @@ send_response <- function(msg_type, parent_msg, socket, content) {
}
handle_shell <- function() {
- print("Shell msg")
parts = recv_multipart(shell_socket)
msg = wire_to_msg(parts)
if (msg$header$msg_type == "execute_request") {
execute(msg)
} else if (msg$header$msg_type == "kernel_info_request") {
kernel_info(msg)
+ } else if (msg$header$msg_type == "history_request") {
+ history(msg)
} else {
print(c("Got unhandled msg_type:", msg$header$msg_type))
}
@@ -101,27 +103,56 @@ execute <- function(request) {
send_response("pyin", request, iopub_socket,
list(code=request$code, execution_count=execution_count))
- code = sprintf("withVisible({%s})", request$content$code)
- print(code)
- expr = parse(text=code)
- result = eval(expr, envir=userenv)
- print(userenv)
- print(result)
+ silent = request$content$silent
+ if (silent) {
+ code = request$contents$code
+ } else {
+ code = sprintf("withVisible({%s})", request$content$code)
+ }
- if (result$visible) {
- data = list()
- data['text/plain'] = toString(result$value)
- send_response("pyout", request, iopub_socket,
- list(data=data, metadata=list(), execution_count=execution_count))
+ err = tryCatch({
+ expr = parse(text=code)
+ output_conn = textConnection("output", "w")
+ sink(output_conn)
+ result = eval(expr, envir=userenv)
+ list(ename=NULL) # Result of expression: error status
+ }, error = function(e) {
+ return(list(ename="ERROR", evalue=toString(e), traceback=list(toString(e))))
+ }, finally = {
+ sink()
+ close(output_conn)
+ })
+
+ if (!silent) {
+ if (!is.null(err$ename)) {
+ send_response("pyerr", request, iopub_socket,
+ c(err, list(execution_count=execution_count)))
+ } else if (result$visible) {
+ data = list()
+ data['text/plain'] = capture.output(print(result$value))
+ send_response("pyout", request, iopub_socket,
+ list(data=data, metadata=list(), execution_count=execution_count))
+ }
+
+ if (length(output) > 0) {
+ send_response("stream", request, iopub_socket,
+ list(name="stdout", data=output))
+ }
}
send_response("status", request, iopub_socket, list(execution_state="idle"))
- reply_content = list(status='ok', execution_count=execution_count,
- payload=list(), user_variables=list(), user_expressions=list())
+ if (!is.null(err$ename)) {
+ reply_content = c(err, list(status='error', execution_count=execution_count))
+ } else {
+ reply_content = list(status='ok', execution_count=execution_count,
+ payload=list(), user_variables=list(), user_expressions=list())
+ }
send_response("execute_reply", request, shell_socket, reply_content)
- assign("execution_count", execution_count+1, envir=.GlobalEnv)
+ if (!silent) {
+ assign("execution_count", execution_count+1, envir=.GlobalEnv)
+ }
}
kernel_info <- function(request) {
@@ -129,10 +160,30 @@ kernel_info <- function(request) {
list(protocol_version=c(4, 0), language="R"))
}
+history <- function(request) {
+ send_response("history_reply", request, shell_socket, list(history=list()))
+}
+
+handle_control <- function() {
+ parts = recv_multipart(control_socket)
+ msg = wire_to_msg(parts)
+ if (msg$header$msg_type == "shutdown_request") {
+ shutdown(msg)
+ } else {
+ print(c("Unhandled control message, msg_type:", msg$header$msg_type))
+ }
+}
+
+shutdown <- function(request) {
+ send_response('shutdown_reply', request, control_socket,
+ list(restart=request$content$restart))
+ stop("Shut down by frontend.")
+}
+
argv = commandArgs(trailingOnly=TRUE)
connection_info = fromJSON(file=argv[1])
-print(connection_info)
+#print(connection_info)
url = paste(connection_info$transport, "://", connection_info$ip, sep="")
@@ -171,4 +222,8 @@ while(1) {
if (events[[2]]$read) { # Shell socket
handle_shell()
}
+
+ if (events[[3]]$read) { # Control socket
+ handle_control()
+ }
}
1  launch.R
View
@@ -0,0 +1 @@
+library(ipyr)
Please sign in to comment.
Something went wrong with that request. Please try again.