Изменить размер участка участка ctree с использованием R блестящего слайдера

Question

Как изменить размер выходного сигнала ctree, используя реактивные входы в R-блестящем?

Моя попытка

УИ:

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.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 
}) 

Запуск выше кода вы должны получить Ctree после нажатия на кнопку. Однако слайдеры ничего не делают. Если вы измените аргументы height и width для renderPlot на что-то другое, кроме 500, размер графика изменится. Как установить высоту и ширину под ползунки?

Когда я пытаюсь запустить сервер с height = sliderHeight(), width = sliderWidth() в последней строке я получаю:

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.) 

И я смущен, поскольку я использовал реактивные выражения.

Answer 1

Два месяца, и я плачу своему лучшему другу $ 500 баксов, чтобы решить эту проблему. Код ниже, и я понятия не имею, почему реактивное выражение внутри реактивного выражения решает это. ui остается неизменным.

# 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()})) 
}) 

Вы можете увидеть в параметрах ширины и высоты над всем, что было необходимо для моего реактивного вызова к себе быть внутри реактивного выражения.