R/server.r
In curryhilton/spm: Statistical Process Measurement
library(shiny)
options(shiny.maxRequestSize = 9*1024^2)
shinyServer(
function(input, output){
data <- reactive({
# input$file1 will be NULL initially. After the user selects
# and uploads a file, it will be a data frame with 'name',
# 'size', 'type', and 'datapath' columns. The 'datapath'
# column will contain the local filenames where the data can
# be found.
inFile <- input$file1
if (is.null(inFile))
return(NULL)
read.csv(inFile$datapath, header = input$header,
sep = input$sep, quote = input$quote)
})
dfx <- reactive({
x <- data()[,1]
})
dfr <- reactive({
r <- data()[,2]
})
dfs <- reactive({
s <- data()[,2]
})
dfx2 <- reactive({
x2 <- data()[,3]
})
dfp2 <- reactive({
p2 <- data()[,2]
})
dfc2 <- reactive({
c2 <- data()[,2]
})
dfm <- reactive({
m <- length(dfx())
})
output$file <- renderTable({
if(is.null(data())){return()}
input$file1
})
output$sum <- renderPrint({
if(is.null(data())){return()}
summary(data())
})
output$table <- renderTable({
if(is.null(data())){return()}
data()
})
output$chart_type_text <- renderText({
input$chart
})
output$hist <- renderPlot({
if(is.null(dfx())){return()}
boxplot(dfx(), main = "Charting Statistic", xlab = "Charting Statistic", horizontal = T)
})
output$plot <- renderPlot({
if(is.null(data())){return()}
if(input$chart == "Shewhart X-Bar Chart, Standards Given") {
mu <- as.numeric(input$mu)
sd <- as.numeric(input$sd)
L <- as.numeric(input$l)
n <- as.numeric(input$n)
A <- L/(sqrt(n))
cl <- mu
uclx <- cl + A*sd
lclx <- max(cl - A*sd,0)
m <- seq(1:dfm())
x <- dfx()
size <- paste("Subgroup Size =", n)
LCL <- paste("LCL =", round(lclx, 2))
CL <- paste("Center Line", round(cl, 2))
UCL <- paste("UCL =", round(uclx, 2))
sub <- paste("Subgroups =", length(m))
stdev <- paste("Standard Deviation =", round(sd, 2))
count <- paste("Violations =", length(which(x > uclx | x < lclx)))
par(bg="lightsteelblue2", mar = c(10, 5, 2, 2))
plot(m, x, xlab = "Subgroups", ylab = "X-bar", ylim = c(min(x) - sd, max(x) + sd))
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = "white")
abline(h = cl, lwd = 2)
abline(h = uclx, col = "red", lty = 2)
abline(h = lclx, col = "red", lty = 2)
points(x, pch = 20, type = "b", col = ifelse(x > uclx | x < lclx, "red", "black"))
mtext(size, at = m[1] + 1, side = 1, line = 5, adj = 0, font = 2)
mtext(LCL, at = m[1] + 1, side = 1, line = 6, adj = 0, font = 2)
mtext(CL, at = m[1] + 1, side = 1, line = 7, adj = 0, font = 2)
mtext(UCL, at = m[1] + 1, side = 1, line = 8, adj = 0, font = 2)
mtext(stdev, at = m[length(m)] - 1, side = 1, line = 5, adj = 1, font = 2)
mtext(sub, at = m[length(m)] - 1, side = 1, line = 6, adj = 1, font = 2)
mtext(count, at = m[length(m)] - 1, side = 1, line = 7, adj = 1, font = 2)
} else if (input$chart == "Shewhart X-Bar Chart (R), No Standards Given") {
L <- as.numeric(input$l)
n <- as.numeric(input$n)
m <- seq(1:dfm())
x <- dfx() # define x as x in reactive expression
x2 <- dfx2()
r <- dfr() # define r as r in reactive expression
rbar <- mean(r) # calculate r-bar based on ranges of subgroups
d2 <- c(1.128, 1.693, 2.059, 2.326, 2.534, # define d2 control chart parameters
2.704, 2.847, 2.970, 3.078, 3.173, # Montgomery's textbook
3.258, 3.336, 3.407, 3.472, 3.532,
3.588, 3.640, 3.689, 3.735, 3.778,
3.819, 3.858, 3.895, 3.931)
A2 <- L/(d2[n-1]*sqrt(n)) # calculate control chart parameter A2
cl <- mean(x) # calculate centerline of x-bar chart based on mean of subgroups
uclx <- cl + A2*rbar # calculate upper control chart limit for x-bar chart
lclx <- cl - A2*rbar # calculate lower control chart limit for x-bar chart
sd <- rbar/d2[n-1] # calculate sd
size <- paste("Subgroup Size =", n)
LCL <- paste("LCL =", round(lclx, 2))
CL <- paste("Center Line", round(cl, 2))
UCL <- paste("UCL =", round(uclx, 2))
sub <- paste("Subgroups =", length(m))
stdev <- paste("Standard Deviation =", round(sd, 2))
count <- paste("Violations =", length(which(x2 > uclx | x2 < lclx)))
par(bg="lightsteelblue2", mar = c(10, 5, 2, 2))
plot(m, x2, xlab = "Subgroups", ylab = "X-bar", pch = 7, type = "b", ylim = c(min(x2) - rbar, max(x2) + rbar))
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = "white")
abline(h = cl, lwd = 2)
abline(h = uclx, col = "red", lty = 2)
abline(h = lclx, col = "red", lty = 2)
points(x2, pch = 20, type = "b", col = ifelse(x2 > uclx | x2 < lclx, "red", "black"))
mtext(size, at = m[1] + 1, side = 1, line = 5, adj = 0, font = 2)
mtext(LCL, at = m[1] + 1, side = 1, line = 6, adj = 0, font = 2)
mtext(CL, at = m[1] + 1, side = 1, line = 7, adj = 0, font = 2)
mtext(UCL, at = m[1] + 1, side = 1, line = 8, adj = 0, font = 2)
mtext(stdev, at = m[length(m)] - 1, side = 1, line = 5, adj = 1, font = 2)
mtext(sub, at = m[length(m)] - 1, side = 1, line = 6, adj = 1, font = 2)
mtext(count, at = m[length(m)] - 1, side = 1, line = 7, adj = 1, font = 2)
} else if (input$chart == "Shewhart X-Bar Chart (s), No Standards Given") {
L <- as.numeric(input$l)
n <- as.numeric(input$n)
m <- seq(1:dfm())
x <- dfx() # define x as x in reactive expression
x2 <- dfx2()
s <- dfs() # define s as s in reactive expression
sbar <- mean(s) # calculate s-bar based on sd of subgroups
c4 <- (4*(n-1))/(4*n-3) # calculate control chart constant c4
cl <- mean(x) # calculate x-bar baed on mean of subgroups
uclx <- cl + (L*sbar)/(c4*sqrt(n)) # calculate upper control chart limit for x-bar chart
lclx <- cl - (L*sbar)/(c4*sqrt(n)) # calculate lower control chart limit for x-bar chart
sd <- sbar/c4 # calculate process sd
size <- paste("Subgroup Size =", n)
LCL <- paste("LCL =", round(lclx, 2))
CL <- paste("Center Line", round(cl, 2))
UCL <- paste("UCL =", round(uclx, 2))
sub <- paste("Subgroups =", length(m))
stdev <- paste("Standard Deviation =", round(sd, 2))
count <- paste("Violations =", length(which(x > uclx | x < lclx)))
par(bg="lightsteelblue2", mar = c(10, 5, 2, 2))
plot(m, x, xlab = "Subgroups", ylab = "X-bar", pch = 7, type = "b", ylim = c(min(x) - sbar, max(x) + sbar))
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = "white")
abline(h = cl, lwd = 2)
abline(h = uclx, col = "red", lty = 2)
abline(h = lclx, col = "red", lty = 2)
points(x, pch = 20, type = "b", col = ifelse(x > uclx | x < lclx, "red", "black"))
mtext(size, at = m[1] + 1, side = 1, line = 5, adj = 0, font = 2)
mtext(LCL, at = m[1] + 1, side = 1, line = 6, adj = 0, font = 2)
mtext(CL, at = m[1] + 1, side = 1, line = 7, adj = 0, font = 2)
mtext(UCL, at = m[1] + 1, side = 1, line = 8, adj = 0, font = 2)
mtext(stdev, at = m[length(m)] - 1, side = 1, line = 5, adj = 1, font = 2)
mtext(sub, at = m[length(m)] - 1, side = 1, line = 6, adj = 1, font = 2)
mtext(count, at = m[length(m)] - 1, side = 1, line = 7, adj = 1, font = 2)
} else if (input$chart == "R Chart, Standards Given") {
r <- as.numeric(input$r)
L <- as.numeric(input$l)
n <- as.numeric(input$n)
m <- seq(1:dfm())
r2 <- dfx() # define x as r in reactive expression
d2 <- c(1.128, 1.693, 2.059, 2.326, 2.534, # define d2 control chart parameters
2.704, 2.847, 2.970, 3.078, 3.173, # Montgomery's textbook
3.258, 3.336, 3.407, 3.472, 3.532,
3.588, 3.640, 3.689, 3.735, 3.778,
3.819, 3.858, 3.895, 3.931)
d3 <- c(0.853, 0.888, 0.880, 0.864, 0.848, # define d3 control chart parameters
0.833, 0.820, 0.808, 0.797, 0.787, # Montgomery's textbook
0.778, 0.770, 0.763, 0.756, 0.750,
0.744, 0.739, 0.734, 0.729, 0.724,
0.720, 0.716, 0.712, 0.708)
D1 = d2[n-1] - L*d3[n-1] # calculate control chart constant D1
D2 = d2[n-1] + L*d3[n-1] # calculate control chart constant D2
cl <- d2[n-1]*r # calculate centerline of R-bar chart
uclr <- D2*r # calculate upper control chart limit for R-bar chart
lclr <- max(D1*r, 0) # calculate lower control chart limit for R-bar chart
size <- paste("Subgroup Size =", n)
LCL <- paste("LCL =", round(lclr, 2))
CL <- paste("Center Line", round(cl, 2))
UCL <- paste("UCL =", round(uclr, 2))
sub <- paste("Subgroups =", length(m))
stdev <- paste("Standard Deviation =", round(sd, 2))
count <- paste("Violations =", length(which(r > uclr | r < lclr)))
par(bg="lightsteelblue2", mar = c(10, 5, 2, 2))
plot(m, r2, xlab = "Subgroups", ylab = "X-bar", pch = 7, type = "b", ylim = c(min(r2) - r, max(r2) + r))
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = "white")
abline(h = cl, lwd = 2)
abline(h = uclr, col = "red", lty = 2)
abline(h = lclr, col = "red", lty = 2)
points(r2, pch = 20, type = "b", col = ifelse(r2 > uclr | r2 < lclr, "red", "black"))
mtext(size, at = m[1] + 1, side = 1, line = 5, adj = 0, font = 2)
mtext(LCL, at = m[1] + 1, side = 1, line = 6, adj = 0, font = 2)
mtext(CL, at = m[1] + 1, side = 1, line = 7, adj = 0, font = 2)
mtext(UCL, at = m[1] + 1, side = 1, line = 8, adj = 0, font = 2)
mtext(stdev, at = m[length(m)] - 1, side = 1, line = 5, adj = 1, font = 2)
mtext(sub, at = m[length(m)] - 1, side = 1, line = 6, adj = 1, font = 2)
mtext(count, at = m[length(m)] - 1, side = 1, line = 7, adj = 1, font = 2)
} else if (input$chart == "R Chart, No Standards Given") {
L <- as.numeric(input$l)
n <- as.numeric(input$n)
m <- seq(1:dfm())
r <- dfx()
r <- dfr()
d2 <- c(1.128, 1.693, 2.059, 2.326, 2.534, # define d2 control chart parameters
2.704, 2.847, 2.970, 3.078, 3.173, # Montgomery's textbook
3.258, 3.336, 3.407, 3.472, 3.532,
3.588, 3.640, 3.689, 3.735, 3.778,
3.819, 3.858, 3.895, 3.931)
d3 <- c(0.853, 0.888, 0.880, 0.864, 0.848, # define d3 control chart parameters
0.833, 0.820, 0.808, 0.797, 0.787, # Montgomery's textbook
0.778, 0.770, 0.763, 0.756, 0.750,
0.744, 0.739, 0.734, 0.729, 0.724,
0.720, 0.716, 0.712, 0.708)
D3 = 1-L*(d3[n-1]/d2[n-1]) # calculate control chart constant D3
D4 = 1+L*(d3[n-1]/d2[n-1]) # calculate control chart constant D4
cl <- mean(r) # calculate centerline of R-bar chart
uclr <- D4*cl # calculate upper control chart limit for R-bar chart
lclr <- max(D3*cl, 0) # calculate lower control chart limit for R-bar chart
sd <- cl/d2[n-1]
size <- paste("Subgroup Size =", n)
LCL <- paste("LCL =", round(lclr, 2))
CL <- paste("Center Line", round(cl, 2))
UCL <- paste("UCL =", round(uclr, 2))
sub <- paste("Subgroups =", length(m))
stdev <- paste("Standard Deviation =", round(sd, 2))
count <- paste("Violations =", length(which(r > uclr | r < lclr)))
par(bg="lightsteelblue2", mar = c(10, 5, 2, 2))
plot(m, r, xlab = "Subgroups", ylab = "X-bar", pch = 7, type = "b", ylim = c(min(r) - sd, max(r) + sd))
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = "white")
abline(h = cl, lwd = 2)
abline(h = uclr, col = "red", lty = 2)
abline(h = lclr, col = "red", lty = 2)
points(r, pch = 20, type = "b", col = ifelse(r > uclr | r < lclr, "red", "black"))
mtext(size, at = m[1] + 1, side = 1, line = 5, adj = 0, font = 2)
mtext(LCL, at = m[1] + 1, side = 1, line = 6, adj = 0, font = 2)
mtext(CL, at = m[1] + 1, side = 1, line = 7, adj = 0, font = 2)
mtext(UCL, at = m[1] + 1, side = 1, line = 8, adj = 0, font = 2)
mtext(stdev, at = m[length(m)] - 1, side = 1, line = 5, adj = 1, font = 2)
mtext(sub, at = m[length(m)] - 1, side = 1, line = 6, adj = 1, font = 2)
mtext(count, at = m[length(m)] - 1, side = 1, line = 7, adj = 1, font = 2)
} else if (input$chart == "s Chart, Standards Given") {
sd <- as.numeric(input$sd)
L <- as.numeric(input$l)
n <- as.numeric(input$n)
s <- dfx()
s2 <- dfs()
m <- seq(1:dfm())
c4 <- (4*(n-1))/(4*n-3) # calculate control chart constant c4
cl <- c4*sd # calculate centerline of the s chart
ucls <- c4*sd + L*sd*sqrt(1-c4^2) # calculate upper control chart limit for the s chart
lcls <- max(c4*sd - L*sd*sqrt(1-c4^2), 0) # calculate lower control chart limit for the s chart
size <- paste("Subgroup Size =", n)
LCL <- paste("LCL =", round(lcls, 2))
CL <- paste("Center Line", round(cl, 2))
UCL <- paste("UCL =", round(ucls, 2))
sub <- paste("Subgroups =", length(m))
stdev <- paste("Standard Deviation =", round(sd, 2))
count <- paste("Violations =", length(which(s > ucls | s < lcls)))
par(bg="lightsteelblue2", mar = c(10, 5, 2, 2))
plot(m, s, xlab = "Subgroups", ylab = "s", pch = 7, type = "b", ylim = c(min(s) - sd, max(s) + sd))
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = "white")
abline(h = cl, lwd = 2)
abline(h = ucls, col = "red", lty = 2)
abline(h = lcls, col = "red", lty = 2)
points(s, pch = 20, type = "b", col = ifelse(s > ucls | s < lcls, "red", "black"))
mtext(size, at = m[1] + 1, side = 1, line = 5, adj = 0, font = 2)
mtext(LCL, at = m[1] + 1, side = 1, line = 6, adj = 0, font = 2)
mtext(CL, at = m[1] + 1, side = 1, line = 7, adj = 0, font = 2)
mtext(UCL, at = m[1] + 1, side = 1, line = 8, adj = 0, font = 2)
mtext(stdev, at = m[length(m)] - 1, side = 1, line = 5, adj = 1, font = 2)
mtext(sub, at = m[length(m)] - 1, side = 1, line = 6, adj = 1, font = 2)
mtext(count, at = m[length(m)] - 1, side = 1, line = 7, adj = 1, font = 2)
} else if (input$chart == "s Chart, No Standards Given") {
L <- as.numeric(input$l)
n <- as.numeric(input$n)
s <- dfx()
s2 <- dfs()
m <- seq(1:dfm())
c4 <- (4*(n-1))/(4*n-3) # calculate control chart constant c4
B3 = 1-(L/c4)*(sqrt(1-c4^2)) # calculate control chart constant B3
B4 = 1+(L/c4)*(sqrt(1-c4^2)) # calculate control chart constant B4
cl <- mean(s) # calculate centerline of s chart
ucls <- B4*cl # calculate upper control chart limit for s chart
lcls <- max(B3*cl, 0) # calculate lower control chart limit for s chart
sd <- cl/c4 # calculate standard deviation for porcess data
size <- paste("Subgroup Size =", n)
LCL <- paste("LCL =", round(lcls, 2))
CL <- paste("Center Line", round(cl, 2))
UCL <- paste("UCL =", round(ucls, 2))
sub <- paste("Subgroups =", length(m))
stdev <- paste("Standard Deviation =", round(sd, 2))
count <- paste("Violations =", length(which(s > ucls | s < lcls)))
par(bg="lightsteelblue2", mar = c(10, 5, 2, 2))
plot(m, s, xlab = "Subgroups", ylab = "s", pch = 7, type = "b", ylim = c(min(s) - sd, max(s) + sd))
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = "white")
abline(h = cl, lwd = 2)
abline(h = ucls, col = "red", lty = 2)
abline(h = lcls, col = "red", lty = 2)
points(s, pch = 20, type = "b", col = ifelse(s > ucls | s < lcls, "red", "black"))
mtext(size, at = m[1] + 1, side = 1, line = 5, adj = 0, font = 2)
mtext(LCL, at = m[1] + 1, side = 1, line = 6, adj = 0, font = 2)
mtext(CL, at = m[1] + 1, side = 1, line = 7, adj = 0, font = 2)
mtext(UCL, at = m[1] + 1, side = 1, line = 8, adj = 0, font = 2)
mtext(stdev, at = m[length(m)] - 1, side = 1, line = 5, adj = 1, font = 2)
mtext(sub, at = m[length(m)] - 1, side = 1, line = 6, adj = 1, font = 2)
mtext(count, at = m[length(m)] - 1, side = 1, line = 7, adj = 1, font = 2)
} else if (input$chart == "p Chart, Standards Given") {
mu <- as.numeric(input$mu)
L <- as.numeric(input$l)
n <- as.numeric(input$n)
p <- dfx()
p2 <- dfp2()
m <- seq(1:dfm())
cl <- mu # define p based on user input
uclp <- cl + L*sqrt((cl*(1-cl))/n) # calculate upper control chart limit for p chart
lclp <- max(cl - L*sqrt((cl*(1-cl))/n), 0) # calculate lower control chart limit for p chart
sd <- sd(p)
size <- paste("Subgroup Size =", n)
LCL <- paste("LCL =", round(lclp, 2))
CL <- paste("Center Line", round(cl, 2))
UCL <- paste("UCL =", round(uclp, 2))
sub <- paste("Subgroups =", length(m))
stdev <- paste("Standard Deviation =", round(sd, 2))
count <- paste("Violations =", length(which(p > uclp | p < lclp)))
par(bg="lightsteelblue2", mar = c(10, 5, 2, 2))
plot(m, p, xlab = "Subgroups", ylab = "p", pch = 7, type = "b", ylim = c(min(p) - 3*sd, max(p) + 3*sd))
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = "white")
abline(h = cl, lwd = 2)
abline(h = uclp, col = "red", lty = 2)
abline(h = lclp, col = "red", lty = 2)
points(p, pch = 20, type = "b", col = ifelse(p > uclp | p < lclp, "red", "black"))
mtext(size, at = m[1] + 1, side = 1, line = 5, adj = 0, font = 2)
mtext(LCL, at = m[1] + 1, side = 1, line = 6, adj = 0, font = 2)
mtext(CL, at = m[1] + 1, side = 1, line = 7, adj = 0, font = 2)
mtext(UCL, at = m[1] + 1, side = 1, line = 8, adj = 0, font = 2)
mtext(stdev, at = m[length(m)] - 1, side = 1, line = 5, adj = 1, font = 2)
mtext(sub, at = m[length(m)] - 1, side = 1, line = 6, adj = 1, font = 2)
mtext(count, at = m[length(m)] - 1, side = 1, line = 7, adj = 1, font = 2)
} else if (input$chart == "p Chart, No Standards Given") {
L <- as.numeric(input$l)
n <- as.numeric(input$n)
p <- dfx()
p2 <- dfp2()
m <- seq(1:dfm())
cl <- mean(p) # define p based on user input
uclp <- cl + L*sqrt((cl*(1-cl))/n) # calculate upper control chart limit for p chart
lclp <- max(cl - L*sqrt((cl*(1-cl))/n), 0) # calculate lower control chart limit for p chart
sd <- sd(p)
size <- paste("Subgroup Size =", n)
LCL <- paste("LCL =", round(lclp, 2))
CL <- paste("Center Line", round(cl, 2))
UCL <- paste("UCL =", round(uclp, 2))
sub <- paste("Subgroups =", length(m))
stdev <- paste("Standard Deviation =", round(sd, 2))
count <- paste("Violations =", length(which(p > uclp | p < lclp)))
par(bg="lightsteelblue2", mar = c(10, 5, 2, 2))
plot(m, p, xlab = "Subgroups", ylab = "p", pch = 7, type = "b", ylim = c(min(p) - 3*sd, max(p) + 3*sd))
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = "white")
abline(h = cl, lwd = 2)
abline(h = uclp, col = "red", lty = 2)
abline(h = lclp, col = "red", lty = 2)
points(p, pch = 20, type = "b", col = ifelse(p > uclp | p < lclp, "red", "black"))
mtext(size, at = m[1] + 1, side = 1, line = 5, adj = 0, font = 2)
mtext(LCL, at = m[1] + 1, side = 1, line = 6, adj = 0, font = 2)
mtext(CL, at = m[1] + 1, side = 1, line = 7, adj = 0, font = 2)
mtext(UCL, at = m[1] + 1, side = 1, line = 8, adj = 0, font = 2)
mtext(stdev, at = m[length(m)] - 1, side = 1, line = 5, adj = 1, font = 2)
mtext(sub, at = m[length(m)] - 1, side = 1, line = 6, adj = 1, font = 2)
mtext(count, at = m[length(m)] - 1, side = 1, line = 7, adj = 1, font = 2)
} else if (input$chart == "np Chart, Standards Given") {
mu <- as.numeric(input$mu)
L <- as.numeric(input$l)
n <- as.numeric(input$n)
np <- n*dfx()
np2 <- n*dfp2()
m <- seq(1:dfm())
cl <- n*mu
uclnp <- cl + L*sqrt(cl*(1-mu)) # calculate upper control chart limit for np chart
lclnp <- max(cl - L*sqrt(cl*(1-mu)), 0) # calculate lower control chart limit for np chart
sd <- sd(np)
size <- paste("Subgroup Size =", n)
LCL <- paste("LCL =", round(lclnp, 2))
CL <- paste("Center Line", round(cl, 2))
UCL <- paste("UCL =", round(uclnp, 2))
sub <- paste("Subgroups =", length(m))
stdev <- paste("Standard Deviation =", round(sd, 2))
count <- paste("Violations =", length(which(np > uclnp | np < lclnp)))
par(bg="lightsteelblue2", mar = c(10, 5, 2, 2))
plot(m, np, xlab = "Subgroups", ylab = "np", pch = 7, type = "b", ylim = c(min(np) - sd, max(np) + sd))
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = "white")
abline(h = cl, lwd = 2)
abline(h = uclnp, col = "red", lty = 2)
abline(h = lclnp, col = "red", lty = 2)
points(np, pch = 20, type = "b", col = ifelse(np > uclnp | np < lclnp, "red", "black"))
mtext(size, at = m[1] + 1, side = 1, line = 5, adj = 0, font = 2)
mtext(LCL, at = m[1] + 1, side = 1, line = 6, adj = 0, font = 2)
mtext(CL, at = m[1] + 1, side = 1, line = 7, adj = 0, font = 2)
mtext(UCL, at = m[1] + 1, side = 1, line = 8, adj = 0, font = 2)
mtext(stdev, at = m[length(m)] - 1, side = 1, line = 5, adj = 1, font = 2)
mtext(sub, at = m[length(m)] - 1, side = 1, line = 6, adj = 1, font = 2)
mtext(count, at = m[length(m)] - 1, side = 1, line = 7, adj = 1, font = 2)
} else if (input$chart == "np Chart, No Standards Given") {
L <- as.numeric(input$l)
n <- as.numeric(input$n)
p <- dfx()
np <- n*p
np2 <- n*dfp2()
m <- seq(1:dfm())
cl <- mean(np)
uclnp <- cl + L*sqrt(cl*(1-mean(p))) # calculate upper control chart limit for np chart
lclnp <- max(cl - L*sqrt(cl*(1-mean(p))), 0) # calculate lower control chart limit for np chart
sd <- sd(np)
size <- paste("Subgroup Size =", n)
LCL <- paste("LCL =", round(lclnp, 2))
CL <- paste("Center Line", round(cl, 2))
UCL <- paste("UCL =", round(uclnp, 2))
sub <- paste("Subgroups =", length(m))
stdev <- paste("Standard Deviation =", round(sd, 2))
count <- paste("Violations =", length(which(np > uclnp | np < lclnp)))
par(bg="lightsteelblue2", mar = c(10, 5, 2, 2))
plot(m, np, xlab = "Subgroups", ylab = "np", pch = 7, type = "b", ylim = c(min(np) - sd, max(np) + sd))
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = "white")
abline(h = cl, lwd = 2)
abline(h = uclnp, col = "red", lty = 2)
abline(h = lclnp, col = "red", lty = 2)
points(np, pch = 20, type = "b", col = ifelse(np > uclnp | np < lclnp, "red", "black"))
mtext(size, at = m[1] + 1, side = 1, line = 5, adj = 0, font = 2)
mtext(LCL, at = m[1] + 1, side = 1, line = 6, adj = 0, font = 2)
mtext(CL, at = m[1] + 1, side = 1, line = 7, adj = 0, font = 2)
mtext(UCL, at = m[1] + 1, side = 1, line = 8, adj = 0, font = 2)
mtext(stdev, at = m[length(m)] - 1, side = 1, line = 5, adj = 1, font = 2)
mtext(sub, at = m[length(m)] - 1, side = 1, line = 6, adj = 1, font = 2)
mtext(count, at = m[length(m)] - 1, side = 1, line = 7, adj = 1, font = 2)
} else if (input$chart == "c Chart, Standards Given") {
mu <- as.numeric(input$mu)
L <- as.numeric(input$l)
n <- as.numeric(input$n)
c <- dfx()
c2 <- dfc2()
m <- seq(1:dfm())
cl <- mu # define c
uclc <- cl + L*sqrt(cl) # calculate upper control chart limit for c chart
lclc <- cl - L*sqrt(cl) # calculate lower control chart limit for c chart
sd <- sd(c)
size <- paste("Subgroup Size =", n)
LCL <- paste("LCL =", round(lclc, 2))
CL <- paste("Center Line", round(cl, 2))
UCL <- paste("UCL =", round(uclc, 2))
sub <- paste("Subgroups =", length(m))
stdev <- paste("Standard Deviation =", round(sd, 2))
count <- paste("Violations =", length(which(c > uclc | c < lclc)))
par(bg="lightsteelblue2", mar = c(10, 5, 2, 2))
plot(m, c, xlab = "Subgroups", ylab = "c", pch = 7, type = "b", ylim = c(min(c) - sd, max(c) + sd))
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = "white")
abline(h = cl, lwd = 2)
abline(h = uclc, col = "red", lty = 2)
abline(h = lclc, col = "red", lty = 2)
points(c, pch = 20, type = "b", col = ifelse(c > uclc | c < lclc, "red", "black"))
mtext(size, at = m[1] + 1, side = 1, line = 5, adj = 0, font = 2)
mtext(LCL, at = m[1] + 1, side = 1, line = 6, adj = 0, font = 2)
mtext(CL, at = m[1] + 1, side = 1, line = 7, adj = 0, font = 2)
mtext(UCL, at = m[1] + 1, side = 1, line = 8, adj = 0, font = 2)
mtext(stdev, at = m[length(m)] - 1, side = 1, line = 5, adj = 1, font = 2)
mtext(sub, at = m[length(m)] - 1, side = 1, line = 6, adj = 1, font = 2)
mtext(count, at = m[length(m)] - 1, side = 1, line = 7, adj = 1, font = 2)
} else if (input$chart == "c Chart, No Standards Given") {
L <- as.numeric(input$l)
n <- as.numeric(input$n)
c <- dfx()
c2 <- dfc2()
m <- seq(1:dfm())
cl <- mean(c) # define c
uclc <- cl + L*sqrt(cl) # calculate upper control chart limit for c chart
lclc <- cl - L*sqrt(cl) # calculate lower control chart limit for c chart
sd <- sd(c)
size <- paste("Subgroup Size =", n)
LCL <- paste("LCL =", round(lclc, 2))
CL <- paste("Center Line", round(cl, 2))
UCL <- paste("UCL =", round(uclc, 2))
sub <- paste("Subgroups =", length(m))
stdev <- paste("Standard Deviation =", round(sd, 2))
count <- paste("Violations =", length(which(c > uclc | c < lclc)))
par(bg="lightsteelblue2", mar = c(10, 5, 2, 2))
plot(m, c, xlab = "Subgroups", ylab = "c", pch = 7, type = "b", ylim = c(min(c) - sd, max(c) + sd))
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = "white")
abline(h = cl, lwd = 2)
abline(h = uclc, col = "red", lty = 2)
abline(h = lclc, col = "red", lty = 2)
points(c, pch = 20, type = "b", col = ifelse(c > uclc | c < lclc, "red", "black"))
mtext(size, at = m[1] + 1, side = 1, line = 5, adj = 0, font = 2)
mtext(LCL, at = m[1] + 1, side = 1, line = 6, adj = 0, font = 2)
mtext(CL, at = m[1] + 1, side = 1, line = 7, adj = 0, font = 2)
mtext(UCL, at = m[1] + 1, side = 1, line = 8, adj = 0, font = 2)
mtext(stdev, at = m[length(m)] - 1, side = 1, line = 5, adj = 1, font = 2)
mtext(sub, at = m[length(m)] - 1, side = 1, line = 6, adj = 1, font = 2)
mtext(count, at = m[length(m)] - 1, side = 1, line = 7, adj = 1, font = 2)
} else if (input$chart == "Shewhart X-Bar Chart (MR), No Standards Given") {
L <- as.numeric(input$l)
n <- as.numeric(input$n)
m <- seq(1:dfm())
x <- dfx() # define x as x in reactive expression
x2 <- dfr()
mr <- rep(NA, n) # function for MR
for(j in 1:n+1){
mr[j] = abs(x[j]-x[j-1])
}
mrbar <- mean(mr, na.rm = T) # calculate the mean of MR
d2 <- c(1.128, 1.693, 2.059, 2.326, 2.534, # define d2 control chart parameters
2.704, 2.847, 2.970, 3.078, 3.173, # Montgomery's textbook
3.258, 3.336, 3.407, 3.472, 3.532,
3.588, 3.640, 3.689, 3.735, 3.778,
3.819, 3.858, 3.895, 3.931)
cl <- mean(x) # calculate the centerline for the IMR chart
uclmr <- cl + L*(mrbar/d2[n-1]) # calculate upper control chart limit for IMR chart
lclmr <- cl - L*(mrbar/d2[n-1]) # calculate lower control chart limit for IMR chart
sd <- sd(x)
size <- paste("Subgroup Size =", n)
LCL <- paste("LCL =", round(lclmr, 2))
CL <- paste("Center Line", round(cl, 2))
UCL <- paste("UCL =", round(uclmr, 2))
sub <- paste("Subgroups =", length(m))
stdev <- paste("Standard Deviation =", round(sd, 2))
count <- paste("Violations =", length(which(x > uclmr | x < lclmr)))
par(bg="lightsteelblue2", mar = c(10, 5, 2, 2))
plot(m, x, xlab = "Subgroups", ylab = "X-bar", pch = 7, type = "b", ylim = c(min(x) - mrbar, max(x) + mrbar))
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = "white")
abline(h = cl, lwd = 2)
abline(h = uclmr, col = "red", lty = 2)
abline(h = lclmr, col = "red", lty = 2)
points(x, pch = 20, type = "b", col = ifelse(x > uclmr | x < lclmr, "red", "black"))
mtext(size, at = m[1] + 1, side = 1, line = 5, adj = 0, font = 2)
mtext(LCL, at = m[1] + 1, side = 1, line = 6, adj = 0, font = 2)
mtext(CL, at = m[1] + 1, side = 1, line = 7, adj = 0, font = 2)
mtext(UCL, at = m[1] + 1, side = 1, line = 8, adj = 0, font = 2)
mtext(stdev, at = m[length(m)] - 1, side = 1, line = 5, adj = 1, font = 2)
mtext(sub, at = m[length(m)] - 1, side = 1, line = 6, adj = 1, font = 2)
mtext(count, at = m[length(m)] - 1, side = 1, line = 7, adj = 1, font = 2)
} else if (input$chart == "EWMA Chart, Target Given") {
#plot()
} else if (input$chart == "CUSUM Chart, Target Given") {
#plot()
}
})
}
)
curryhilton/spm documentation built on May 14, 2019, 12:51 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
library(shiny)
options(shiny.maxRequestSize = 9*1024^2)
shinyServer(
function(input, output){
data <- reactive({
# input$file1 will be NULL initially. After the user selects
# and uploads a file, it will be a data frame with 'name',
# 'size', 'type', and 'datapath' columns. The 'datapath'
# column will contain the local filenames where the data can
# be found.
inFile <- input$file1
if (is.null(inFile))
return(NULL)
read.csv(inFile$datapath, header = input$header,
sep = input$sep, quote = input$quote)
})
dfx <- reactive({
x <- data()[,1]
})
dfr <- reactive({
r <- data()[,2]
})
dfs <- reactive({
s <- data()[,2]
})
dfx2 <- reactive({
x2 <- data()[,3]
})
dfp2 <- reactive({
p2 <- data()[,2]
})
dfc2 <- reactive({
c2 <- data()[,2]
})
dfm <- reactive({
m <- length(dfx())
})
output$file <- renderTable({
if(is.null(data())){return()}
input$file1
})
output$sum <- renderPrint({
if(is.null(data())){return()}
summary(data())
})
output$table <- renderTable({
if(is.null(data())){return()}
data()
})
output$chart_type_text <- renderText({
input$chart
})
output$hist <- renderPlot({
if(is.null(dfx())){return()}
boxplot(dfx(), main = "Charting Statistic", xlab = "Charting Statistic", horizontal = T)
})
output$plot <- renderPlot({
if(is.null(data())){return()}
if(input$chart == "Shewhart X-Bar Chart, Standards Given") {
mu <- as.numeric(input$mu)
sd <- as.numeric(input$sd)
L <- as.numeric(input$l)
n <- as.numeric(input$n)
A <- L/(sqrt(n))
cl <- mu
uclx <- cl + A*sd
lclx <- max(cl - A*sd,0)
m <- seq(1:dfm())
x <- dfx()
size <- paste("Subgroup Size =", n)
LCL <- paste("LCL =", round(lclx, 2))
CL <- paste("Center Line", round(cl, 2))
UCL <- paste("UCL =", round(uclx, 2))
sub <- paste("Subgroups =", length(m))
stdev <- paste("Standard Deviation =", round(sd, 2))
count <- paste("Violations =", length(which(x > uclx | x < lclx)))
par(bg="lightsteelblue2", mar = c(10, 5, 2, 2))
plot(m, x, xlab = "Subgroups", ylab = "X-bar", ylim = c(min(x) - sd, max(x) + sd))
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = "white")
abline(h = cl, lwd = 2)
abline(h = uclx, col = "red", lty = 2)
abline(h = lclx, col = "red", lty = 2)
points(x, pch = 20, type = "b", col = ifelse(x > uclx | x < lclx, "red", "black"))
mtext(size, at = m[1] + 1, side = 1, line = 5, adj = 0, font = 2)
mtext(LCL, at = m[1] + 1, side = 1, line = 6, adj = 0, font = 2)
mtext(CL, at = m[1] + 1, side = 1, line = 7, adj = 0, font = 2)
mtext(UCL, at = m[1] + 1, side = 1, line = 8, adj = 0, font = 2)
mtext(stdev, at = m[length(m)] - 1, side = 1, line = 5, adj = 1, font = 2)
mtext(sub, at = m[length(m)] - 1, side = 1, line = 6, adj = 1, font = 2)
mtext(count, at = m[length(m)] - 1, side = 1, line = 7, adj = 1, font = 2)
} else if (input$chart == "Shewhart X-Bar Chart (R), No Standards Given") {
L <- as.numeric(input$l)
n <- as.numeric(input$n)
m <- seq(1:dfm())
x <- dfx() # define x as x in reactive expression
x2 <- dfx2()
r <- dfr() # define r as r in reactive expression
rbar <- mean(r) # calculate r-bar based on ranges of subgroups
d2 <- c(1.128, 1.693, 2.059, 2.326, 2.534, # define d2 control chart parameters
2.704, 2.847, 2.970, 3.078, 3.173, # Montgomery's textbook
3.258, 3.336, 3.407, 3.472, 3.532,
3.588, 3.640, 3.689, 3.735, 3.778,
3.819, 3.858, 3.895, 3.931)
A2 <- L/(d2[n-1]*sqrt(n)) # calculate control chart parameter A2
cl <- mean(x) # calculate centerline of x-bar chart based on mean of subgroups
uclx <- cl + A2*rbar # calculate upper control chart limit for x-bar chart
lclx <- cl - A2*rbar # calculate lower control chart limit for x-bar chart
sd <- rbar/d2[n-1] # calculate sd
size <- paste("Subgroup Size =", n)
LCL <- paste("LCL =", round(lclx, 2))
CL <- paste("Center Line", round(cl, 2))
UCL <- paste("UCL =", round(uclx, 2))
sub <- paste("Subgroups =", length(m))
stdev <- paste("Standard Deviation =", round(sd, 2))
count <- paste("Violations =", length(which(x2 > uclx | x2 < lclx)))
par(bg="lightsteelblue2", mar = c(10, 5, 2, 2))
plot(m, x2, xlab = "Subgroups", ylab = "X-bar", pch = 7, type = "b", ylim = c(min(x2) - rbar, max(x2) + rbar))
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = "white")
abline(h = cl, lwd = 2)
abline(h = uclx, col = "red", lty = 2)
abline(h = lclx, col = "red", lty = 2)
points(x2, pch = 20, type = "b", col = ifelse(x2 > uclx | x2 < lclx, "red", "black"))
mtext(size, at = m[1] + 1, side = 1, line = 5, adj = 0, font = 2)
mtext(LCL, at = m[1] + 1, side = 1, line = 6, adj = 0, font = 2)
mtext(CL, at = m[1] + 1, side = 1, line = 7, adj = 0, font = 2)
mtext(UCL, at = m[1] + 1, side = 1, line = 8, adj = 0, font = 2)
mtext(stdev, at = m[length(m)] - 1, side = 1, line = 5, adj = 1, font = 2)
mtext(sub, at = m[length(m)] - 1, side = 1, line = 6, adj = 1, font = 2)
mtext(count, at = m[length(m)] - 1, side = 1, line = 7, adj = 1, font = 2)
} else if (input$chart == "Shewhart X-Bar Chart (s), No Standards Given") {
L <- as.numeric(input$l)
n <- as.numeric(input$n)
m <- seq(1:dfm())
x <- dfx() # define x as x in reactive expression
x2 <- dfx2()
s <- dfs() # define s as s in reactive expression
sbar <- mean(s) # calculate s-bar based on sd of subgroups
c4 <- (4*(n-1))/(4*n-3) # calculate control chart constant c4
cl <- mean(x) # calculate x-bar baed on mean of subgroups
uclx <- cl + (L*sbar)/(c4*sqrt(n)) # calculate upper control chart limit for x-bar chart
lclx <- cl - (L*sbar)/(c4*sqrt(n)) # calculate lower control chart limit for x-bar chart
sd <- sbar/c4 # calculate process sd
size <- paste("Subgroup Size =", n)
LCL <- paste("LCL =", round(lclx, 2))
CL <- paste("Center Line", round(cl, 2))
UCL <- paste("UCL =", round(uclx, 2))
sub <- paste("Subgroups =", length(m))
stdev <- paste("Standard Deviation =", round(sd, 2))
count <- paste("Violations =", length(which(x > uclx | x < lclx)))
par(bg="lightsteelblue2", mar = c(10, 5, 2, 2))
plot(m, x, xlab = "Subgroups", ylab = "X-bar", pch = 7, type = "b", ylim = c(min(x) - sbar, max(x) + sbar))
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = "white")
abline(h = cl, lwd = 2)
abline(h = uclx, col = "red", lty = 2)
abline(h = lclx, col = "red", lty = 2)
points(x, pch = 20, type = "b", col = ifelse(x > uclx | x < lclx, "red", "black"))
mtext(size, at = m[1] + 1, side = 1, line = 5, adj = 0, font = 2)
mtext(LCL, at = m[1] + 1, side = 1, line = 6, adj = 0, font = 2)
mtext(CL, at = m[1] + 1, side = 1, line = 7, adj = 0, font = 2)
mtext(UCL, at = m[1] + 1, side = 1, line = 8, adj = 0, font = 2)
mtext(stdev, at = m[length(m)] - 1, side = 1, line = 5, adj = 1, font = 2)
mtext(sub, at = m[length(m)] - 1, side = 1, line = 6, adj = 1, font = 2)
mtext(count, at = m[length(m)] - 1, side = 1, line = 7, adj = 1, font = 2)
} else if (input$chart == "R Chart, Standards Given") {
r <- as.numeric(input$r)
L <- as.numeric(input$l)
n <- as.numeric(input$n)
m <- seq(1:dfm())
r2 <- dfx() # define x as r in reactive expression
d2 <- c(1.128, 1.693, 2.059, 2.326, 2.534, # define d2 control chart parameters
2.704, 2.847, 2.970, 3.078, 3.173, # Montgomery's textbook
3.258, 3.336, 3.407, 3.472, 3.532,
3.588, 3.640, 3.689, 3.735, 3.778,
3.819, 3.858, 3.895, 3.931)
d3 <- c(0.853, 0.888, 0.880, 0.864, 0.848, # define d3 control chart parameters
0.833, 0.820, 0.808, 0.797, 0.787, # Montgomery's textbook
0.778, 0.770, 0.763, 0.756, 0.750,
0.744, 0.739, 0.734, 0.729, 0.724,
0.720, 0.716, 0.712, 0.708)
D1 = d2[n-1] - L*d3[n-1] # calculate control chart constant D1
D2 = d2[n-1] + L*d3[n-1] # calculate control chart constant D2
cl <- d2[n-1]*r # calculate centerline of R-bar chart
uclr <- D2*r # calculate upper control chart limit for R-bar chart
lclr <- max(D1*r, 0) # calculate lower control chart limit for R-bar chart
size <- paste("Subgroup Size =", n)
LCL <- paste("LCL =", round(lclr, 2))
CL <- paste("Center Line", round(cl, 2))
UCL <- paste("UCL =", round(uclr, 2))
sub <- paste("Subgroups =", length(m))
stdev <- paste("Standard Deviation =", round(sd, 2))
count <- paste("Violations =", length(which(r > uclr | r < lclr)))
par(bg="lightsteelblue2", mar = c(10, 5, 2, 2))
plot(m, r2, xlab = "Subgroups", ylab = "X-bar", pch = 7, type = "b", ylim = c(min(r2) - r, max(r2) + r))
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = "white")
abline(h = cl, lwd = 2)
abline(h = uclr, col = "red", lty = 2)
abline(h = lclr, col = "red", lty = 2)
points(r2, pch = 20, type = "b", col = ifelse(r2 > uclr | r2 < lclr, "red", "black"))
mtext(size, at = m[1] + 1, side = 1, line = 5, adj = 0, font = 2)
mtext(LCL, at = m[1] + 1, side = 1, line = 6, adj = 0, font = 2)
mtext(CL, at = m[1] + 1, side = 1, line = 7, adj = 0, font = 2)
mtext(UCL, at = m[1] + 1, side = 1, line = 8, adj = 0, font = 2)
mtext(stdev, at = m[length(m)] - 1, side = 1, line = 5, adj = 1, font = 2)
mtext(sub, at = m[length(m)] - 1, side = 1, line = 6, adj = 1, font = 2)
mtext(count, at = m[length(m)] - 1, side = 1, line = 7, adj = 1, font = 2)
} else if (input$chart == "R Chart, No Standards Given") {
L <- as.numeric(input$l)
n <- as.numeric(input$n)
m <- seq(1:dfm())
r <- dfx()
r <- dfr()
d2 <- c(1.128, 1.693, 2.059, 2.326, 2.534, # define d2 control chart parameters
2.704, 2.847, 2.970, 3.078, 3.173, # Montgomery's textbook
3.258, 3.336, 3.407, 3.472, 3.532,
3.588, 3.640, 3.689, 3.735, 3.778,
3.819, 3.858, 3.895, 3.931)
d3 <- c(0.853, 0.888, 0.880, 0.864, 0.848, # define d3 control chart parameters
0.833, 0.820, 0.808, 0.797, 0.787, # Montgomery's textbook
0.778, 0.770, 0.763, 0.756, 0.750,
0.744, 0.739, 0.734, 0.729, 0.724,
0.720, 0.716, 0.712, 0.708)
D3 = 1-L*(d3[n-1]/d2[n-1]) # calculate control chart constant D3
D4 = 1+L*(d3[n-1]/d2[n-1]) # calculate control chart constant D4
cl <- mean(r) # calculate centerline of R-bar chart
uclr <- D4*cl # calculate upper control chart limit for R-bar chart
lclr <- max(D3*cl, 0) # calculate lower control chart limit for R-bar chart
sd <- cl/d2[n-1]
size <- paste("Subgroup Size =", n)
LCL <- paste("LCL =", round(lclr, 2))
CL <- paste("Center Line", round(cl, 2))
UCL <- paste("UCL =", round(uclr, 2))
sub <- paste("Subgroups =", length(m))
stdev <- paste("Standard Deviation =", round(sd, 2))
count <- paste("Violations =", length(which(r > uclr | r < lclr)))
par(bg="lightsteelblue2", mar = c(10, 5, 2, 2))
plot(m, r, xlab = "Subgroups", ylab = "X-bar", pch = 7, type = "b", ylim = c(min(r) - sd, max(r) + sd))
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = "white")
abline(h = cl, lwd = 2)
abline(h = uclr, col = "red", lty = 2)
abline(h = lclr, col = "red", lty = 2)
points(r, pch = 20, type = "b", col = ifelse(r > uclr | r < lclr, "red", "black"))
mtext(size, at = m[1] + 1, side = 1, line = 5, adj = 0, font = 2)
mtext(LCL, at = m[1] + 1, side = 1, line = 6, adj = 0, font = 2)
mtext(CL, at = m[1] + 1, side = 1, line = 7, adj = 0, font = 2)
mtext(UCL, at = m[1] + 1, side = 1, line = 8, adj = 0, font = 2)
mtext(stdev, at = m[length(m)] - 1, side = 1, line = 5, adj = 1, font = 2)
mtext(sub, at = m[length(m)] - 1, side = 1, line = 6, adj = 1, font = 2)
mtext(count, at = m[length(m)] - 1, side = 1, line = 7, adj = 1, font = 2)
} else if (input$chart == "s Chart, Standards Given") {
sd <- as.numeric(input$sd)
L <- as.numeric(input$l)
n <- as.numeric(input$n)
s <- dfx()
s2 <- dfs()
m <- seq(1:dfm())
c4 <- (4*(n-1))/(4*n-3) # calculate control chart constant c4
cl <- c4*sd # calculate centerline of the s chart
ucls <- c4*sd + L*sd*sqrt(1-c4^2) # calculate upper control chart limit for the s chart
lcls <- max(c4*sd - L*sd*sqrt(1-c4^2), 0) # calculate lower control chart limit for the s chart
size <- paste("Subgroup Size =", n)
LCL <- paste("LCL =", round(lcls, 2))
CL <- paste("Center Line", round(cl, 2))
UCL <- paste("UCL =", round(ucls, 2))
sub <- paste("Subgroups =", length(m))
stdev <- paste("Standard Deviation =", round(sd, 2))
count <- paste("Violations =", length(which(s > ucls | s < lcls)))
par(bg="lightsteelblue2", mar = c(10, 5, 2, 2))
plot(m, s, xlab = "Subgroups", ylab = "s", pch = 7, type = "b", ylim = c(min(s) - sd, max(s) + sd))
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = "white")
abline(h = cl, lwd = 2)
abline(h = ucls, col = "red", lty = 2)
abline(h = lcls, col = "red", lty = 2)
points(s, pch = 20, type = "b", col = ifelse(s > ucls | s < lcls, "red", "black"))
mtext(size, at = m[1] + 1, side = 1, line = 5, adj = 0, font = 2)
mtext(LCL, at = m[1] + 1, side = 1, line = 6, adj = 0, font = 2)
mtext(CL, at = m[1] + 1, side = 1, line = 7, adj = 0, font = 2)
mtext(UCL, at = m[1] + 1, side = 1, line = 8, adj = 0, font = 2)
mtext(stdev, at = m[length(m)] - 1, side = 1, line = 5, adj = 1, font = 2)
mtext(sub, at = m[length(m)] - 1, side = 1, line = 6, adj = 1, font = 2)
mtext(count, at = m[length(m)] - 1, side = 1, line = 7, adj = 1, font = 2)
} else if (input$chart == "s Chart, No Standards Given") {
L <- as.numeric(input$l)
n <- as.numeric(input$n)
s <- dfx()
s2 <- dfs()
m <- seq(1:dfm())
c4 <- (4*(n-1))/(4*n-3) # calculate control chart constant c4
B3 = 1-(L/c4)*(sqrt(1-c4^2)) # calculate control chart constant B3
B4 = 1+(L/c4)*(sqrt(1-c4^2)) # calculate control chart constant B4
cl <- mean(s) # calculate centerline of s chart
ucls <- B4*cl # calculate upper control chart limit for s chart
lcls <- max(B3*cl, 0) # calculate lower control chart limit for s chart
sd <- cl/c4 # calculate standard deviation for porcess data
size <- paste("Subgroup Size =", n)
LCL <- paste("LCL =", round(lcls, 2))
CL <- paste("Center Line", round(cl, 2))
UCL <- paste("UCL =", round(ucls, 2))
sub <- paste("Subgroups =", length(m))
stdev <- paste("Standard Deviation =", round(sd, 2))
count <- paste("Violations =", length(which(s > ucls | s < lcls)))
par(bg="lightsteelblue2", mar = c(10, 5, 2, 2))
plot(m, s, xlab = "Subgroups", ylab = "s", pch = 7, type = "b", ylim = c(min(s) - sd, max(s) + sd))
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = "white")
abline(h = cl, lwd = 2)
abline(h = ucls, col = "red", lty = 2)
abline(h = lcls, col = "red", lty = 2)
points(s, pch = 20, type = "b", col = ifelse(s > ucls | s < lcls, "red", "black"))
mtext(size, at = m[1] + 1, side = 1, line = 5, adj = 0, font = 2)
mtext(LCL, at = m[1] + 1, side = 1, line = 6, adj = 0, font = 2)
mtext(CL, at = m[1] + 1, side = 1, line = 7, adj = 0, font = 2)
mtext(UCL, at = m[1] + 1, side = 1, line = 8, adj = 0, font = 2)
mtext(stdev, at = m[length(m)] - 1, side = 1, line = 5, adj = 1, font = 2)
mtext(sub, at = m[length(m)] - 1, side = 1, line = 6, adj = 1, font = 2)
mtext(count, at = m[length(m)] - 1, side = 1, line = 7, adj = 1, font = 2)
} else if (input$chart == "p Chart, Standards Given") {
mu <- as.numeric(input$mu)
L <- as.numeric(input$l)
n <- as.numeric(input$n)
p <- dfx()
p2 <- dfp2()
m <- seq(1:dfm())
cl <- mu # define p based on user input
uclp <- cl + L*sqrt((cl*(1-cl))/n) # calculate upper control chart limit for p chart
lclp <- max(cl - L*sqrt((cl*(1-cl))/n), 0) # calculate lower control chart limit for p chart
sd <- sd(p)
size <- paste("Subgroup Size =", n)
LCL <- paste("LCL =", round(lclp, 2))
CL <- paste("Center Line", round(cl, 2))
UCL <- paste("UCL =", round(uclp, 2))
sub <- paste("Subgroups =", length(m))
stdev <- paste("Standard Deviation =", round(sd, 2))
count <- paste("Violations =", length(which(p > uclp | p < lclp)))
par(bg="lightsteelblue2", mar = c(10, 5, 2, 2))
plot(m, p, xlab = "Subgroups", ylab = "p", pch = 7, type = "b", ylim = c(min(p) - 3*sd, max(p) + 3*sd))
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = "white")
abline(h = cl, lwd = 2)
abline(h = uclp, col = "red", lty = 2)
abline(h = lclp, col = "red", lty = 2)
points(p, pch = 20, type = "b", col = ifelse(p > uclp | p < lclp, "red", "black"))
mtext(size, at = m[1] + 1, side = 1, line = 5, adj = 0, font = 2)
mtext(LCL, at = m[1] + 1, side = 1, line = 6, adj = 0, font = 2)
mtext(CL, at = m[1] + 1, side = 1, line = 7, adj = 0, font = 2)
mtext(UCL, at = m[1] + 1, side = 1, line = 8, adj = 0, font = 2)
mtext(stdev, at = m[length(m)] - 1, side = 1, line = 5, adj = 1, font = 2)
mtext(sub, at = m[length(m)] - 1, side = 1, line = 6, adj = 1, font = 2)
mtext(count, at = m[length(m)] - 1, side = 1, line = 7, adj = 1, font = 2)
} else if (input$chart == "p Chart, No Standards Given") {
L <- as.numeric(input$l)
n <- as.numeric(input$n)
p <- dfx()
p2 <- dfp2()
m <- seq(1:dfm())
cl <- mean(p) # define p based on user input
uclp <- cl + L*sqrt((cl*(1-cl))/n) # calculate upper control chart limit for p chart
lclp <- max(cl - L*sqrt((cl*(1-cl))/n), 0) # calculate lower control chart limit for p chart
sd <- sd(p)
size <- paste("Subgroup Size =", n)
LCL <- paste("LCL =", round(lclp, 2))
CL <- paste("Center Line", round(cl, 2))
UCL <- paste("UCL =", round(uclp, 2))
sub <- paste("Subgroups =", length(m))
stdev <- paste("Standard Deviation =", round(sd, 2))
count <- paste("Violations =", length(which(p > uclp | p < lclp)))
par(bg="lightsteelblue2", mar = c(10, 5, 2, 2))
plot(m, p, xlab = "Subgroups", ylab = "p", pch = 7, type = "b", ylim = c(min(p) - 3*sd, max(p) + 3*sd))
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = "white")
abline(h = cl, lwd = 2)
abline(h = uclp, col = "red", lty = 2)
abline(h = lclp, col = "red", lty = 2)
points(p, pch = 20, type = "b", col = ifelse(p > uclp | p < lclp, "red", "black"))
mtext(size, at = m[1] + 1, side = 1, line = 5, adj = 0, font = 2)
mtext(LCL, at = m[1] + 1, side = 1, line = 6, adj = 0, font = 2)
mtext(CL, at = m[1] + 1, side = 1, line = 7, adj = 0, font = 2)
mtext(UCL, at = m[1] + 1, side = 1, line = 8, adj = 0, font = 2)
mtext(stdev, at = m[length(m)] - 1, side = 1, line = 5, adj = 1, font = 2)
mtext(sub, at = m[length(m)] - 1, side = 1, line = 6, adj = 1, font = 2)
mtext(count, at = m[length(m)] - 1, side = 1, line = 7, adj = 1, font = 2)
} else if (input$chart == "np Chart, Standards Given") {
mu <- as.numeric(input$mu)
L <- as.numeric(input$l)
n <- as.numeric(input$n)
np <- n*dfx()
np2 <- n*dfp2()
m <- seq(1:dfm())
cl <- n*mu
uclnp <- cl + L*sqrt(cl*(1-mu)) # calculate upper control chart limit for np chart
lclnp <- max(cl - L*sqrt(cl*(1-mu)), 0) # calculate lower control chart limit for np chart
sd <- sd(np)
size <- paste("Subgroup Size =", n)
LCL <- paste("LCL =", round(lclnp, 2))
CL <- paste("Center Line", round(cl, 2))
UCL <- paste("UCL =", round(uclnp, 2))
sub <- paste("Subgroups =", length(m))
stdev <- paste("Standard Deviation =", round(sd, 2))
count <- paste("Violations =", length(which(np > uclnp | np < lclnp)))
par(bg="lightsteelblue2", mar = c(10, 5, 2, 2))
plot(m, np, xlab = "Subgroups", ylab = "np", pch = 7, type = "b", ylim = c(min(np) - sd, max(np) + sd))
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = "white")
abline(h = cl, lwd = 2)
abline(h = uclnp, col = "red", lty = 2)
abline(h = lclnp, col = "red", lty = 2)
points(np, pch = 20, type = "b", col = ifelse(np > uclnp | np < lclnp, "red", "black"))
mtext(size, at = m[1] + 1, side = 1, line = 5, adj = 0, font = 2)
mtext(LCL, at = m[1] + 1, side = 1, line = 6, adj = 0, font = 2)
mtext(CL, at = m[1] + 1, side = 1, line = 7, adj = 0, font = 2)
mtext(UCL, at = m[1] + 1, side = 1, line = 8, adj = 0, font = 2)
mtext(stdev, at = m[length(m)] - 1, side = 1, line = 5, adj = 1, font = 2)
mtext(sub, at = m[length(m)] - 1, side = 1, line = 6, adj = 1, font = 2)
mtext(count, at = m[length(m)] - 1, side = 1, line = 7, adj = 1, font = 2)
} else if (input$chart == "np Chart, No Standards Given") {
L <- as.numeric(input$l)
n <- as.numeric(input$n)
p <- dfx()
np <- n*p
np2 <- n*dfp2()
m <- seq(1:dfm())
cl <- mean(np)
uclnp <- cl + L*sqrt(cl*(1-mean(p))) # calculate upper control chart limit for np chart
lclnp <- max(cl - L*sqrt(cl*(1-mean(p))), 0) # calculate lower control chart limit for np chart
sd <- sd(np)
size <- paste("Subgroup Size =", n)
LCL <- paste("LCL =", round(lclnp, 2))
CL <- paste("Center Line", round(cl, 2))
UCL <- paste("UCL =", round(uclnp, 2))
sub <- paste("Subgroups =", length(m))
stdev <- paste("Standard Deviation =", round(sd, 2))
count <- paste("Violations =", length(which(np > uclnp | np < lclnp)))
par(bg="lightsteelblue2", mar = c(10, 5, 2, 2))
plot(m, np, xlab = "Subgroups", ylab = "np", pch = 7, type = "b", ylim = c(min(np) - sd, max(np) + sd))
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = "white")
abline(h = cl, lwd = 2)
abline(h = uclnp, col = "red", lty = 2)
abline(h = lclnp, col = "red", lty = 2)
points(np, pch = 20, type = "b", col = ifelse(np > uclnp | np < lclnp, "red", "black"))
mtext(size, at = m[1] + 1, side = 1, line = 5, adj = 0, font = 2)
mtext(LCL, at = m[1] + 1, side = 1, line = 6, adj = 0, font = 2)
mtext(CL, at = m[1] + 1, side = 1, line = 7, adj = 0, font = 2)
mtext(UCL, at = m[1] + 1, side = 1, line = 8, adj = 0, font = 2)
mtext(stdev, at = m[length(m)] - 1, side = 1, line = 5, adj = 1, font = 2)
mtext(sub, at = m[length(m)] - 1, side = 1, line = 6, adj = 1, font = 2)
mtext(count, at = m[length(m)] - 1, side = 1, line = 7, adj = 1, font = 2)
} else if (input$chart == "c Chart, Standards Given") {
mu <- as.numeric(input$mu)
L <- as.numeric(input$l)
n <- as.numeric(input$n)
c <- dfx()
c2 <- dfc2()
m <- seq(1:dfm())
cl <- mu # define c
uclc <- cl + L*sqrt(cl) # calculate upper control chart limit for c chart
lclc <- cl - L*sqrt(cl) # calculate lower control chart limit for c chart
sd <- sd(c)
size <- paste("Subgroup Size =", n)
LCL <- paste("LCL =", round(lclc, 2))
CL <- paste("Center Line", round(cl, 2))
UCL <- paste("UCL =", round(uclc, 2))
sub <- paste("Subgroups =", length(m))
stdev <- paste("Standard Deviation =", round(sd, 2))
count <- paste("Violations =", length(which(c > uclc | c < lclc)))
par(bg="lightsteelblue2", mar = c(10, 5, 2, 2))
plot(m, c, xlab = "Subgroups", ylab = "c", pch = 7, type = "b", ylim = c(min(c) - sd, max(c) + sd))
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = "white")
abline(h = cl, lwd = 2)
abline(h = uclc, col = "red", lty = 2)
abline(h = lclc, col = "red", lty = 2)
points(c, pch = 20, type = "b", col = ifelse(c > uclc | c < lclc, "red", "black"))
mtext(size, at = m[1] + 1, side = 1, line = 5, adj = 0, font = 2)
mtext(LCL, at = m[1] + 1, side = 1, line = 6, adj = 0, font = 2)
mtext(CL, at = m[1] + 1, side = 1, line = 7, adj = 0, font = 2)
mtext(UCL, at = m[1] + 1, side = 1, line = 8, adj = 0, font = 2)
mtext(stdev, at = m[length(m)] - 1, side = 1, line = 5, adj = 1, font = 2)
mtext(sub, at = m[length(m)] - 1, side = 1, line = 6, adj = 1, font = 2)
mtext(count, at = m[length(m)] - 1, side = 1, line = 7, adj = 1, font = 2)
} else if (input$chart == "c Chart, No Standards Given") {
L <- as.numeric(input$l)
n <- as.numeric(input$n)
c <- dfx()
c2 <- dfc2()
m <- seq(1:dfm())
cl <- mean(c) # define c
uclc <- cl + L*sqrt(cl) # calculate upper control chart limit for c chart
lclc <- cl - L*sqrt(cl) # calculate lower control chart limit for c chart
sd <- sd(c)
size <- paste("Subgroup Size =", n)
LCL <- paste("LCL =", round(lclc, 2))
CL <- paste("Center Line", round(cl, 2))
UCL <- paste("UCL =", round(uclc, 2))
sub <- paste("Subgroups =", length(m))
stdev <- paste("Standard Deviation =", round(sd, 2))
count <- paste("Violations =", length(which(c > uclc | c < lclc)))
par(bg="lightsteelblue2", mar = c(10, 5, 2, 2))
plot(m, c, xlab = "Subgroups", ylab = "c", pch = 7, type = "b", ylim = c(min(c) - sd, max(c) + sd))
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = "white")
abline(h = cl, lwd = 2)
abline(h = uclc, col = "red", lty = 2)
abline(h = lclc, col = "red", lty = 2)
points(c, pch = 20, type = "b", col = ifelse(c > uclc | c < lclc, "red", "black"))
mtext(size, at = m[1] + 1, side = 1, line = 5, adj = 0, font = 2)
mtext(LCL, at = m[1] + 1, side = 1, line = 6, adj = 0, font = 2)
mtext(CL, at = m[1] + 1, side = 1, line = 7, adj = 0, font = 2)
mtext(UCL, at = m[1] + 1, side = 1, line = 8, adj = 0, font = 2)
mtext(stdev, at = m[length(m)] - 1, side = 1, line = 5, adj = 1, font = 2)
mtext(sub, at = m[length(m)] - 1, side = 1, line = 6, adj = 1, font = 2)
mtext(count, at = m[length(m)] - 1, side = 1, line = 7, adj = 1, font = 2)
} else if (input$chart == "Shewhart X-Bar Chart (MR), No Standards Given") {
L <- as.numeric(input$l)
n <- as.numeric(input$n)
m <- seq(1:dfm())
x <- dfx() # define x as x in reactive expression
x2 <- dfr()
mr <- rep(NA, n) # function for MR
for(j in 1:n+1){
mr[j] = abs(x[j]-x[j-1])
}
mrbar <- mean(mr, na.rm = T) # calculate the mean of MR
d2 <- c(1.128, 1.693, 2.059, 2.326, 2.534, # define d2 control chart parameters
2.704, 2.847, 2.970, 3.078, 3.173, # Montgomery's textbook
3.258, 3.336, 3.407, 3.472, 3.532,
3.588, 3.640, 3.689, 3.735, 3.778,
3.819, 3.858, 3.895, 3.931)
cl <- mean(x) # calculate the centerline for the IMR chart
uclmr <- cl + L*(mrbar/d2[n-1]) # calculate upper control chart limit for IMR chart
lclmr <- cl - L*(mrbar/d2[n-1]) # calculate lower control chart limit for IMR chart
sd <- sd(x)
size <- paste("Subgroup Size =", n)
LCL <- paste("LCL =", round(lclmr, 2))
CL <- paste("Center Line", round(cl, 2))
UCL <- paste("UCL =", round(uclmr, 2))
sub <- paste("Subgroups =", length(m))
stdev <- paste("Standard Deviation =", round(sd, 2))
count <- paste("Violations =", length(which(x > uclmr | x < lclmr)))
par(bg="lightsteelblue2", mar = c(10, 5, 2, 2))
plot(m, x, xlab = "Subgroups", ylab = "X-bar", pch = 7, type = "b", ylim = c(min(x) - mrbar, max(x) + mrbar))
rect(par("usr")[1], par("usr")[3], par("usr")[2], par("usr")[4], col = "white")
abline(h = cl, lwd = 2)
abline(h = uclmr, col = "red", lty = 2)
abline(h = lclmr, col = "red", lty = 2)
points(x, pch = 20, type = "b", col = ifelse(x > uclmr | x < lclmr, "red", "black"))
mtext(size, at = m[1] + 1, side = 1, line = 5, adj = 0, font = 2)
mtext(LCL, at = m[1] + 1, side = 1, line = 6, adj = 0, font = 2)
mtext(CL, at = m[1] + 1, side = 1, line = 7, adj = 0, font = 2)
mtext(UCL, at = m[1] + 1, side = 1, line = 8, adj = 0, font = 2)
mtext(stdev, at = m[length(m)] - 1, side = 1, line = 5, adj = 1, font = 2)
mtext(sub, at = m[length(m)] - 1, side = 1, line = 6, adj = 1, font = 2)
mtext(count, at = m[length(m)] - 1, side = 1, line = 7, adj = 1, font = 2)
} else if (input$chart == "EWMA Chart, Target Given") {
#plot()
} else if (input$chart == "CUSUM Chart, Target Given") {
#plot()
}
})
}
)
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.