Rの宝物化オブジェクトにオンクリックを使用するShiny

Question

R光沢のある宝物化オブジェクトに対して「オンクリック」イベントを実行することは可能ですか？私は他のタイプのggplot2オブジェクトのために以下のコードをテストしました。また、ツリーマップに対して「オンクリック」イベントを実行する別の方法がある場合は、教えてください。

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

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

Answer 1

私はこれを正しく理解していた場合：

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

をアイデアはout_textがクリックされたツリーマップタイルに対応mtで何観測を教えてくれますということです。しかし、問題は、ツリーマップ内のx座標とy座標が、基礎となるデータセットに直接的にマッピングされないことです。タイルレイアウトアルゴリズムは、観測セット全体に依存しているため、ツリーマップ全体を計算することなく、単一の観測がどこに描画されるかを予測することはできません。

global.R

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

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

functions.R

：

溶液がクリックされた座標対がに関するもの観察把握するためにこれらの座標を使用するように、その後、treemapify()機能をツリーマップのレイアウトを事前計算することです

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