我在工作中遇到实验室内部质控需要作Xbar图，写了一个ggplot2的脚本，参数可选择theme和line（散点之间的连线）。
- library(ggplot2)
- source("plot.Xbar.r")
- plot.Xbar(IQC_data, theme = 'economist', line = T)
最终得到下图
在短暂的接触了shiny包后，想实现一个交互式的APP，在ui中输入一个任意矩阵，选择theme和line自动生成基于ggplot2风格的Xbar图。但水平有限，实在无能为力。希望大神指点迷津。
1、生成矩阵m（源自教科书的数据）：
- m <- matrix(c(38, 35, 40, 34, 38, 36, 44, 43, 39, 43,
- 42, 36, 42, 40, 40, 40, 43, 43, 46, 40,
- 38, 43, 40, 51, 38, 33, 39, 45, 35, 39,
- 34, 36, 36, 37, 36, 39, 42, 43, 46, 34),
- nr = 10,nc = 4)
- colnames(m) <- LETTERS[1:4]
- rownames(m) <- paste("IQC", 1:10, sep ='')
2、通过自编函数，将matrix转换成data.frame，同时计算Xbar图的警戒上下限和处置上下限，用于ggplot2作图。
- dataGraph <- function(matrix) {
- Parameter <- data.frame(n = 2:10,
- Cn = c(1.253, 1.128, 1.085, 1.064, 1.051,
- 1.042, 1.036, 1.032, 1.028),
- A2 = c(1.772, 1.303, 1.085, 0.985, 0.858,
- 0.788, 0.733, 0.688, 0.650),
- A3 = c(2.659, 1.954, 1.628, 1.427, 1.287,
- 1.182, 1.099, 1.032, 0.975),
- S999 = c(0.002, 0.036, 0.098, 0.160, 0.215,
- 0.263, 0.303, 0.338, 0.368),
- S975 = c(0.039, 0.180, 0.291, 0.370, 0.428,
- 0.473, 0.509, 0.539, 0.563),
- S25 = c(2.809, 2.167, 1.916, 1.776, 1.684,
- 1.618, 1.567, 1.527, 1.495),
- S1 = c(4.124, 2.966, 2.527, 2.286, 2.129,
- 2.017, 1.932, 1.864, 1.809))
- Xbar <- sum(matrix)/(ncol(matrix) * nrow(matrix))
- SD <- apply(matrix, 1, sd)
- Sbar <- mean(SD)
- L1 <- Xbar + Sbar * Parameter[which(Parameter$n == ncol(matrix)), 3]#Warning ulim
- L2 <- Xbar - Sbar * Parameter[which(Parameter$n == ncol(matrix)), 3]#Warning dlim
- LL1 <- Xbar + Sbar * Parameter[which(Parameter$n == ncol(matrix)), 4] #Action ulim
- LL2 <- Xbar - Sbar * Parameter[which(Parameter$n == ncol(matrix)), 4] #Action dlim
- matrixGraph <- data.frame(X = 1: nrow(matrix), Y = apply(matrix, 1, mean),
- W_ulim = rep(L1, nrow(matrix)), W_dlim = rep(L2, nrow(matrix)),
- A_ulim = rep(LL1, nrow(matrix)), A_dlim = rep(LL2, nrow(matrix))
- )
- return(matrixGraph)
- }
3、构建ui和server。
此处可能需要用到shinyMatrix包
- library(shiny)
- library(shinyMatrix)
- library(ggplot2)
- ui <- tagList(
- fluidPage(
- titlePanel("My APP"),
- fluidRow(
- column(3, matrixInput(
- inputId = "matrix",
- value = m,
- class = "numeric",
- cols = list(
- names = TRUE,
- extend = FALSE
- ),
- rows = list(
- names = TRUE,
- extend = FALSE
- )
- )
- ),
- column(
- 3,
- actionButton("button", "Update Matrix"),
- tableOutput("table")),
- mainPanel(
- plotOutput("Plot")
- )
- )
- )
- )
-
- server <- function(input, output, session) {
- output$plot <- renderPlot({
- DataGraph <- DataGraph(input$matrix)
- p1 <- ggplot() +
- geom_point(data = DataGraph, aes(X, Y), shape = 5, size = 3)
- print(p1)
- })
- }
- shinyApp(ui = ui, server = server)
|
熟悉论坛请点击新手指南
京公网安备 11010802022788号
论坛法律顾问：王进律师
知识产权保护声明
免责及隐私声明
