Question

所以我试图解决以下问题，但我可能已经走错了路。

随着这些样本量的增加，我需要更新y限制，以便geom_histogram（）中的最高位不会超出顶部。特别是如果圣。开发。设置在0附近。

这是我第二天与Shiny和被动应用程序一起工作，所以我觉得自己已经陷入困境。

我想我需要保存ggplot（）对象，然后用最后一个直方图中最大条的值反应更新它们的ylimit。只是不确定我是否可以按照现在这样设置的方式来做到这一点。

（我意识到我在两年前遇到了类似的问题）

ggplot2 Force y-axis to start at origin and float y-axis upper limit

这是不同的，因为直方图的高度需要告诉y轴增加，而不是最大的数据值。还有，因为Shiny。

我的server.R功能看起来像

    library(shiny)
library(ggplot2)
library(extrafont)


# Define server logic for random distribution application
function(input, output, session) {


    data <- reactive({
            set.seed(123)

             switch(input$dist, 
                    norm = rnorm(input$n, 
                                 sd = input$stDev),
                    unif = runif(input$n,-4,4),
                    lnorm = rlnorm(input$n)
                    )
                 })

    height="100%"

    plotType <- function(blah, maxVal, stDev, n, type) {

      roundUp <- function(x) 10^ceiling(log10(x)+0.001)
      maxX<- roundUp(maxVal)
      breakVal<-max(floor(maxX/10),1)

      switch(type,
             norm =  ggplot(as.data.frame(blah), aes(x=blah))+
               geom_histogram(binwidth = 0.2,
                              boundary = 0, 
                              colour = "black") +
               scale_y_continuous(limits = c(0, maxX),
                                  breaks = seq(0, maxX, breakVal), 
                                  expand = c(0, 0)) +
               scale_x_continuous(breaks = seq(-4, 4, 1),
                                  expand = c(0, 0)) +
               theme_set(theme_bw(base_size = 40) +
               ylab("Frequency")+
               xlab("")+
               coord_cartesian(xlim=c(-4, 4))+
               ggtitle(paste("n = ",n, "St Dev =", stDev,"  Normal Distribution ", sep = ' ')),

             unif =  ggplot(as.data.frame(blah), aes(x=blah))+
               geom_histogram(binwidth=0.1, boundary =0,colour = "black")+
               scale_y_continuous(limits = c(0,roundUp(maxVal*(3/stDev))),
                                  breaks=seq(0,roundUp(maxVal*(3/stDev)), roundUp(maxVal*(3/stDev))/10),
                                  expand = c(0, 0))+
               scale_x_continuous(breaks=seq(-4,4,1),expand = c(0, 0))+
               theme_set(theme_bw(base_size = 40))+
               ylab("Frequency")+xlab("")+
               coord_cartesian(xlim=c(-4,4))+
               ggtitle(paste("n = ",n, "     Uniform Distribution ", sep = ' ')),


             lnorm = ggplot(as.data.frame(blah), aes(x=blah))+
               geom_histogram(binwidth=0.2, boundary =0,colour = "black")+
               scale_y_continuous(limits = c(0,maxX),
                                  breaks=seq(0,maxX, breakVal),
                                  expand = c(0, 0))+
               scale_x_continuous(breaks=seq(0,8,1),expand = c(0, 0))+
               theme_set(theme_bw(base_size = 40))+
               ylab("Frequency")+xlab("")+
               coord_cartesian(xlim=c(0,8))+
                 ggtitle(paste("n = ",n, "     Log-Normal Distribution ", sep = ' '))
      )

    }

    observe({ 
      updateSliderInput(session, "n", 
                        step = input$stepSize,
                        max=input$maxN)
             })
    plot.dat <- reactiveValues(main=NULL, layer1=NULL)

     #plotType(data, maxVal, stDev, n, type)
    output$plot <- renderPlot({ 
                                plotType(data(),

                                switch(input$dist,
                                       norm = max((input$n)/7,1),
                                       unif = max((input$n)/50,1),
                                       lnorm =max((input$n)/8,1)
                                          ), 

                                input$stDev, 
                                input$n,
                                input$dist) })


  # Generate a summary of the data
  output$summary <- renderTable(
    as.array(round(summary(data())[c(1,4,6)],5)),
    colnames=FALSE
  )

  output$stDev <- renderTable(
    as.array(sd(data())),
    colnames=FALSE
  )

  # Generate an HTML table view of the data
  output$table <- renderTable({
    data.frame(x=data())
  })

}

我的ui.R看起来像

  library(shiny)
library(shinythemes)
library(DT)


# Define UI for random distribution application 
shinyUI(fluidPage(theme = shinytheme("slate"),

  # Application title
  headerPanel("Michael's Shiny App"),

  # Sidebar with controls to select the random distribution type
  # and number of observations to generate. Note the use of the
  # br() element to introduce extra vertical spacing
  sidebarLayout(
    sidebarPanel(
      tags$head(tags$style("#plot{height:90vh !important;}")),
      radioButtons("dist", "Distribution:",
                   c("Standard Normal" = "norm",
                     "Uniform" = "unif",
                     "Log-normal" = "lnorm")),
      br(),

      numericInput("stepSize", "Step", 1, min = 1, max = NA, step = NA,
                   width = NULL),
      numericInput("maxN", "Max Sample Size", 50, min = NA, max = NA, step = NA,
                   width = NULL),

      br(),

        sliderInput("n", 
                  "Number of observations:", 
                  value = 0,
                  min = 1, 
                  max = 120000,
                  step = 5000,
                  animate=animationOptions(interval=1200, loop=T)),

      sliderInput("stDev", 
                  "Standard Deviation:", 
                  value = 1,
                  min = 0, 
                  max = 3,
                  step = 0.1,
                  animate=animationOptions(interval=1200, loop=T)),

      p("Summary Statistics"),         
      tabPanel("Summary", tableOutput("summary")),
      p("Sample St. Dev."),
      tabPanel("Standard Dev", tableOutput("stDev")),
      width =2
    ),

    # Show a tabset that includes a plot, summary, and table view
    # of the generated distribution
    mainPanel(
      tabsetPanel(type = "tabs", 
                  tabPanel("Plot", plotOutput("plot")), 
                  tabPanel("Table", tableOutput("table"))
      ))

  )))

整个事情有很多冗余。我想做的是，一旦柱状图上最大的条形接近y上限，我希望ylimit跳到下一个10的幂。

非常感谢任何建议。

更新很容易，我最终使用的解决方案如下：在renderPlot（）函数中，您需要保存ggplot对象。然后如下所述，访问ymax值（仍在renderPlot（）中），

 ggplot_build(norm)$layout$panel_ranges[[1]]$y.range[[2]]

然后使用它来更新y轴。我使用以下功能使轴限制＆＃34;漂亮＆＃34;。

roundUpNice <- function(x, nice=c(1,2,4,5,6,8,10)) {
        10^floor(log10(x)) * nice[[which(x <= 10^floor(log10(x)) * nice)[[1]]]]
      }

然后更新y轴。（仍在renderplot（）中）

   ymaxX = roundUpNice(ggplot_build(norm)$layout$panel_ranges[[1]]$y.range[[2]])


  norm+scale_y_continuous(limits = c(0, max(ymaxX, 20)), 
                        expand=c(0,0))

Answer 1

首先，存储直方图（默认轴）。

p1 <- ggplot(...) + geom_histogram()

然后，使用ggplot_build(p1)到access the heights of the histogram bars。例如，

 set.seed(1)
 df <- data.frame(x=rnorm(10000))
 library(ggplot2)
 p1 <- ggplot(df, aes(x=x)) + geom_histogram()
 bar_max <- max(ggplot_build(p1)[['data']][[1]]$ymax) # where 1 is index 1st layer
 bar_max # returns 1042

您将需要一个函数来告诉您下一个10的幂是什么，例如：

nextPowerOfTen <- function(x) as.integer(floor(log10(x) + 1))
# example: nextPowerOfTen(999) # returns 3 (10^3=1000)

您需要检查bar_max是否在下一次10次方的某个范围内（根据您的偏好）。如果触发了调整，您只需执行p1 + scale_y_continuous(limits=c(0,y_max_new))。

Answer 2

我发现答案隐藏在＆＃34; scale_y_continuous（）＆＃34;部分代码。该应用程序非常接近，但在某些情况下，数据最大化了y轴，这使得它看起来像正如你所说的那样比轴限制运行得更远。

要解决此问题，需要将scale_y_continuous部分中的expand参数设置为＆＃34; c（0.05,0）＆＃34;，而不是＆＃34; c（0,0）＆＃34;

首先，我通过在您的应用中将样本大小设置为50并将标准偏差设置为0.3来复制您所描述的图形流失的示例。使用＆＃34; expand = c（0,0）＆＃34;运行原始代码后，我们可以看到我们得到以下图表：

通过将参数更改为＆＃34; expand = c（0.05,0）＆＃34;来解决此问题，如下所示：

有关固定脚本的副本，请参阅下文。

第1部分 - server.R

library(shiny) library(ggplot2) library(extrafont) # Define server logic for random distribution application function(input, output, session) { data <- reactive({ set.seed(123) switch(input$dist, norm = rnorm(input$n, sd = input$stDev), unif = runif(input$n,-4,4), lnorm = rlnorm(input$n) ) }) height="100%" plotType <- function(blah, maxVal, stDev, n, type){ roundUp <- function(x){10^ceiling(log10(x)+0.001)} maxX<- roundUp(maxVal) breakVal<-max(floor(maxX/10),1) switch(type, norm=ggplot(as.data.frame(blah), aes(x=blah)) + geom_histogram(binwidth = 0.2, boundary = 0, colour = "black") + scale_y_continuous(limits = c(0, maxX), breaks = seq(0, maxX, breakVal), expand = c(0.05, 0)) + scale_x_continuous(breaks = seq(-4, 4, 1), expand = c(0, 0)) + theme_set(theme_bw(base_size = 40)) + ylab("Frequency") + xlab("") + coord_cartesian(xlim=c(-4, 4))+ ggtitle(paste("n = ",n, "St Dev =", stDev, " Normal Distribution ", sep = ' ')), unif=ggplot(as.data.frame(blah), aes(x=blah)) + geom_histogram(binwidth=0.1, boundary=0, colour="black")+ scale_y_continuous( limits = c(0,roundUp(maxVal*(3/stDev))), breaks=seq(0,roundUp(maxVal*(3/stDev)), roundUp(maxVal*(3/stDev))/10), expand = c(0.05, 0))+ scale_x_continuous(breaks=seq(-4,4,1),expand=c(0, 0)) + theme_set(theme_bw(base_size = 40))+ ylab("Frequency")+xlab("")+ coord_cartesian(xlim=c(-4,4))+ ggtitle(paste("n = ",n, " Uniform Distribution ", sep = ' ')), lnorm=ggplot(as.data.frame(blah), aes(x=blah))+ geom_histogram(binwidth=0.2,boundary=0, colour="black") + scale_y_continuous(limits=c(o,maxX), breaks=seq(0,maxX, breakVal), expand = c(0.05, 0)) + scale_x_continuous(breaks=seq(0,8,1), expand = c(0, 0)) + theme_set(theme_bw(base_size = 40)) + ylab("Frequency") + xlab("") + coord_cartesian(xlim=c(0,8)) + ggtitle(paste("n = ",n, " Log-Normal Distribution ", sep = ' ')) ) } observe({ updateSliderInput(session, "n", step = input$stepSize, max=input$maxN) }) plot.dat <- reactiveValues(main=NULL, layer1=NULL) #plotType(data, maxVal, stDev, n, type) output$plot <- renderPlot({ plotType(data(), switch(input$dist, norm = max((input$n)/7,1), unif = max((input$n)/50,1), lnorm =max((input$n)/8,1) ), input$stDev, input$n, input$dist) }) # Generate a summary of the data output$summary <- renderTable( as.array(round(summary(data())[c(1,4,6)],5)), colnames=FALSE ) output$stDev <- renderTable( as.array(sd(data())), colnames=FALSE ) # Generate an HTML table view of the data output$table <- renderTable({ data.frame(x=data()) }) }

第2部分 - ui.R

library(shiny) library(shinythemes) library(DT) # Define UI for random distribution application shinyUI(fluidPage(theme = shinytheme("slate"), # Application title headerPanel("Michael's Shiny App"), # Sidebar with controls to select the random distribution type # and number of observations to generate. Note the use of the # br() element to introduce extra vertical spacing sidebarLayout( sidebarPanel( tags$head(tags$style("#plot{height:90vh !important;}")), radioButtons("dist", "Distribution:", c("Standard Normal" = "norm", "Uniform" = "unif", "Log-normal" = "lnorm")), br(), numericInput("stepSize", "Step", 1, min = 1, max = NA, step = NA, width = NULL), numericInput("maxN", "Max Sample Size", 50, min = NA, max = NA, step = NA,width = NULL), br(), sliderInput("n", "Number of observations:", value = 0, min = 1, max = 120000, step = 5000, animate=animationOptions(interval=1200, loop=T)), sliderInput("stDev","Standard Deviation:",value = 1, min = 0,max = 3,step = 0.1, animate=animationOptions(interval=1200, loop=T)), p("Summary Statistics"), tabPanel("Summary", tableOutput("summary")), p("Sample St. Dev."), tabPanel("Standard Dev", tableOutput("stDev")), width =2), # Show a tabset that includes a plot, summary, and table view # of the generated distribution mainPanel(tabsetPanel(type = "tabs", tabPanel("Plot", plotOutput("plot")), tabPanel("Table", tableOutput("table")) )) )))

更新很容易，我最终使用的解决方案如下：在renderPlot（）函数中，您需要保存ggplot对象。然后如下所述，访问ymax值（仍在renderPlot（）中），

ggplot_build(p1)$layout$panel_ranges[[1]]$y.range[[2]]

然后使用它来更新y轴。我使用以下功能使轴限制＆＃34;漂亮＆＃34;。

roundUpNice <- function(x, nice=c(1,2,4,5,6,8,10)) { if(length(x) != 1) stop("'x' must be of length 1") 10^floor(log10(x)) * nice[[which(x <= 10^floor(log10(x)) * nice)[[1]]]] }

使用ggplot和Shiny R中的geom_histogram反应更新y轴

2 个答案: