#server.R library(shiny) library(treemap) server <- function(input, output) { data <- mtcars #data$count <- ave(data$carb, data[,c('vs','am', 'gear', 'carb')], FUN=length) #kann weg data$one <- 1 rV <- reactiveValues( selectedData = data, tile = data.frame() ) output$vs <- renderUI({ selectInput(inputId = 'vs', label = 'Engine', c(Choose = '', V_shaped = 0, straight = 1) ) }) output$am <- renderUI({ selectInput(inputId = 'am', label = 'Transmission', c(Choose = '', automatic = 0, manual = 1) ) }) output$gear <- renderUI({ selectInput(inputId = 'gear', label = 'Number of forward gears', c(Choose = '', sort(unique(data$gear))) ) }) output$carb <- renderUI({ selectInput(inputId = 'carb', label = 'Number of carburetors', c(Choose = '', sort(unique(data$carb))) ) }) output$treemap <- renderPlot({ p <- treemap(rV$selectedData, index = c('vs', 'am', 'gear', 'carb'), vSize = 'one', #vSize = 'count', #kann weg type = 'index' ) rV$tile <- p$tm[, c('vs', 'am', 'gear', 'carb', 'vSize', 'x0', 'y0', 'w', 'h')] p }) observeEvent(c(input$vs, input$am, input$gear, input$carb), { rV$selectedData <- data if(input$vs != '') rV$selectedData <- rV$selectedData[rV$selectedData$vs == input$vs,] if(input$am != '') rV$selectedData <- rV$selectedData[rV$selectedData$am == input$am,] if(input$gear != '') rV$selectedData <- rV$selectedData[rV$selectedData$gear == input$gear,] if(input$carb != '') rV$selectedData <- rV$selectedData[rV$selectedData$carb == input$carb,] }) output$hoverInfo <- renderUI({ hover <- input$hover # Zwischenspeicher if (!is.null(hover)) { for (i in 1:nrow(rV$tile)) { if (hover$x >= rV$tile$x0[i] && hover$x <= (rV$tile$x0[i] + rV$tile$w[i]) && hover$y >= rV$tile$y0[i] && hover$y <= (rV$tile$y0[i] + rV$tile$h[i])) { style <- paste0("position:absolute; z-index:100; background-color: rgba(245, 245, 245, 0.85); ", "left:", hover$coords_img$x + 5, "px; top:", hover$coords_img$y + 5, "px;") return( wellPanel( style = style, p(HTML(paste0(" Engine: ", rV$tile$vs[i], "
", " Transmission: ", rV$tile$am[i], "
", " Number of forward gears: ", rV$tile$gear[i], "
", " Number of carburetors: ", rV$tile$carb[i], "
", " Count: ", rV$tile$vSize[i]))) ) ) } } } }) } #----------------------------------------------------------------------- #ui.R ui <- fluidPage( titlePanel("Demo 6_Treemap"), fluidRow(htmlOutput('vs')), fluidRow(htmlOutput('am')), fluidRow(htmlOutput('gear')), fluidRow(htmlOutput('carb')), fluidRow( style = "position:relative", uiOutput("hoverInfo"), plotOutput('treemap', dblclick = "dblclick", hover = hoverOpts(id = "hover", delay = 250, delayType = "throttle"))) ) #----------------------------------------------------------------------- #app.R source('server.R', encoding = "UTF-8") source('ui.R', encoding = "UTF-8") shinyApp(ui = ui, server = server)