UIOutput level plot test
library(shinyWidgets) #draw_data <- readRDS("/home/sixx/d2cm/1.RCodes/4.Etc/9.sixx/draw_data.rds") init_env0 <- function(){ env <- new.env() env$dd <- NULL return(env) } env6 <- init_env0() server <- function(input,output, session){ uFunc_draw_plot<- function(dd, selected_col, val_limit){ p <- dd %>% ggplot(aes_string(x="sec", y="val", group="subid", color=selected_col)) + coord_cartesian(ylim=val_limit) + geom_point() + geom_line() output$O_plt_main <- renderPlot({ return(p) }) } observeEvent(input$I_btn_load_make_dd, { if (is.null(env6$dd)){ # example dataset set.seed(666) nn <- 20 repp <- 10 subid <- lapply(1:nn, function(x){rep(letters[x],repp)}) %>% unlist() col1 <- sample( rep(c("A","B"),nn*repp), nn*repp) col2 <- rep("G",nn*repp) sec <- rep(1:repp, nn) val <- rnorm(nn*repp, mean=repp, sd =2) dd <- data.frame(subid, col1, col2, sec, val) env6$dd <<- dd } updateRadioButtons(session, "I_rdo_color_opt", choices=c("subid","col1","col2"), selected="subid",inline=T) }) react_color_opt <- reactive(input$I_rdo_color_opt) react_display_each <- reactive(input$I_rdoG_display_each) react_level_rng <- reactive(input$I_sld_subid_level) observe({ select_col <- react_color_opt() subid_level<- react_level_rng() display_each <- react_display_each() dd <- env6$dd if (!is.null(dd)){ val_limit <- range(env6$dd$val) if(!is.null(select_col)){ if(!is.null(subid_level) & display_each=="on"){ subid_levels <- levels(env6$dd$subid) uFunc_draw_plot(env6$dd[env6$dd$subid==subid_levels[subid_level],], select_col, val_limit) }else { uFunc_draw_plot(dd, select_col, val_limit) } } } }) output$O_dync_slide <- renderUI({ display_each <- react_display_each() if(!is.null(display_each)){ if(display_each=="on"){ tags$style(HTML(".js-irs-0 { background:#FFFFFF00; } .js-irs-0 .irs-bar-edge { background:#FFFFFF00; border:1px solid #CCC; border-right:1px solid #FFFFFF00; } .js-irs-0 .irs-line { border: 1px solid #CCC } .js-irs-0 .irs-bar { background:linear-gradient(to bottom, #DDD -50%, #FFF 150%); border-top:1px solid #CCC; border-bottom:1px solid #CCC; } ")) sliderInput("I_sld_subid_level", label="", width = "100%", value=0, min=1, max=length(unique(env6$dd$subid)), step=1, animate = animationOptions(interval = 666)) } } }) } ui <- fluidPage( fluidRow(column(width=12, actionButton("I_btn_load_make_dd", "Load Data!") )), fluidRow(column(width=12, plotOutput("O_plt_main", width="100%") )), radioButtons("I_rdo_color_opt", "Color Option", choices=c("subid","col1","col2"), selected="",inline=T), conditionalPanel(condition = 'input.I_rdo_color_opt!="col2"', fluidRow(column(width=12, radioGroupButtons("I_rdoG_display_each", "Display each:", choices=c("off", "on"), selected="off", status="default", size="normal", checkIcon=list(), choiceNames=NULL, choiceValues=NULL), uiOutput("O_dync_slide") )) ) ) shinyApp(ui, server)