Related
I just started using Jupyter with R, and I'm wondering if there's a good way to display HTML or LaTeX output.
Here's some example code that I wish worked:
library(xtable)
x <- runif(500, 1, 50)
y <- x + runif(500, -5, 5)
model <- lm(y~x)
print(xtable(model), type = 'html')
Instead of rendering the HTML, it just displays it as plaintext. Is there any way to change that behavior?
A combination of repr (for setting options) and IRdisplay will work for HTML. Others may know about latex.
# Cell 1 ------------------------------------------------------------------
library(xtable)
library(IRdisplay)
library(repr)
data(tli)
tli.table <- xtable(tli[1:20, ])
digits(tli.table) <- matrix( 0:4, nrow = 20, ncol = ncol(tli)+1 )
options(repr.vector.quote=FALSE)
display_html(paste(capture.output(print(head(tli.table), type = 'html')), collapse="", sep=""))
# Cell 2 ------------------------------------------------------------------
display_html("<span style='color:red; float:right'>hello</span>")
# Cell 3 ------------------------------------------------------------------
display_markdown("[this](http://google.com)")
# Cell 4 ------------------------------------------------------------------
display_png(file="shovel-512.png")
# Cell 5 ------------------------------------------------------------------
display_html("<table style='width:20%;border:1px solid blue'><tr><td style='text-align:right'>cell 1</td></tr></table>")
I found a simpler answer, for the initial, simple use case.
If you call xtable without wrapping it in a call to print, then it totally works. E.g.,
library(xtable)
data(cars)
model <- lm(speed ~ ., data = cars)
xtable(model)
In Jupyter, you can use Markdown. Just be sure to change the Jupyter cell from a code cell to a Markdown cell. Once you have done this you can simply place a double dollar sign ("$$") before and after the LaTex you have. Then run the cell.
The steps are as follows:
1. Create a Markdown cell.
2. $$ some LaTex $$
3. Press play button within Jupyter.
Defining the following function in the session will display objects returned by xtable as html generated by xtable:
repr_html.xtable <- function(obj, ...){
paste(capture.output(print(obj, type = 'html')), collapse="", sep="")
}
library(xtable)
data(cars)
model <- lm(speed ~ ., data = cars)
xtable(model)
Without the repr_html.xtable function, because the returned object is also of class data.frame, the display system in the kernel will rich display that object (=html table) via repr::repr_html.data.frame.
Just don't print(...) the object :-)
Render/Embed html/Latex table to IR Kernel jupyter
Some packages in R give tables in html format like "knitr", so if you want to put this tables in the notebook:
library(knitr)
library(kableExtra)
library(IRdisplay) #the package that you need
#we create the table
dt <- mtcars[1:5, 1:6]
options(knitr.table.format = "html")
html_table= kable(dt) %>%
kable_styling("striped") %>%
add_header_above(c(" " = 1, "Group 1" = 2, "Group 2" = 2, "Group 3" = 2))
#We put the table in our notebook
display_html(toString(html_table))
Or for example if you have a file
display_latex(file = "your file path")
I have some longitudinal data from which I'd like to get the predicted means at specified times. The model includes 2 terms, their interaction and a spline term for the time variable. When I try to obtain the predicted means, I get "Error in mm %*% fixef(m4) : non-conformable arguments"
I've used the sleep data set from lmer to illustrate my problem. First, I import the data and create a variable "age" for my interaction
sleep <- as.data.frame(sleepstudy) #get the sleep data
# create fake variable for age with 3 levels
set.seed(1234567)
sleep$age <- as.factor(sample(1:3,length(sleep),rep=TRUE))
Then I run my lmer model
library(lme4)
library(splines)
m4 <- lmer(Reaction ~ Days + ns(Days, df=4) + age + Days:age + (Days | Subject), sleep)
Finally, I create the data and matrix needed to obtain predicted means
#new data frame for predicted means
d <- c(0:9) # make a vector of days = 0 to 9 to obtain predictions for each day
newdat <- as.data.frame(cbind(Days=d, age=rep(c(1:3),length(d))))
newdat$Days <- as.numeric(as.character(newdat$Days))
newdat$age <- as.factor(newdat$age)
# create a matrix
mm<-model.matrix(~Days + ns(Days, df=4) + age + Days:age, newdat)
newdat$pred<-mm%*%fixef(m4)
It's at this point that I get the error:
Error in mm %*% fixef(m4) : non-conformable arguments
I can use predict to get the means
newdat$pred <- predict(m4, newdata=newdat, re.form=NA)
which works fine, but I want to be able to calculate a confidence interval, so I need a conformable matrix.
I read somewhere that the problem may be that lmer creates aliases (I can't find that post). This comment was made with regards to not being able to use effect() for a similar task. I couldn't quite understand how to overcome this problem. Moreover, I recall that post was a little old and hoped the alias problem may no longer be relevant.
If anyone has a suggestion for what I may be doing wrong, I'd appreciate the feedback. Thanks.
There are a couple of things here.
you need to drop columns to make your model matrix commensurate with the fixed effect vector that was actually fitted (i.e., commensurate with the model matrix that was actually used for fitting, after dropping collinear columns)
for additional confusion, you happened to only sample ages 2 and 3 (out of a possible {1,2,3})
I've cleaned up the code a little bit ...
library("lme4")
library("splines")
sleep <- sleepstudy #get the sleep data
set.seed(1234567)
## next line happens to sample only 2 and 3 ...
sleep$age <- as.factor(sample(1:3,length(sleep),rep=TRUE))
length(levels(sleep$age)) ## 2
Fit model:
m4 <- lmer(Reaction ~ Days + ns(Days, df=4) +
age + Days:age + (Days | Subject), sleep)
## message; fixed-effect model matrix is
## rank deficient so dropping 1 column / coefficient
Check fixed effects:
f1 <- fixef(m4)
length(f1) ## 7
f2 <- fixef(m4,add.dropped=TRUE)
length(f2) ## 8
We could use this extended version of the fixed effects (which has an NA value in it), but this would just mess us up by propagating NA values through the computation ...
Check model matrix:
X <- getME(m4,"X")
ncol(X) ## 7
(which.dropped <- attr(getME(m4,"X"),"col.dropped"))
## ns(Days, df = 4)4
## 6
New data frame for predicted means
d <- 0:9
## best to use data.frame() directly, avoid cbind()
## generate age based on *actual* levels in data
newdat <- data.frame(Days=d,
age=factor(rep(levels(sleep$age),length(d))))
Create a matrix:
mm <- model.matrix(formula(m4,fixed.only=TRUE)[-2], newdat)
mm <- mm[,-which.dropped] ## drop redundant columns
## newdat$pred <- mm%*%fixef(m4) ## works now
Added by sianagh: Code to obtain confidence intervals and plot the data:
predFun <- function(x) predict(x,newdata=newdat,re.form=NA)
newdat$pred <- predFun(m4)
bb <- bootMer(m4,
FUN=predFun,
nsim=200)
## nb. this produces an error message on its first run,
## but not on subsequent runs (using the development version of lme4)
bb_ci <- as.data.frame(t(apply(bb$t,2,quantile,c(0.025,0.975))))
names(bb_ci) <- c("lwr","upr")
newdat <- cbind(newdat,bb_ci)
Plot:
plot(Reaction~Days,sleep)
with(newdat,
matlines(Days,cbind(pred,lwr,upr),
col=c("red","green","green"),
lty=2,
lwd=c(3,2,2)))
The error is caused due to the drift component, if you put
allowdrift=FALSE
into your auto.arima prediction it will be fixed.
I just started using Jupyter with R, and I'm wondering if there's a good way to display HTML or LaTeX output.
Here's some example code that I wish worked:
library(xtable)
x <- runif(500, 1, 50)
y <- x + runif(500, -5, 5)
model <- lm(y~x)
print(xtable(model), type = 'html')
Instead of rendering the HTML, it just displays it as plaintext. Is there any way to change that behavior?
A combination of repr (for setting options) and IRdisplay will work for HTML. Others may know about latex.
# Cell 1 ------------------------------------------------------------------
library(xtable)
library(IRdisplay)
library(repr)
data(tli)
tli.table <- xtable(tli[1:20, ])
digits(tli.table) <- matrix( 0:4, nrow = 20, ncol = ncol(tli)+1 )
options(repr.vector.quote=FALSE)
display_html(paste(capture.output(print(head(tli.table), type = 'html')), collapse="", sep=""))
# Cell 2 ------------------------------------------------------------------
display_html("<span style='color:red; float:right'>hello</span>")
# Cell 3 ------------------------------------------------------------------
display_markdown("[this](http://google.com)")
# Cell 4 ------------------------------------------------------------------
display_png(file="shovel-512.png")
# Cell 5 ------------------------------------------------------------------
display_html("<table style='width:20%;border:1px solid blue'><tr><td style='text-align:right'>cell 1</td></tr></table>")
I found a simpler answer, for the initial, simple use case.
If you call xtable without wrapping it in a call to print, then it totally works. E.g.,
library(xtable)
data(cars)
model <- lm(speed ~ ., data = cars)
xtable(model)
In Jupyter, you can use Markdown. Just be sure to change the Jupyter cell from a code cell to a Markdown cell. Once you have done this you can simply place a double dollar sign ("$$") before and after the LaTex you have. Then run the cell.
The steps are as follows:
1. Create a Markdown cell.
2. $$ some LaTex $$
3. Press play button within Jupyter.
Defining the following function in the session will display objects returned by xtable as html generated by xtable:
repr_html.xtable <- function(obj, ...){
paste(capture.output(print(obj, type = 'html')), collapse="", sep="")
}
library(xtable)
data(cars)
model <- lm(speed ~ ., data = cars)
xtable(model)
Without the repr_html.xtable function, because the returned object is also of class data.frame, the display system in the kernel will rich display that object (=html table) via repr::repr_html.data.frame.
Just don't print(...) the object :-)
Render/Embed html/Latex table to IR Kernel jupyter
Some packages in R give tables in html format like "knitr", so if you want to put this tables in the notebook:
library(knitr)
library(kableExtra)
library(IRdisplay) #the package that you need
#we create the table
dt <- mtcars[1:5, 1:6]
options(knitr.table.format = "html")
html_table= kable(dt) %>%
kable_styling("striped") %>%
add_header_above(c(" " = 1, "Group 1" = 2, "Group 2" = 2, "Group 3" = 2))
#We put the table in our notebook
display_html(toString(html_table))
Or for example if you have a file
display_latex(file = "your file path")
I am trying to call rq() of the package quantreg within a function. Herebelow is a simplified explanation of my problem.
If I follow the recommendations found at
http://developer.r-project.org/model-fitting-functions.txt, I have a design matrix after the line
x <- model.matrix(mt, mf, contrasts)
with the first column full of 1's to create an intercept.
Now, when I call rq(), I am obliged to use something like
fit <- rq (y ~ x [,2], tau = 0.5, ...)
My problem happens if there is more than 1 explanatory variable. I don't know how to find an automatic way to write:
x [,2] + x [,3] + x [,4] + ...
Here is the complete simplified code:
ao_qr <- function (formula, data, method = "br",...) {
cl <- match.call ()
## keep only the arguments which should go into the model
## frame
mf <- match.call (expand.dots = FALSE)
m <- match (c ("formula", "data"), names (mf), 0)
mf <- mf[c (1, m)]
mf$drop.unused.levels <- TRUE
mf[[1]] <- as.name ("model.frame")
mf <- eval.parent (mf)
if (method == "model.frame") return (mf)
## allow model.frame to update the terms object before
## saving it
mt <- attr (mf, "terms")
y <- model.response (mf, "numeric")
x <- model.matrix (mt, mf, contrasts)
## proceed with the quantile regression
fit <- rq (y ~ x[,2], tau = 0.5, ...)
print (summary (fit, se = "boot", R = 100))
}
I call the function with:
ao_qr(pain ~ treatment + extra, data = data.subset)
And here is how to get the data:
require (lqmm)
data(labor)
data <- labor
data.subset <- subset (data, time == 90)
data.subset$extra <- rnorm (65)
In this case, with this code, my linear predictor only includes "treatment". If I want "extra", I have to manually add x[,3] in the linear predictor of rq() in the code. This is not automatic and will not work on other datasets with unknown number of variables.
Does anyone know how to tackle this ?
Any help would be greatly appreciated !!!
I found a simple solution:
x[,2:ncol(x)]
I would like to have a call that returns me a vector with the names of all function that I could call in the current R session. Does anybody know how to achieve this?
(I would like to check user entered variables against this vector. We had some unforseen problem with users entering e.g., c as variable names)
UPDATE: I would like to get the function names from all packages currently loaded.
SOLUTION (half way): Based on Joris Meys tip with lsf.str() I came up with the following function that returns a sorted vector with all currently available function names:
getFunctionNames <- function() {
loaded <- (.packages())
loaded <- paste("package:", loaded, sep ="")
return(sort(unlist(lapply(loaded, lsf.str))))
}
Bu,t see also the comments on Joris Meys' post for even better answers.
I'd use lsf.str() as a start.
eg : x <- as.character(lsf.str("package:base")) gives you a list of all functions in the base package. You could do add all packages you want to check against. stats and utils come to mind first.
EDIT : Regarding your question about currently loaded packages :
x <- unlist(sapply(search()[-1],function(x)as.character(lsf.str(x)))) see comments
pkgs <- search()
pkgs <- pkgs[grep("package:",pkgs)]
y <- unlist(sapply(pkgs,lsf.str))
does the trick.
I asked a similar Q on R-Help many moons ago (2007) and Prof. Brian Ripley provided this as a solution:
findfuns <- function(x) {
if(require(x, character.only=TRUE)) {
env <- paste("package", x, sep=":")
nm <- ls(env, all=TRUE)
nm[unlist(lapply(nm, function(n) exists(n, where=env,
mode="function",
inherits=FALSE)))]
} else character(0)
}
pkgs <- dir(.Library)
z <- lapply(pkgs, findfuns)
names(z) <- pkgs
Z <- sort(unique(unlist(z)))
Which gives output like:
> head(Z)
[1] "^" "-" "-.Date" "-.POSIXt" ":" "::"
This was for finding all the functions in packages specified by object pkgs so you can control which packages are loaded/checked against.
A modified version that work on the currently loaded set of packages would be:
findfuns2 <- function(pkgs) {
nm <- ls(pkgs, all = TRUE)
nm[unlist(lapply(nm, function(n) exists(n, where = pkgs,
mode = "function",
inherits = FALSE)))]
if(isTRUE(all.equal(length(nm), 0)))
character(0)
else
nm
}
pkgs <- search()
pkgs <- pkgs[grep("package:", pkgs)]
z <- lapply(pkgs, findfuns2)
z <- sort(unique(unlist(z)))
head(z)