如何在shiny中里构建server生成ggplot2的图像？

我在工作中遇到实验室内部质控需要作Xbar图，写了一个ggplot2的脚本，参数可选择theme和line（散点之间的连线）。
plot.Xbar.txt (16.62 KB)

2019-3-22 21:01:24 上传

1. library(ggplot2)
   
2. source("plot.Xbar.r")
   
3. plot.Xbar(IQC_data, theme = 'economist', line = T)

复制代码

最终得到下图



在短暂的接触了shiny包后，想实现一个交互式的APP，在ui中输入一个任意矩阵，选择theme和line自动生成基于ggplot2风格的Xbar图。但水平有限，实在无能为力。希望大神指点迷津。


1、生成矩阵m（源自教科书的数据）：

1. m <- matrix(c(38, 35, 40, 34, 38, 36, 44, 43, 39, 43,
   
2.             42, 36, 42, 40, 40, 40, 43, 43, 46, 40,
   
3.             38, 43, 40, 51, 38, 33, 39, 45, 35, 39,
   
4.             34, 36, 36, 37, 36, 39, 42, 43, 46, 34),
   
5.             nr = 10,nc = 4)
   
6. colnames(m) <- LETTERS[1:4]
   
7. rownames(m) <- paste("IQC", 1:10, sep ='')

复制代码

2、通过自编函数，将matrix转换成data.frame，同时计算Xbar图的警戒上下限和处置上下限，用于ggplot2作图。

1. dataGraph <- function(matrix) {
   
2.   Parameter <- data.frame(n = 2:10,
   
3.                  Cn = c(1.253, 1.128, 1.085, 1.064, 1.051,
   
4.                         1.042, 1.036, 1.032, 1.028),
   
5.                  A2 = c(1.772, 1.303, 1.085, 0.985, 0.858,
   
6.                         0.788, 0.733, 0.688, 0.650),
   
7.                  A3 = c(2.659, 1.954, 1.628, 1.427, 1.287,
   
8.                         1.182, 1.099, 1.032, 0.975),
   
9.                  S999 = c(0.002, 0.036, 0.098, 0.160, 0.215,
   
10.                           0.263, 0.303, 0.338, 0.368),
    
11.                  S975 = c(0.039, 0.180, 0.291, 0.370, 0.428,
    
12.                           0.473, 0.509, 0.539, 0.563),
    
13.                  S25 = c(2.809, 2.167, 1.916, 1.776, 1.684,
    
14.                          1.618, 1.567, 1.527, 1.495),
    
15.                  S1 = c(4.124, 2.966, 2.527, 2.286, 2.129,
    
16.                         2.017, 1.932, 1.864, 1.809))
    
17.   Xbar <- sum(matrix)/(ncol(matrix) * nrow(matrix))
    
18.   SD <- apply(matrix, 1, sd)
    
19.   Sbar <- mean(SD)
    
20.   L1 <- Xbar + Sbar * Parameter[which(Parameter$n == ncol(matrix)), 3]  #Warning ulim
    
21.   L2 <- Xbar - Sbar * Parameter[which(Parameter$n == ncol(matrix)), 3]  #Warning dlim
    
22.   LL1 <- Xbar + Sbar * Parameter[which(Parameter$n == ncol(matrix)), 4] #Action ulim
    
23.   LL2 <- Xbar - Sbar * Parameter[which(Parameter$n == ncol(matrix)), 4] #Action dlim
    
24.   matrixGraph <- data.frame(X = 1: nrow(matrix), Y = apply(matrix, 1, mean),
    
25.                            W_ulim = rep(L1, nrow(matrix)), W_dlim = rep(L2, nrow(matrix)),
    
26.                            A_ulim = rep(LL1, nrow(matrix)), A_dlim = rep(LL2, nrow(matrix))
    
27.                            )
    
28.   return(matrixGraph)        
    
29. }

复制代码

3、构建ui和server。
此处可能需要用到shinyMatrix包

1. library(shiny)
   
2. library(shinyMatrix)
   
3. library(ggplot2)
   
4. ui <- tagList(
   
5.   fluidPage(
   
6.     titlePanel("My APP"),
   
7.     fluidRow(
   
8.       column(3, matrixInput(
   
9.         inputId = "matrix",
   
10.         value = m,
    
11.         class = "numeric",
    
12.         cols = list(
    
13.           names = TRUE,
    
14.           extend = FALSE
    
15.         ),
    
16.         rows = list(
    
17.           names = TRUE,
    
18.           extend = FALSE
    
19.         )
    
20.       )
    
21.       ),
    
22.       column(
    
23.         3,
    
24.         actionButton("button", "Update Matrix"),
    
25.         tableOutput("table")),
    
26.        mainPanel(
    
27.          plotOutput("Plot")
    
28.    )
    
29.   )
    
30. )
    
31. )
    
32.         
    
33. 
    
34. server <- function(input, output, session) {
    
35. 
    
36.   output$plot <- renderPlot({
    
37.     DataGraph <- DataGraph(input$matrix)
    
38.     p1 <- ggplot() +
    
39.           geom_point(data = DataGraph, aes(X, Y), shape = 5, size = 3)
    
40.    print(p1)
    
41.   })
    
42. 
    
43. }
    
44. 
    
45. shinyApp(ui = ui, server = server)

复制代码