#' Process Map
#'
#' This function takes information about the process we want
#' to represent and draw the Process Map, with its X's, x's, Y's and y's in
#' each step of the process
#'
#' The type of the x parameters and y features can be: C(controllable),
#' N(noise), Cr(Critical), P(Procedure). The default value for ss.col is
#' c("#666666", "#BBBBBB", "#CCCCCC", "#DDDDDD", "#EEEEEE", "#FFFFFF",
#' "#000000", "#000000") a grayscale style.You can pass any accepted color string.
#'
#'
#' @param steps A vector of characters with the name of the 'n' steps
#' @param inputs.overall A vector of characters with the name of the overall inputs
#' @param outputs.overall A vector of characters with the name of the overall outputs
#' @param input.output A vector of lists with the names of the inputs of the \eqn{i-{th}} step,
#' that will be the outputs of the \eqn{(i-1)-{th}} step
#' @param x.parameters A vector of lists with a list of the x parameters of the process. The
#' parameter is a vector with two values: the name and the type (view details)
#' @param y.features A vector of lists with a list of the y features of the step. The
#' feature is a vector with two values: the name and the type (view details)
#' @param main The main title for the Process Map
#' @param sub Subtitle for the diagram (recommended the Six Sigma project name)
#' @param ss.col A vector of colours for a custom drawing. At least five colours,
#' sorted by descendant intensity (see details)
#'
#' @return
#' A graphic representation of the Map Process.
#'
#' @references
#' \url{https://en.wikipedia.org/wiki/Business_Process_Mapping/}\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
#' The process map is the starting point for a Six Sigma Project, and it is
#' very important to find out who the x's and y'x are.
#'
#' @seealso
#' \code{\link{ss.ceDiag}}
#'
#' @author EL Cano
#'
#' @examples
#'
#' inputs.overall<-c("operators", "tools", "raw material", "facilities")
#' outputs.overall<-c("helicopter")
#' steps<-c("INSPECTION", "ASSEMBLY", "TEST", "LABELING")
#' #Inputs of process "i" are inputs of process "i+1"
#' input.output<-vector(mode="list",length=length(steps))
#' input.output[1]<-list(c("sheets", "..."))
#' input.output[2]<-list(c("sheets"))
#' input.output[3]<-list(c("helicopter"))
#' input.output[4]<-list(c("helicopter"))
#'
#' #Parameters of each process
#' x.parameters<-vector(mode="list",length=length(steps))
#' x.parameters[1]<-list(c(list(c("width", "NC")),list(c("operator", "C")),
#' list(c("Measure pattern", "P")), list(c("discard", "P"))))
#' x.parameters[2]<-list(c(list(c("operator", "C")),list(c("cut", "P")),
#' list(c("fix", "P")), list(c("rotor.width", "C")),list(c("rotor.length",
#' "C")), list(c("paperclip", "C")), list(c("tape", "C"))))
#' x.parameters[3]<-list(c(list(c("operator", "C")),list(c("throw", "P")),
#' list(c("discard", "P")), list(c("environment", "N"))))
#' x.parameters[4]<-list(c(list(c("operator", "C")),list(c("label", "P"))))
#' x.parameters
#'
#' #Features of each process
#' y.features<-vector(mode="list",length=length(steps))
#' y.features[1]<-list(c(list(c("ok", "Cr"))))
#' y.features[2]<-list(c(list(c("weight", "Cr"))))
#' y.features[3]<-list(c(list(c("time", "Cr"))))
#' y.features[4]<-list(c(list(c("label", "Cr"))))
#' y.features
#'
#' ss.pMap(steps, inputs.overall, outputs.overall,
#' input.output, x.parameters, y.features,
#' sub="Paper Helicopter Project")
#'
#' @export
#' @keywords process map
ss.pMap <-
function(steps, inputs.overall, outputs.overall,
input.output, x.parameters, y.features,
main = "Six Sigma Process Map", sub,
ss.col = c("#666666", "#BBBBBB", "#CCCCCC", "#DDDDDD", "#EEEEEE", "#FFFFFF",
"#000000", "#000000")){
nsteps <- length(steps)
.ss.prepCanvas(main, sub, ss.col)
paintBox <- function(){
x <- c(rep(0.10, 4), 0.30, 0.70,
rep(0.90, 4), 0.7, 0.3)
y <-c (0.10, 0.37, 0.64, rep(0.91, 4),
0.64, 0.37, rep(0.1, 3))
grid::grid.xspline(x, y,
shape = c(1, 1, 1, 1, 1, 1),
open = FALSE,
gp = grid::gpar(fill = ss.col[4],
lwd = 3, col = ss.col[2])
)
}
#ProcessMap container
vp.map <- grid::viewport(name = "map",
layout.pos.col = 1:3,
layout.pos.row = 2,
layout = grid::grid.layout(3, nsteps,
heights = c(0.2, 0.6, 0.2))) ##
grid::pushViewport(vp.map)
#overall inputs
vp.inputs <- grid::viewport(layout.pos.col = 1,
layout.pos.row = 1,
name = "inputs")
grid::pushViewport(vp.inputs)
paintBox()
grid::grid.text("INPUTS\nX", gp = grid::gpar(col = ss.col[7]))
grid::grid.move.to(x = 0.5, y = 0.1)
grid::upViewport()
vp.inputsText <- grid::viewport(layout.pos.col = 2:nsteps,
layout.pos.row = 1, name = "inputst", gp = grid::gpar(col = ss.col[8]))
grid::pushViewport(vp.inputsText)
for (i in 1:length(inputs.overall)){
grid::grid.text(x = unit(0.5, "cm"),
y = unit(1, "npc") - unit(i,"lines"),
paste(inputs.overall[i],"\n"),
just = c("left","top"),
name="inputst")
}
grid::upViewport()
#Processes
for (i in 1:nsteps){
vp.proc <- grid::viewport(layout.pos.col = i,
layout.pos.row = 2)
grid::pushViewport(vp.proc)
grid::pushViewport(grid::viewport(y = 1,
height = 0.5,
just = c("center", "top")))
paintBox()
grid::grid.lines(x = c(0.1, 0.9),
y = c(0.74, 0.74),
gp = grid::gpar(lwd = 3, col = ss.col[2]))
grid::grid.text(steps[i],
y = 0.85,
just = c("center", "top"), gp = grid::gpar(col = ss.col[7]))
grid::grid.text("INPUTS",
rot = 90,
x = 0.20,
y = 0.20,
just = c("left", "bottom"), gp = grid::gpar(fontsize = 8, col = ss.col[1]))
for (j in 1:length(input.output[[i]])){
grid::grid.text(input.output[[i]][j],
y = unit(0.7, "npc") - unit(j-1, "lines"),
just = c("center","top"),
gp = grid::gpar(col = ss.col[7]))
}
if (i==1){
grid::grid.line.to(x = 0.5, y = 0.91,
arrow = arrow(angle = 30,
length = unit(0.15, "inches"),
ends = "last",
type = "open"),
gp = grid::gpar(lwd = 6, col = ss.col[1]))
}
if (i > 1){
grid::grid.line.to(x = 0.1, y = 0.5,
arrow = arrow(angle = 30, length = unit(0.15, "inches"),
ends = "last", type = "open"),
gp=grid::gpar(lwd=6, col=ss.col[1]))
}
grid::grid.move.to(x = 0.9, y = 0.5)
if (i == nsteps){
grid::grid.move.to(x = 0.7, y = 0.1)
}
grid::upViewport()
grid::pushViewport(grid::viewport(y = 0.5,
height = 0.5,
just = c("center","top")))
grid::grid.text("Param.(x): ",
y = unit(1,"npc") - unit(2,"mm"),
gp = grid::gpar(fontsize = 8, col = ss.col[8]),
x = unit(0,"npc") + unit(2,"mm"),
just = c("left", "top"))
for (j in 1:length(x.parameters[[i]])){
grid::grid.text(paste(x.parameters[[i]][[j]][1], x.parameters[[i]][[j]][2]),
y = unit(1,"npc") - unit(2,"mm") - unit(j-1,"lines"),
x = unit(1,"strwidth","Param.(x): "),
gp = grid::gpar(fontsize = 8, col = ss.col[8]), just = c("left", "top"))
}
grid::grid.text("Featur.(y): ",
y = unit(1, "npc") -
unit(2, "mm") -
unit(length(x.parameters[[i]]), "lines"),
x = unit(0, "npc") + unit(2, "mm"),
gp = grid::gpar(fontsize = 8, col = ss.col[8]),
just = c("left", "top"))
for (j in 1:length(y.features[[i]])){
grid::grid.text(y.features[[i]][[j]],
y = unit(1,"npc") -
unit(2,"mm") -
unit(j - 1 + length(x.parameters[[i]]), "lines"),
x = unit(1, "strwidth", "Featur.(y): "),
gp = grid::gpar(fontsize = 8, col = ss.col[8]),
just = c("left", "top"))
}
grid::upViewport()
grid::upViewport()
}
#overalloutputs
vp.outputs <- grid::viewport(layout.pos.col = nsteps,
layout.pos.row = 3, name = "outputs")
grid::pushViewport(vp.outputs)
paintBox()
grid::grid.text("OUTPUTS\nY", gp = grid::gpar(col = ss.col[7]))
grid::grid.line.to(x = 0.7,
y = 0.91,
arrow = arrow(angle = 30, length = unit(0.15, "inches"),
ends = "last", type = "open"),
gp = grid::gpar(lwd = 6, col = ss.col[1]))
grid::upViewport()
vp.outputsText <- grid::viewport(layout.pos.col = 1:(nsteps-1),
layout.pos.row = 3,
name="outputst", gp = grid::gpar(col = ss.col[8]))
grid::pushViewport(vp.outputsText)
for (i in 1:length(outputs.overall)){
grid::grid.text(x = unit(1, "npc") - unit(0.5, "cm"),
y = unit(1, "npc") - unit(i, "lines"),
paste(outputs.overall[i],"\n"),
just = c("right", "top"),
name="outputst")
}
vp.legend<-grid::viewport(x = unit(0.2, "cm"),
y = unit(0.2, "cm"),
just = c("left", "bottom"),
height = unit(1, "npc") - unit(0.4, "cm"),
width = 0.3)
grid::pushViewport(vp.legend)
grid::grid.rect(gp = grid::gpar(fill = ss.col[3]))
grid::grid.text("LEGEND\n\t(C)ontrollable\n\t(Cr)itical\n\t(N)oise\n\t(P)rocedure",
y = unit(1, "npc") - unit(0.2, "cm") ,
x = unit(0, "npc") + unit(0.2,"cm"),
just = c("left", "top"),
gp = grid::gpar(fontsize = 8, col = ss.col[7]))
grid::upViewport()
grid::upViewport()
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.