R-直方图中的交互/动态绘图,数据被采样

时间:2018-05-14 06:43:29

标签: r plot ggplot2 plotly

我正在使用Sequential Monte Carlo,我希望可视化我正在处理的数据如何在被采样时分发。因此,我考虑创建动态/交互式绘图,以说明采样数据的开发。

我试图查看Google上的第一个搜索匹配,但乍一看,他们没有做我打算做的事情。 相反,我考虑过写一个带有延迟的for循环,但这就是我对一些已经存在的包的期望,包括一些重复机制。

我认为必须有人在那里,他们想过创建相同的交互式情节,这样可以减少对所用方法的理解。

总结一下几句话,我希望得到X_t的直方图t进展。

1 个答案:

答案 0 :(得分:1)

查看shiny包,它允许您制作小型网络应用程序。我构建了一些用于教授蒙特卡罗模拟的应用程序。关于着名报童模特的一个app就是这种直方图。

报童模型应用程序的代码(包含直方图):

server.R

library(ggplot2)

function(input, output, session) {
  output$demand <- renderPlot({
    set.seed(1)
    values <- round(runif(input$nr_of_runs, min(input$demand_range), max(input$demand_range)))
    demand <- as.data.frame(values)
    ggplot(demand, aes(x = values)) +
      geom_histogram(aes(y= ..count..), binwidth = 1, col = I("white"), fill = "forestgreen") +
      xlim(c(0,200)) + xlab("No. of newspapers demanded") +
      ylab("Counts") +
      ggtitle("Probability-Distribution of Demand") +
      theme_classic() + theme(axis.text.y = element_text(size = 15, colour = "forestgreen"),
                              axis.title.y = element_text(size = 15, colour = "forestgreen"),
                              axis.text.x = element_text(size = 15),
                              axis.title.x = element_text(size = 15),
                              plot.title = element_text(size = 20))
  })

  output$sales <- renderPlot({
    set.seed(1)
    values <- round(runif(input$nr_of_runs, min(input$demand_range), max(input$demand_range)))
    demand <- as.data.frame(values)

    profit <- data.frame(nr_of_newspapers_bought = numeric(200), mean_profit = numeric(200))
    prize_buy <- min(input$prize)
    prize_sell <- max(input$prize)
    for(bought in 1:200) {
      sold <- pmin(bought, demand$values)
      profits <- sold*prize_sell - bought*prize_buy
      profit$nr_of_newspapers_bought[bought] <- bought
      profit$mean_profit[bought] <- mean(profits)
    }
    ggplot(profit, aes(nr_of_newspapers_bought)) + geom_line(aes(y = mean_profit)) +
      xlim(c(0,200)) + ggtitle("Profit depending on newspapers sold") +
      xlab("No. of newspapers sold") + ylab("Mean profit")  +
      theme_classic() + theme(axis.text = element_text(size = 15),
                              axis.title = element_text(size = 15),
                              plot.title = element_text(size = 20)) +
      geom_vline(aes(xintercept = which.max(mean_profit)), color = "red", linetype = "dashed", size = 1) +
      geom_hline(aes(yintercept = max(mean_profit)), color = "red", linetype = "dashed", size = 1) +
      annotate("text", label = which.max(profit$mean_profit), x = 7 + which.max(profit$mean_profit),
               y = 10 + min(profit$mean_profit), size = 8, colour = "red") +
      annotate("text", label = round(max(profit$mean_profit),2), x = 0,
               y = max(profit$mean_profit) - 0.1*(max(profit$mean_profit) - min(profit$mean_profit)),
               size = 8, colour = "red")
  })

}

ui.R

fluidPage(
  headerPanel('Newsboy Model with Monte Carlo Simulation'),
  sidebarPanel(
    sliderInput('nr_of_runs', 'Nr of runs', 1,
                 min = 1, max = 10000, step = 1, animate = TRUE),
    sliderInput('prize', 'Prize (buy and sell)', c(1, 1.5),
                min = 0, max = 10, step = 0.1),
    sliderInput('demand_range', 'Demand Range (min and max)', c(100, 190), min = 0, max = 200)
    ),
  mainPanel(
    plotOutput('demand'),
    plotOutput('sales')
  )
)

以下单文件闪亮应用程序生成随机数据,然后将其添加到直方图中,运行次数增加。

# sample data outside loop because of reactivity
n <- 1000
data <- runif(n)


# Define the UI
ui <- bootstrapPage(
  sliderInput('nr_of_samples', 'Nr of samples', 1,
              min = 1, max = n, step = 1, animate = TRUE),
  plotOutput('hist')
)

# Define the server code
server <- function(input, output) {
  output$hist <- renderPlot({
    hist(data[1:input$nr_of_samples], breaks = 5, xlim = c(0,1))
  })
}

# Return a Shiny app object
shinyApp(ui = ui, server = server)