How do you resize the output of a ctree using reactive inputs in R shiny?
My attempt
ui:
rm(list=ls())
library(shiny)
library(party)
# Define the overall UI
shinyUI(fluidPage(
titlePanel("Unbiased Recursive Partitioning"),
sidebarLayout(
sidebarPanel(
actionButton("go", "Plot URP-Ctree")
),
mainPanel(
# Create a new row for the URP plot.
sliderInput("sliderWidth", label = "", min = 10, max = 3000, value = 1000),
sliderInput("sliderHeight", label = "", min = 10, max = 3000, value = 1000),
plotOutput("plot")
))
)
)
server:
# server.R
rm(list=ls())
CCS<-c(41, 45, 50, 50, 38, 42, 50, 43, 37, 22, 42, 48, 47, 48, 50, 47, 41, 50, 45, 45, 39, 45, 46, 48, 50, 47, 50, 21, 48, 50, 48, 48, 48, 46, 36, 38, 50, 39, 44, 44, 50, 49, 40, 48, 48, 45, 39, 40, 44, 39, 40, 44, 42, 39, 49, 50, 50, 48, 48, 47, 48, 47, 44, 41, 50, 47, 50, 41, 50, 44, 47, 50, 24, 40, 43, 37, 44, 32, 43, 42, 44, 38, 42, 45, 50, 47, 46, 43,
37, 47, 37, 45, 41, 50, 42, 32, 43, 48, 45, 45, 28, 44,38, 41, 45, 48, 48, 47 ,49, 16, 45, 50, 47, 50, 43, 49, 50)
X1.2Weeks<-c(NA,NA,NA,NA,NA,1,2,2,2,NA,2,2,2,2,2,2,2,NA,NA,2,2,2,2,NA,2,2,2,2,2,2,2,NA,NA,NA,NA,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,NA,2,2,2,2,2,2,2,2,2,2,NA,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,1,2,2,2,2,2,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,1,1,2,2,1,2,2,2)
X2.2Weeks<-c(NA,NA,NA,NA,NA,NA,2,2,2,NA,NA,2,2,2,2,2,2,NA,2,2,2,2,2,NA,2,2,2,2,2,2,2,NA,NA,NA,NA,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,NA,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,1,2,2,2,2,2,2,2)
X3.2Weeks<-c(NA,35,40,NA,10,NA,31,NA,14,NA,NA,15,17,NA,NA,16,10,15,14,39,17,35,14,14,22,10,15,0,34,23,13,35,32,2,14,10,14,10,10,10,40,10,13,13,10,10,10,13,13,25,10,35,NA,13,NA,10,40,0,0,20,40,10,14,40,10,10,10,10,13,10,8,NA,NA,14,NA,10,28,10,10,15,15,16,10,10,35,16,NA,NA,NA,NA,30,19,14,30,10,10,8,10,21,10,10,35,15,34,10,39,NA,10,10,6,16,10,10,10,10,34,10)
X4.2Weeks<-c(NA,NA,511,NA,NA,NA,NA,NA,849,NA,NA,NA,NA,1324,1181,832,1005,166,204,1253,529,317,294,NA,514,801,534,1319,272,315,572,96,666,236,842,980,290,843,904,528,27,366,540,560,659,107,63,20,1184,1052,214,46,139,310,872,891,651,687,434,1115,1289,455,764,938,1188,105,757,719,1236,982,710,NA,NA,632,NA,546,747,941,1257,99,133,61,249,NA,NA,1080,NA,645,19,107,486,1198,276,777,738,1073,539,1096,686,505,104,5,55,553,1023,1333,NA,NA,969,691,1227,1059,358,991,1019,NA,1216)
x4.3Weeks<-c(NA,NA,511,NA,NA,NA,NA,NA,0,NA,NA,72,NA,1324,1181,832,1005,166,204,1253,529,317,294,NA,514,801,534,1319,272,315,572,96,666,236,842,980,290,843,904,528,27,366,540,560,659,107,63,20,1184,1052,214,46,139,310,872,891,651,687,434,1115,1289,455,764,938,1188,105,757,719,1236,982,710,NA,NA,632,NA,546,747,941,1257,99,133,61,249,NA,NA,1080,NA,645,19,107,486,1198,276,777,738,1073,539,1096,686,505,104,5,55,553,1023,1333,NA,NA,969,691,1227,1059,358,991,1019,NA,1216)
dat<-as.data.frame(cbind(CCS,X1.2Weeks,X2.2Weeks,X3.2Weeks,X4.2Weeks,x4.3Weeks))
library(shiny)
library(party)
shinyServer(function(input, output, clientData, session) {
sliderWidth<-reactive({
as.integer(input$sliderWidth)
})
sliderHeight<-reactive({
as.integer(input$sliderHeight)
})
# Construct URP-Ctree
output$plot <- renderPlot({
if(input$go==0){
return()
}
else {
isolate({
an<-"CCS"
# Only columns with "2Weeks" as part of their title are selected as predictors
control_preds<-"2Weeks"
preds<-names(dat)[grepl(paste(control_preds),names(dat))]
datSubset<-subset(dat,dat[,an]!="NA")
anchor <- datSubset[,an]
predictors <- datSubset[,preds]
urp<-ctree(anchor~., data=data.frame(anchor,predictors))
plot(urp)
})
}
},height = 500, width = 500)
# },height = sliderHeight(), width = sliderWidth())<-- Causes error
})
Running the above code you should get a ctree after you click the button. However the sliders don't do anything. If you change the height and width arguments of renderPlot to something other than 500 the size of the plot does change. How do I bring height and width under the control of the sliders?
When I try to run server with height = sliderHeight(), width = sliderWidth() in the last line I get:
Error in .getReactiveEnvironment()$currentContext() :
Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
And I'm confused since I used reactive expressions.
Two months on and I pay my best friend $500 bucks to solve this. Code below and I have no idea why a reactive expression inside a reactive expression solves this. ui stays unchanged.
# server.R
rm(list=ls())
CCS<-c(41, 45, 50, 50, 38, 42, 50, 43, 37, 22, 42, 48, 47, 48, 50, 47, 41, 50, 45, 45, 39, 45, 46, 48, 50, 47, 50, 21, 48, 50, 48, 48, 48, 46, 36, 38, 50, 39, 44, 44, 50, 49, 40, 48, 48, 45, 39, 40, 44, 39, 40, 44, 42, 39, 49, 50, 50, 48, 48, 47, 48, 47, 44, 41, 50, 47, 50, 41, 50, 44, 47, 50, 24, 40, 43, 37, 44, 32, 43, 42, 44, 38, 42, 45, 50, 47, 46, 43,
37, 47, 37, 45, 41, 50, 42, 32, 43, 48, 45, 45, 28, 44,38, 41, 45, 48, 48, 47 ,49, 16, 45, 50, 47, 50, 43, 49, 50)
X1.2Weeks<-c(NA,NA,NA,NA,NA,1,2,2,2,NA,2,2,2,2,2,2,2,NA,NA,2,2,2,2,NA,2,2,2,2,2,2,2,NA,NA,NA,NA,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,NA,2,2,2,2,2,2,2,2,2,2,NA,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,1,2,2,2,2,2,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,1,1,2,2,1,2,2,2)
X2.2Weeks<-c(NA,NA,NA,NA,NA,NA,2,2,2,NA,NA,2,2,2,2,2,2,NA,2,2,2,2,2,NA,2,2,2,2,2,2,2,NA,NA,NA,NA,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,NA,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,1,2,2,2,2,2,2,2)
X3.2Weeks<-c(NA,35,40,NA,10,NA,31,NA,14,NA,NA,15,17,NA,NA,16,10,15,14,39,17,35,14,14,22,10,15,0,34,23,13,35,32,2,14,10,14,10,10,10,40,10,13,13,10,10,10,13,13,25,10,35,NA,13,NA,10,40,0,0,20,40,10,14,40,10,10,10,10,13,10,8,NA,NA,14,NA,10,28,10,10,15,15,16,10,10,35,16,NA,NA,NA,NA,30,19,14,30,10,10,8,10,21,10,10,35,15,34,10,39,NA,10,10,6,16,10,10,10,10,34,10)
X4.2Weeks<-c(NA,NA,511,NA,NA,NA,NA,NA,849,NA,NA,NA,NA,1324,1181,832,1005,166,204,1253,529,317,294,NA,514,801,534,1319,272,315,572,96,666,236,842,980,290,843,904,528,27,366,540,560,659,107,63,20,1184,1052,214,46,139,310,872,891,651,687,434,1115,1289,455,764,938,1188,105,757,719,1236,982,710,NA,NA,632,NA,546,747,941,1257,99,133,61,249,NA,NA,1080,NA,645,19,107,486,1198,276,777,738,1073,539,1096,686,505,104,5,55,553,1023,1333,NA,NA,969,691,1227,1059,358,991,1019,NA,1216)
x4.3Weeks<-c(NA,NA,511,NA,NA,NA,NA,NA,0,NA,NA,72,NA,1324,1181,832,1005,166,204,1253,529,317,294,NA,514,801,534,1319,272,315,572,96,666,236,842,980,290,843,904,528,27,366,540,560,659,107,63,20,1184,1052,214,46,139,310,872,891,651,687,434,1115,1289,455,764,938,1188,105,757,719,1236,982,710,NA,NA,632,NA,546,747,941,1257,99,133,61,249,NA,NA,1080,NA,645,19,107,486,1198,276,777,738,1073,539,1096,686,505,104,5,55,553,1023,1333,NA,NA,969,691,1227,1059,358,991,1019,NA,1216)
dat<-as.data.frame(cbind(CCS,X1.2Weeks,X2.2Weeks,X3.2Weeks,X4.2Weeks,x4.3Weeks))
library(shiny)
library(party)
shinyServer(function(input, output, clientData, session) {
sliderWidth<-reactive({
as.integer(input$sliderWidth)
})
sliderHeight<-reactive({
as.integer(input$sliderHeight)
})
# Construct URP-Ctree
output$plot <- renderPlot({
if(input$go==0){
return()
}
else {
isolate({
an<-"CCS"
# Only columns with "2Weeks" as part of their title are selected as predictors
control_preds<-"2Weeks"
preds<-names(dat)[grepl(paste(control_preds),names(dat))]
datSubset<-subset(dat,dat[,an]!="NA")
anchor <- datSubset[,an]
predictors <- datSubset[,preds]
urp<-ctree(anchor~., data=data.frame(anchor,predictors))
plot(urp)
})
}
}, height = reactive({sliderHeight()}), width = reactive({sliderWidth()}))
})
You can see in the width and height parameters above all that was needed was for my reactive call to itself be inside a reactive expression.
Related
I am using an xgboost model to predict onto a raster stack. I have successfully used the same approach with CART, xgb and Random Forest models:
library(raster)
# create a RasterStack or RasterBrick with with a set of predictor layers
logo <- brick(system.file("external/rlogo.grd", package="raster"))
names(logo)
# known presence and absence points
p <- matrix(c(48, 48, 48, 53, 50, 46, 54, 70, 84, 85, 74, 84, 95, 85,
66, 42, 26, 4, 19, 17, 7, 14, 26, 29, 39, 45, 51, 56, 46, 38, 31,
22, 34, 60, 70, 73, 63, 46, 43, 28), ncol=2)
a <- matrix(c(22, 33, 64, 85, 92, 94, 59, 27, 30, 64, 60, 33, 31, 9,
99, 67, 15, 5, 4, 30, 8, 37, 42, 27, 19, 69, 60, 73, 3, 5, 21,
37, 52, 70, 74, 9, 13, 4, 17, 47), ncol=2)
# extract values for points
xy <- rbind(cbind(1, p), cbind(0, a))
v <- data.frame(cbind(pa=xy[,1], extract(logo, xy[,2:3])))
xgb <- xgboost(data = data.matrix(subset(v, select = -c(pa))), label = v$pa,
nrounds = 5)
raster::predict(model = xgb, logo)
But with xgboost I get the following error:
Error in xgb.DMatrix(newdata, missing = missing) :
xgb.DMatrix does not support construction from list
The problem is that predict.xgb.Booster does not accept a data.frame for argument newdata (see ?predict.xgb.Booster). That is unexpected (all common predict.* methods take a data.frame), but we can work around it. I show how to do that below, using the "terra" package instead of the obsolete "raster" package (but the solution is exactly the same for either package).
The example data
library(terra)
library(xgboost)
logo <- rast(system.file("ex/logo.tif", package="terra"))
p <- matrix(c(48, 48, 48, 53, 50, 46, 54, 70, 84, 85, 74, 84, 95, 85,
66, 42, 26, 4, 19, 17, 7, 14, 26, 29, 39, 45, 51, 56, 46, 38, 31,
22, 34, 60, 70, 73, 63, 46, 43, 28), ncol=2)
a <- matrix(c(22, 33, 64, 85, 92, 94, 59, 27, 30, 64, 60, 33, 31, 9,
99, 67, 15, 5, 4, 30, 8, 37, 42, 27, 19, 69, 60, 73, 3, 5, 21,
37, 52, 70, 74, 9, 13, 4, 17, 47), ncol=2)
xy <- rbind(cbind(1, p), cbind(0, a))
v <- extract(logo, xy[,2:3])
xgb <- xgboost(data = data.matrix(v), label=xy[,1], nrounds = 5)
The work-around is to write a prediction function that first coerces the data.frame with "new data" to a matrix. We can use that function with predict<SpatRaster>
xgbpred <- function(model, data, ...) {
predict(model, newdata=as.matrix(data), ...)
}
p <- predict(logo, model=xgb, fun=xgbpred)
plot(p)
In am plotting histogram in r an I want to specify my bins but I am getting some else.
This is my lenght data
pss <-
structure(list(LengthSize = c(48, 39, 94, 30, 81, 49, 44, 85,
44, 55, 45, 47, 44, 43, 42, 44, 76, 42, 65, 43, 43, 90, 105,
32, 31, 43, 36, 65, 21, 15, 113, 113, 44, 46, 94, 90, 95, 37,
25, 72, 49, 46, 48, 49, 49, 44, 50, 48, 37, 37, 55, 60, 65, 30,
22, 26, 43, 43, 43, 43, 18, 67, 110, 64, 28, 29, 38, 37, 38,
37, 38, 70, 58, 65, 55, 60, 40, 22, 68, 88, 88, 32, 44, 86, 37,
38, 67, 52, 48, 123, 50, 114, 37, 38, 39, 41, 60, 55, 50, 99,
57, 44, 45, 45, 51, 44, 45, 37, 39, 43, 43, 50, 51, 34, 42, 44,
46, 67, 67, 56, 56, 57, 56, 47, 65, 66, 43, 41, 69, 45, 114,
60, 55, 37, 88, 85, 39, 39, 46, 50, 60, 44, 77, 61, 68, 46, 114,
51, 105, 48, 95, 32, 40, 28, 42, 47, 46, 48, 50, 96, 45, 47,
118, 55, 60, 34, 118, 39, 52, 119, 40, 55, 60, 55, 59, 102, 73,
42, 78, 56, 74, 102, 88, 38, 36, 33, 34, 41, 120, 50, 46, 79,
98, 65, 40, 45, 42, 50, 61, 44)),
row.names = c(NA, 200L), class = "data.frame")
This is my code in ggplot2.
pss %>%
ggplot(data = pss,breaks = 25,xlim = c(0,528,11), mapping = aes(x = LengthSize )) +
geom_histogram(binwidth = 10, col = "black", fill = "grey")
You're in the right track, just modify your script as follows. You can experiment with binwidth and bins. You can easily modify or remove the title, xlab and ylab if you don't want them.
library(ggplot2)
ggplot(pss, mapping = aes(LengthSize)) + geom_histogram(binwidth = 3, bins=50, col = "black", fill = "grey") + ggtitle("My plot title") + xlab("My X axis label - length size") + ylab("Y axis label - Fequency count") + theme(plot.title = element_text(hjust = 0.5))
On the basis of the sample data above, the script produces the following histogram.
I extracted this data from a file:
forests<-read.table("~/Desktop/f.txt", header = FALSE, sep = " ", fill = TRUE)
library(arules) //after installing the package
I get an error when I type
forests<- apriori(forests, parameter = list(support=0.3))
Error in asMethod(object) : column(s) 1, 2, 3, 4, 5, 6, 7, 8, 9,
10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26,
27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43,
44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60,
61, 62, 63, 64, 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77,
78, 79, 80, 81, 82, 83, 84, 85 not logical or a factor. Discretize the
columns first.
I tried discritize(forests). It still doesn't work.
itemFrequencyPlot(forests) also gives an error saying unable to find inherited method.
Have I imported the data incorrectly?
I'm trying to plot the individual nodes from a regression tree created by the ctree function (party package). I have an action button and the code that generates the ctree only runs after this button is pressed. This part seems to work. After the tree is generated though what needs to happen is a group of radioButtons should appear with numbers corresponding to the terminal node numbers of the ctree that was just generated.
When the user selects a radioButton, the corresponding terminal node is plotted.
I have an observe clause that monitors the radioButton widget. It does not get updated after clicking the action button. Why?
Run the following server and ui code and you'll see my problem (sample data included. Tree plot should look the same as the one at this post). After you press the action button the plot appears. However, there remains only one radioButton. Observe({}) doesn't update it.
NOTE: Be sure to use rm(list=ls()) to clear the workspace before running the app.
# server.R
#rm(list=ls())
CCS<-c(41, 45, 50, 50, 38, 42, 50, 43, 37, 22, 42, 48, 47, 48, 50, 47, 41, 50, 45, 45, 39, 45, 46, 48, 50, 47, 50, 21, 48, 50, 48, 48, 48, 46, 36, 38, 50, 39, 44, 44, 50, 49, 40, 48, 48, 45, 39, 40, 44, 39, 40, 44, 42, 39, 49, 50, 50, 48, 48, 47, 48, 47, 44, 41, 50, 47, 50, 41, 50, 44, 47, 50, 24, 40, 43, 37, 44, 32, 43, 42, 44, 38, 42, 45, 50, 47, 46, 43,
37, 47, 37, 45, 41, 50, 42, 32, 43, 48, 45, 45, 28, 44,38, 41, 45, 48, 48, 47 ,49, 16, 45, 50, 47, 50, 43, 49, 50)
X1.2Weeks<-c(NA,NA,NA,NA,NA,1,2,2,2,NA,2,2,2,2,2,2,2,NA,NA,2,2,2,2,NA,2,2,2,2,2,2,2,NA,NA,NA,NA,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,NA,2,2,2,2,2,2,2,2,2,2,NA,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,1,2,2,2,2,2,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,1,1,2,2,1,2,2,2)
X2.2Weeks<-c(NA,NA,NA,NA,NA,NA,2,2,2,NA,NA,2,2,2,2,2,2,NA,2,2,2,2,2,NA,2,2,2,2,2,2,2,NA,NA,NA,NA,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,NA,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,1,2,2,2,2,2,2,2)
X3.2Weeks<-c(NA,35,40,NA,10,NA,31,NA,14,NA,NA,15,17,NA,NA,16,10,15,14,39,17,35,14,14,22,10,15,0,34,23,13,35,32,2,14,10,14,10,10,10,40,10,13,13,10,10,10,13,13,25,10,35,NA,13,NA,10,40,0,0,20,40,10,14,40,10,10,10,10,13,10,8,NA,NA,14,NA,10,28,10,10,15,15,16,10,10,35,16,NA,NA,NA,NA,30,19,14,30,10,10,8,10,21,10,10,35,15,34,10,39,NA,10,10,6,16,10,10,10,10,34,10)
X4.2Weeks<-c(NA,NA,511,NA,NA,NA,NA,NA,849,NA,NA,NA,NA,1324,1181,832,1005,166,204,1253,529,317,294,NA,514,801,534,1319,272,315,572,96,666,236,842,980,290,843,904,528,27,366,540,560,659,107,63,20,1184,1052,214,46,139,310,872,891,651,687,434,1115,1289,455,764,938,1188,105,757,719,1236,982,710,NA,NA,632,NA,546,747,941,1257,99,133,61,249,NA,NA,1080,NA,645,19,107,486,1198,276,777,738,1073,539,1096,686,505,104,5,55,553,1023,1333,NA,NA,969,691,1227,1059,358,991,1019,NA,1216)
x4.3Weeks<-c(NA,NA,511,NA,NA,NA,NA,NA,0,NA,NA,72,NA,1324,1181,832,1005,166,204,1253,529,317,294,NA,514,801,534,1319,272,315,572,96,666,236,842,980,290,843,904,528,27,366,540,560,659,107,63,20,1184,1052,214,46,139,310,872,891,651,687,434,1115,1289,455,764,938,1188,105,757,719,1236,982,710,NA,NA,632,NA,546,747,941,1257,99,133,61,249,NA,NA,1080,NA,645,19,107,486,1198,276,777,738,1073,539,1096,686,505,104,5,55,553,1023,1333,NA,NA,969,691,1227,1059,358,991,1019,NA,1216)
dat<-as.data.frame(cbind(CCS,X1.2Weeks,X2.2Weeks,X3.2Weeks,X4.2Weeks,x4.3Weeks))
library(shiny)
library(party)
shinyServer(function(input, output, clientData, session) {
observe({
if(exists("datSubset")&&!is.null(datSubset$node)){
updateRadioButtons(session,"nodesRadio",
h3("Choose Node to Display"),
choices = sort(unique(datSubset$node)),
selected = 1)
nodesRadioUpdated<<-TRUE
}
else{
nodesRadioUpdated<<-FALSE
}
})
# Construct URP-Ctree
output$plot <- renderPlot({
if(input$go==0){
return()
}
else {
isolate({
an<-"CCS"
# Only columns with "2Weeks" as part of their title are selected as predictors
control_preds<-"2Weeks"
preds<-names(dat)[grepl(paste(control_preds),names(dat))]
datSubset<-subset(dat,dat[,an]!="NA")
anchor <- datSubset[,an]
predictors <- datSubset[,preds]
urp<-ctree(anchor~., data=data.frame(anchor,predictors))
node<-where(urp)
datSubset<<-cbind(anchor,node,dat)
plot(urp,height = 1000, width = 1000)
})
}
})
output$nodePlot <- renderPlot({
if(exists("datSubset")&&!is.null(datSubset$node)&&nodesRadioUpdated){
if(!is.numeric(datSubset[node==input$nodesRadio,][,"anchor"])){
barplot(table(datSubset[node==input$nodesRadio,][,"anchor"]))
}
else{
boxplot(datSubset[node==input$nodesRadio,][,"anchor"])
}
}
})
})
And here is ui.R
#rm(list=ls())
library(shiny)
library(party)
# Define the overall UI
shinyUI(fluidPage(
titlePanel("Unbiased Recursive Partitioning"),
fluidRow(
column(2, wellPanel(
actionButton("go", "Plot URP-Ctree")
)),
column(8, wellPanel(
# Create a new row for the URP plot.
plotOutput("plot",height = 1000, width = 1000),
# Create a starting point for the radioButtons. More radioButtons should be added after pressing the actionButton because then the ctree will be created and terminal nodes will be defined
radioButtons("nodesRadio", label = h3("Choose Node to Display"),
choices = 1,
selected = NULL),
plotOutput("nodePlot",height = 1000, width = 1000)
))
)
)
)
As a sanity check I wrote the following to check if the tree generated is identical outside of R shiny and that you'd expect the if statement in the observe clause to have TRUE after datSubset is assigned as a global variable
library(party)
load("NotWorking.RData")
an<-"CCS"
control_preds<-"2Weeks"
preds<-names(dat)[grepl(paste(control_preds),names(dat))]
datSubset<-subset(dat,dat[,an]!="NA")
anchor <- datSubset[,an]
predictors <- datSubset[,preds]
urp<-ctree(anchor~., data=data.frame(anchor,predictors))
node<-where(urp)
datSubset<<-cbind(anchor,node,dat)
plot(urp)
# Generates the same tree
sort(unique(datSubset$node))
# Generates the correct set of nodes
exists("datSubset")&&!is.null(datSubset$node)
# TRUE
And thus my sanity isn't doing so well... Seems in order so why isn't it working? :S Any help is appreciated.
Is there any way to change the title sizes of a ctree plot?
Use the following variables to quickly set up a ctree plot
a<-c(41, 45, 50, 50, 38, 42, 50, 43, 37, 22, 42, 48, 47, 48, 50, 47, 41, 50, 45, 45, 39, 45, 46, 48, 50, 47, 50, 21, 48, 50, 48, 48, 48, 46, 36, 38, 50, 39, 44, 44, 50, 49, 40, 48, 48, 45, 39, 40, 44, 39, 40, 44, 42, 39, 49, 50, 50, 48, 48, 47, 48, 47, 44, 41, 50, 47, 50, 41, 50, 44, 47, 50, 24, 40, 43, 37, 44, 32, 43, 42, 44, 38, 42, 45, 50, 47, 46, 43,
37, 47, 37, 45, 41, 50, 42, 32, 43, 48, 45, 45, 28, 44,38, 41, 45, 48, 48, 47 ,49, 16, 45, 50, 47, 50, 43, 49, 50)
X1<-c(NA,NA,NA,NA,NA,1,2,2,2,NA,2,2,2,2,2,2,2,NA,NA,2,2,2,2,NA,2,2,2,2,2,2,2,NA,NA,NA,NA,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,NA,2,2,2,2,2,2,2,2,2,2,NA,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,1,2,2,2,2,2,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,1,1,2,2,1,2,2,2)
X2<-c(NA,NA,NA,NA,NA,NA,2,2,2,NA,NA,2,2,2,2,2,2,NA,2,2,2,2,2,NA,2,2,2,2,2,2,2,NA,NA,NA,NA,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,NA,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,1,2,2,2,2,2,2,1,2,2,2,2,2,2,2)
X3<-c(NA,35,40,NA,10,NA,31,NA,14,NA,NA,15,17,NA,NA,16,10,15,14,39,17,35,14,14,22,10,15,0,34,23,13,35,32,2,14,10,14,10,10,10,40,10,13,13,10,10,10,13,13,25,10,35,NA,13,NA,10,40,0,0,20,40,10,14,40,10,10,10,10,13,10,8,NA,NA,14,NA,10,28,10,10,15,15,16,10,10,35,16,NA,NA,NA,NA,30,19,14,30,10,10,8,10,21,10,10,35,15,34,10,39,NA,10,10,6,16,10,10,10,10,34,10)
X4<-c(NA,NA,511,NA,NA,NA,NA,NA,849,NA,NA,NA,NA,1324,1181,832,1005,166,204,1253,529,317,294,NA,514,801,534,1319,272,315,572,96,666,236,842,980,290,843,904,528,27,366,540,560,659,107,63,20,1184,1052,214,46,139,310,872,891,651,687,434,1115,1289,455,764,938,1188,105,757,719,1236,982,710,NA,NA,632,NA,546,747,941,1257,99,133,61,249,NA,NA,1080,NA,645,19,107,486,1198,276,777,738,1073,539,1096,686,505,104,5,55,553,1023,1333,NA,NA,969,691,1227,1059,358,991,1019,NA,1216)
p<-cbind(X1,X2,X3,X4)
With the following you should then get the plot below
library(party)
urp<-ctree(a~., data=data.frame(a,p))
plot(urp, main = "Broken Title")
How do I change the title size? I've tried the following which does nothing:
plot(urp, main = "Broken Title",cex = 1.5)
plot(urp, main = "Broken Title",cex.main = 1.5)
In fact, can I manipulate the title at all? font.main similarly does nothing. What about the titles "Node 2" and "Node 3." Is there likewise no way for me to manipulate them?
A similar question was asked here:
https://stackoverflow.com/questions/18817522/ctree-changing-titles-of-inner-nodes
There is good news and bad news.
So the plot() function that's actually doing all the work there is party:::plot.BinaryTree. The help is available from ?plot.BinaryTree but the bad news is it doesn't have any easily accessible parameters for font formatting. However, the good news is that the function uses grid graphics to draw to the screen and you can update properties after you've created the plot.
So after you run
library(party)
urp<-ctree(a~., data=data.frame(a,p))
plot(urp, main = "Broken Title")
You can run
for(gg in grid.ls(print=F)[[1]]) {
if (grepl("text", gg)) {
print(paste(gg, grid.get(gg)$label,sep=": "))
}
}
to see all the text boxes on the plot. For example, I see
[1] "GRID.text.673: Broken Title"
[1] "GRID.text.677: X1"
[1] "GRID.text.678: p = 0.03"
[1] "GRID.text.680: 1"
[1] "GRID.text.682: phantom(0) <= 1"
[1] "GRID.text.684: phantom(0) > 1"
[1] "GRID.text.686: Node 2 (n = 8)"
[1] "GRID.text.697: Node 3 (n = 109)"
Here i see the node names, and the text they contain. Note that the node names are not the same from plot to plot and change everything you draw the same plot. But you can use this list to find the ones you want to change and update them. So if I wanted to make the main text bigger, I would run
grid.edit("GRID.text.673", gp=gpar(fontsize=20))
or If i wanted to italize the node labels i would run
grid.edit("GRID.text.686", gp=gpar(fontface=3))
grid.edit("GRID.text.697", gp=gpar(fontface=3))
and that gives