Verwenden Sie die Ein-Klick-Funktion für ein Objekt tremaphapify in R Shiny

Question

Ist es möglich, ein "On-Click" -Ereignis zu einem tremaphapify-Objekt in R Shiny zu machen? Ich habe den folgenden Code für andere Arten von ggplot2 Objekten getestet und es funktioniert. Wenn es eine andere Möglichkeit gibt, ein "On-Click" -Event für eine Treemap zu machen, lass es mich wissen!

global.R

library(tidyverse) 
library(treemapify) 
library(shiny) 
source("functions.R") 

mt <- data.frame(mtcars) 
cylinders <- unique(mt$cyl) 

functions.R

tmapData <- function(act_cyl) { 
    play <- mt %>% 
    mutate(name = row.names(mtcars)) %>% 
    dplyr::filter(cyl == act_cyl) 
    return(play) 
} 

tmapPlot <- function(act_cyl) { 

play <- tmapData(act_cyl) 
p <- ggplot(play, aes(area = wt, fill = mpg, label = name)) + 
    geom_treemap() + 
    geom_treemap_text(grow = FALSE, reflow = TRUE, color = "black") 
return(p) 
} 

server.R

shinyServer(function(input, output) { 

    active_cyl <- reactive({ 
    input$cyl_input 
    }) 

    output$tmap <- renderPlot({ 
    tmapPlot(active_cyl()) 
    }) 

    output$tdata <- DT::renderDataTable(
    out <- DT::datatable({ 
     tmapData(active_cyl()) %>% 
     select(name, mpg, wt) 
    }) 
) 

    output$out_text <- renderPrint({ 
    nearPoints(mt, input$tClick, threshold = 10, 
       maxpoints = 1, addDist = TRUE) 
    }) 
}) 

ui.R

Answer 1

Wenn ich zu verstehen, dies richtig:

output$out_text <- renderPrint({ 
    nearPoints(mt, input$tClick, threshold = 10, 
      maxpoints = 1, addDist = TRUE) 
}) 

die Idee ist, dass out_text werden Ihnen sagen, welche Beobachtung in mt entspricht die treemap Fliese, die geklickt wurde. Das Problem besteht jedoch darin, dass die X- und Y-Koordinaten in der Treemap nicht direkt auf den zugrunde liegenden Datensatz abgebildet werden. Der Kachel-Layout-Algorithmus hängt vom gesamten Satz von Beobachtungen ab, sodass Sie nicht vorhersagen können, wo eine einzelne Beobachtung ohne Berechnung der gesamten Treemap gezeichnet wird.

Die Lösung ist, die treemap Layout mit dem treemapify() Funktion vorauszuberechnen, dann diese Koordinaten zu verwenden, um herauszufinden, welche Beobachtung ein Paar geklickt Koordinate bezieht sich auf:

global.R

library(tidyverse) 
library(treemapify) 
library(shiny) 
source("functions.R") 

mt <- data.frame(mtcars) 
cylinders <- unique(mt$cyl) 

functions.R

tmapData <- function() { 
    play <- mt %>% 
    mutate(name = row.names(mtcars)) %>% 
    dplyr::filter(cyl == 4) 
    return(play) 
} 

tmapCoords <- function() { 
    treemapify(tmapData(), area = "wt", fill = "mpg", label = "name", xlim = c(0, 1), 
      ylim = c(0, 1)) 
} 

tmapPlot <- function() { 

play <- tmapData() 
p <- ggplot(play, aes(area = wt, fill = mpg, label = name)) + 
    geom_treemap() + 
    geom_treemap_text(grow = FALSE, reflow = TRUE, color = "black") 
return(p) 
} 

server.R

shinyServer(function(input, output) { 

    output$tmap <- renderPlot({ 
    tmapPlot() 
    }) 

    output$tdata <- DT::renderDataTable(
    out <- DT::datatable({ 
     tmapData() %>% 
     select(name, mpg, wt) 
    }) 
) 

    output$out_text <- renderPrint({ 
    input$tClick 
    tmapCoords() %>% 
     filter(xmin < input$tClick$x) %>% 
     filter(xmax > input$tClick$x) %>% 
     filter(ymin < input$tClick$y) %>% 
     filter(ymax > input$tClick$y) 
    }) 
}) 

ui.R

shinyUI(fluidPage(
    titlePanel("nearPoints Test"), 
    mainPanel(
     fluidRow(
     column(8, h3("First Column"), plotOutput("tmap", click = "tClick")), 
     column(4, h3("Second Column"), DT::dataTableOutput("tdata")) 
    ), 
     fluidRow(
     verbatimTextOutput("out_text") 
    ) 
    ) 
) 
)