在 Shiny 中將縮放添加到密度 Plot

Question

我希望能夠在 shiny 中以密度 plot 放大 vlines。 我將 iris 數據集用於可重現的目的。 vlines 標有行名稱。

在我的實際數據集中，我有許多彼此非常接近的 vline。 它們非常接近，以至於我經常無法區分行號標簽。 我想找到一種放大 vline 標簽的方法。 我曾嘗試使用刷子，但這不起作用。

library(tidyverse)
library(cluster)
library(shiny)

ui <- fluidPage({
  pageWithSidebar(
    headerPanel('Iris k-means clustering'),
    sidebarPanel(
      numericInput('clusters', 'Cluster count', 3, min = 1, max = 9)
    ),
    mainPanel(
      plotOutput('plot1', 
                 dblclick = 'plot1_dblclick',
                 brush = brushOpts(
                   id = 'plot1_brush',
                   resetOnNew = TRUE
                 ))
    )
  )
})


server <- function(input, output){
  
  ClusterData <- reactive({
    iris[,1:4]
  })
  
  # need to keep row numbers for outlier labels
  ClusterData2 <- reactive({
    ClusterData2 <- data.frame(ClusterData())
    
    row.names(ClusterData2) <- 1:nrow(ClusterData2)
    
    return(ClusterData2)
  })
  
  
  # scale the iris data
  ScaledData <- reactive({
    scale(ClusterData2())
  })
  
  # kmeans clustering
  final <- reactive({
    kmeans(ScaledData(), input$clusters, nstart = 25)
  })
  
  # find centers
  states.centers <- reactive({
    final()$centers[final()$cluster, ]
  })
  
  # find outliers
  distances <- reactive({
    sqrt(rowSums((ScaledData() - states.centers())^2))
  })
  
  # bind distances back to data
  outliers <- reactive({
    cbind(ClusterData(), Distance = distances())
  })
  
  # bind cluster number to data
  clusterMember <- reactive({
    cbind(outliers(), clusterNum = final()$cluster)
  })
  
  # turn into data frame
  clusterMember2 <- reactive({
    as.data.frame(clusterMember())
  })
  
  # find points that are their own cluster
  dist0 <- reactive({
    clusterMember() %>%
      filter(distances() == 0)
  })
  
  # arrange distances largest to smallest
  distArrange <- reactive({
    clusterMember() %>%
      arrange(desc(Distance))
  })
  
  # find top 5 outliers
  filtTop5 <- reactive({
    distArrange()[1:5,]
  })
  
  # bind outliers and single clusters together
  AllOutliers <- reactive({
    rbind(filtTop5(), dist0())
    
  })
  

  ########## output plot
  output$plot1 <- renderPlot({
    ClusterData() %>%
      ggplot(aes(x = Petal.Length)) +
      geom_density(fill = "blue", alpha = 0.4) +
      geom_vline(xintercept = AllOutliers()$Petal.Length) +  
      annotate("text", x = AllOutliers()$Petal.Length, 
               y = 0,
               label = rownames(AllOutliers()),
               hjust = 0.5,
               vjust = -1)
  
  })
  
  ######### zoom brush
  observeEvent(input$plot1_dblclick, {
    brush <- input$plot1_brush
    if (!is.null(brush)) {
      ranges$x <- c(brush$xmin, brush$xmax)
      ranges$y <- c(brush$ymin, brush$ymax)
    } else {
      ranges$x <- NULL
      ranges$y <- NULL
    }
  })
  
  
}

shinyApp(ui, server)

我沒有投資於上述方法。 歡迎大家提出意見。

謝謝你。

Answer 1

我建議您嘗試plotly package。

從您的問題修改代碼：

library(tidyverse)
library(cluster)
library(shiny)
library(plotly)

ui <- fluidPage({
    pageWithSidebar(
        headerPanel('Iris k-means clustering'),
        sidebarPanel(
            numericInput('clusters', 'Cluster count', 3, min = 1, max = 9)
        ),
        mainPanel(
            plotlyOutput('plot1')
        )
    )
})


server <- function(input, output){
    
    ClusterData <- reactive({
        iris[,1:4]
    })
    
    # need to keep row numbers for outlier labels
    ClusterData2 <- reactive({
        ClusterData2 <- data.frame(ClusterData())
        
        row.names(ClusterData2) <- 1:nrow(ClusterData2)
        
        return(ClusterData2)
    })
    
    
    # scale the iris data
    ScaledData <- reactive({
        scale(ClusterData2())
    })
    
    # kmeans clustering
    final <- reactive({
        kmeans(ScaledData(), input$clusters, nstart = 25)
    })
    
    # find centers
    states.centers <- reactive({
        final()$centers[final()$cluster, ]
    })
    
    # find outliers
    distances <- reactive({
        sqrt(rowSums((ScaledData() - states.centers())^2))
    })
    
    # bind distances back to data
    outliers <- reactive({
        cbind(ClusterData(), Distance = distances())
    })
    
    # bind cluster number to data
    clusterMember <- reactive({
        cbind(outliers(), clusterNum = final()$cluster)
    })
    
    # turn into data frame
    clusterMember2 <- reactive({
        as.data.frame(clusterMember())
    })
    
    # find points that are their own cluster
    dist0 <- reactive({
        clusterMember() %>%
            filter(distances() == 0)
    })
    
    # arrange distances largest to smallest
    distArrange <- reactive({
        clusterMember() %>%
            arrange(desc(Distance))
    })
    
    # find top 5 outliers
    filtTop5 <- reactive({
        distArrange()[1:5,]
    })
    
    # bind outliers and single clusters together
    AllOutliers <- reactive({
        rbind(filtTop5(), dist0())
        
    })
    
    
    ########## output plot
    output$plot1 <- renderPlotly({
        plot1 <- ClusterData() %>%
            ggplot(aes(x = Petal.Length)) +
            geom_density(fill = "#6495ed", alpha = 0.3) +
            geom_vline(xintercept = AllOutliers()$Petal.Length, size = 0.5, colour = "#013220") +  
            annotate("text", x = AllOutliers()$Petal.Length, 
                     y = 0,
                     label = rownames(AllOutliers()),
                     colour = "#d4240b", 
                     size = 4)
        
        ggplotly(plot1)
    })
    
}

shinyApp(ui, server)

Output（用簇數縮放 = 9）：