Nothing
#' Loss Function Analysis
#'
#' This function performs a Quality Loss Function Analysis, based in the Taguchi
#' Loss Function for "Nominal-the-Best" characteristics.
#'
#' \code{lfa.output} can take the values "text", "plot" or "both".
#'
#' @param lfa.data Data frame with the sample to get the average loss.
#' @param lfa.ctq Name of the field in the data frame containing the data.
#' @param lfa.Delta Tolerance of the process.
#' @param lfa.Y0 Target of the process (see note).
#' @param lfa.L0 Cost of poor quality at tolerance limit.
#' @param lfa.size Size of the production, batch, etc. to calculate the total loss in a group
#' (span, batch, period, ...)
#' @param lfa.output Type of output (see details).
#' @param lfa.sub Subtitle for the graphic output.
#'
#' @return
#' \item{lfa.k }{Constant k for the loss function}
#' \item{lfa,lf }{Expression with the loss function}
#' \item{lfa.MSD}{Mean Squared Differences from the target}
#' \item{lfa.avLoss}{Average Loss per unit of the process}
#' \item{lfa.Loss}{Total Loss of the process (if a size is provided)}
#'
#' @references
#' Taguchi G, Chowdhury S,Wu Y (2005) \emph{Taguchi's quality engineering handbook}. John
#' Wiley\cr
#'
#' Cano, Emilio L., Moguerza, Javier M. and Redchuk, Andres. 2012.
#' \emph{Six Sigma with {R}. Statistical Engineering for Process
#' Improvement}, Use R!, vol. 36. Springer, New York.
#' \url{https://link.springer.com/book/10.1007/978-1-4614-3652-2}.\cr
#'
#' @note
#' For smaller-the-better characteristics, the target should be zero (\code{lfa.Y0 = 0}).
#' For larger-the-better characteristics, the target should be infinity (\code{lfa.Y0 = Inf}).
#'
#' @seealso
#' \code{\link{ss.lf}}, \code{\link{ss.data.bolts}}.
#'
#' @author EL Cano
#'
#' @examples
#' ss.lfa(ss.data.bolts, "diameter", 0.5, 10, 0.001,
#' lfa.sub = "10 mm. Bolts Project",
#' lfa.size = 100000, lfa.output = "both")
#' @export
#' @keywords loss function Taguchi
ss.lfa <- function(lfa.data, lfa.ctq, lfa.Delta, lfa.Y0, lfa.L0,
lfa.size = NA, lfa.output = "both", lfa.sub = "Six Sigma Project"){
if (missing(lfa.Delta) || !is.numeric(lfa.Delta)){
stop("Please provide a valid tolerance value (lfa.Delta).")
}
if (lfa.Y0 == 0){
lfa.k <- lfa.L0/(lfa.Delta^2)
lfa.lf <- bquote(bold(L==.(lfa.k)%.%Y^2))
lfa.MSD <- with(lfa.data,
sum((get(lfa.ctq))^2) / length(get(lfa.ctq)))
} else if (lfa.Y0 == Inf){
lfa.k <- lfa.L0*(lfa.Delta^2)
lfa.lf <- bquote(bold(L==.(lfa.k)%.%(1/Y^2)))
lfa.MSD <- with(lfa.data,
sum((1/get(lfa.ctq))^2) / length(get(lfa.ctq)))
} else {
lfa.k <- lfa.L0/(lfa.Delta^2)
lfa.lf <- bquote(bold(L==.(lfa.k)%.%(Y-.(lfa.Y0))^2))
lfa.MSD <- with(lfa.data,
sum((get(lfa.ctq) - lfa.Y0)^2) / length(get(lfa.ctq)))
}
lfa.avLoss <- lfa.k * lfa.MSD
if (is.numeric(lfa.size)){
lfa.Loss <- lfa.size * lfa.avLoss
}
else{
lfa.Loss <- NA
}
if (lfa.output %in% c("both", "plot")){
.ss.prepCanvas(main = "Loss Function Analysis", sub = lfa.sub)
vp.function <- grid::viewport(name = "Taguchi",
layout = grid::grid.layout(2, 2,
heights = c(0.9, 0.1),
widths = c(0.8, 0.2)))
grid::pushViewport(vp.function)
vp.plot <- grid::viewport(name = "plot",
layout.pos.row = 1,
layout.pos.col = 1)
#plot
grid::pushViewport(vp.plot)
ggdata <- reshape2::melt(with(lfa.data, get(lfa.ctq)))
qqp <- ggplot(ggdata, aes(x = .data$value))
qqp <- qqp + stat_function(fun = function(x) {
if (lfa.Y0 == 0){
eval(lfa.k)*(x)^2
} else if (lfa.Y0 == Inf){
eval(lfa.k)*(1/x^2)
} else {
eval(lfa.k)*(x-eval(lfa.Y0))^2
}
},
size = 1.2) +
ylab("Cost of Poor Quality") +
xlab("Observed Value")
if (lfa.Y0 == Inf) qqp <- qqp + scale_y_continuous(limits = c(0, lfa.L0*10))
qqp <- qqp + geom_vline(xintercept = eval(lfa.Y0),
linetype = 3, size = 1.1)
qqp <- qqp + geom_hline(yintercept = 0,
size = 1)
if (lfa.Y0 != 0){
xpos <- ifelse(lfa.Y0 == Inf, 0 + lfa.Delta, lfa.Y0 - lfa.Delta)
qqp <- qqp + geom_vline(xintercept = xpos,
linetype = 2)
qqp <- qqp + annotate(geom = "text",
x = xpos,
y = lfa.avLoss,
label = "LSL",
hjust = -0.1)
}
if (lfa.Y0 != Inf){
qqp <- qqp + geom_vline(xintercept = eval(lfa.Y0 + lfa.Delta),
linetype = 2)
qqp <- qqp + annotate(geom = "text",
x = lfa.Y0 + lfa.Delta,
y = lfa.avLoss,
label = "USL",
hjust = 1.1)
qqp <- qqp + annotate(geom = "text",
x = lfa.Y0,
y = ss.lf(lfa.Y0 - lfa.Delta,
lfa.Delta,
lfa.Y0,
lfa.L0),
label = "T",
hjust = 1.1)
}
if (lfa.Y0 == Inf){
qqp <- qqp + geom_vline(xintercept = 0,
linetype = 1, size = 1)
}
print(qqp, newpage = FALSE)
grid::popViewport()
#function
vp.fun <- grid::viewport(name = "fun",
layout.pos.row = 2,
layout.pos.col = 1:2)
grid::pushViewport(vp.fun)
grid::grid.rect(width = 0.95,
gp = grid::gpar(lty = 0, fill = "#DDDDDD"))
grid::grid.text(lfa.lf)
grid::popViewport()
#data
vp.data <- grid::viewport(name = "data",
layout.pos.row = 1:2,
layout.pos.col = 2)
grid::pushViewport(vp.data)
vp.data.input <- grid::viewport(name="input",
layout.pos.row = 2,
layout.pos.col = 1)
grid::pushViewport(vp.data.input)
grid::grid.rect(y = 0.95,
width = 0.99,
just = "top",
height=0.7)
my.margin <- 0.9
grid::grid.text(expression(bold(Data)),
y = my.margin,
just = "top")
grid::grid.text(paste("CTQ:", eval(lfa.ctq)),
y = unit(my.margin, "npc") - unit(2, "lines"),
just = "top",
gp = grid::gpar(cex = 0.8))
grid::grid.text(bquote(Y[0]==.(lfa.Y0)),
y = unit(my.margin, "npc") - unit(3, "lines"),
just = "top")
grid::grid.text(bquote(Delta==.(lfa.Delta)),
y = unit(my.margin, "npc") - unit(4, "lines"),
just = "top")
grid::grid.text(bquote(L[0]==.(lfa.L0)),
y = unit(my.margin,"npc") - unit(5, "lines"),
just = "top")
if (is.numeric(lfa.size)){
size.exists = 1
grid::grid.text(bquote(Size==.(lfa.size)),
y = unit(my.margin, "npc") - unit(6, "lines"),
just = "top")
}
grid::grid.lines(y = unit(my.margin, "npc") - unit(8, "lines"))
grid::grid.text(bquote(Mean==.(round(with(lfa.data, mean(get(lfa.ctq))),
digits = 4))),
y = unit(my.margin,"npc") - unit(10, "lines"),
just = "top")
grid::grid.text(bquote(k==.(lfa.k)),
y = unit(my.margin,"npc") - unit(11, "lines"),
just = "top")
grid::grid.text(bquote(MSD==.(round(lfa.MSD, digits = 4))),
y = unit(my.margin, "npc") - unit(12, "lines"),
just = "top")
grid::grid.text(bquote(Av.Loss==.(round(lfa.avLoss, digits = 4))),
y = unit(my.margin, "npc") - unit(13, "lines"),
just = "top")
if (is.numeric(lfa.size)){
grid::grid.text(bquote(Loss==.(round(lfa.Loss, digits = 4))),
y = unit(my.margin, "npc") - unit(14, "lines"),
just = "top")
}
}
if (lfa.output %in% c("both", "text")){
#pintar valores en output
return(list(lfa.k = lfa.k,
lfa.lf = as.expression(lfa.lf),
lfa.MSD = lfa.MSD,
lfa.avLoss = lfa.avLoss,
lfa.Loss = lfa.Loss))
}
else{
invisible(list(lfa.k = lfa.k,
lfa.lf = as.expression(lfa.lf),
lfa.MSD = lfa.MSD,
lfa.avLoss = lfa.L0,
lfa.Loss = lfa.Loss))
}
}
#' Evaluates the Loss Function for a process.
#'
#' The quality loss function is one of the tools of the Six Sigma methodology.
#' The function assigns a cost to an observed value, that is larger as far as it
#' is from the target.
#'
#' @param lfa.Y1 The observed value of the CTQ (critical to quality) characteristic
#' that will be evaluated.
#' @param lfa.Delta The tolerance for the CTQ.
#' @param lfa.Y0 The target for the CTQ.
#' @param lfa.L0 The cost of poor quality when the characteristic is \eqn{Y_0 + \Delta}.
#'
#' @return
#' \item{ss.lf}{A number with the evaluated function at \eqn{Y_1}}
#'
#' @references
#' Taguchi G, Chowdhury S,Wu Y (2005) \emph{Taguchi's quality engineering handbook}. John
#' Wiley
#'
#' Cano, Emilio L., Moguerza, Javier M. and Redchuk, Andres. 2012.
#' \emph{Six Sigma with {R}. Statistical Engineering for Process
#' Improvement}, Use R!, vol. 36. Springer, New York.
#' \url{https://link.springer.com/book/10.1007/978-1-4614-3652-2}.
#'
#' @seealso \code{\link{ss.lfa}}
#' @author EL Cano
#'
#' @examples
#' #Example bolts: evaluate LF at 10.5 if Target=10, Tolerance=0.5, L_0=0.001
#' ss.lf(10.5, 0.5, 10, 0.001)
#' @export
#' @keywords loss function Taguchi
ss.lf <- function(lfa.Y1, lfa.Delta, lfa.Y0, lfa.L0) {
if (lfa.Delta <= 0){
stop("The tolerance of the process must be greater than 0")
}
if (lfa.L0 <= 0){
warning("The Cost of poor quality at tolerance limit should be greater than 0")
}
lfa.k <- lfa.L0/lfa.Delta
return(lfa.k*(lfa.Y1-lfa.Y0)^2)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.