Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Fixing some reported issues #280

Merged
merged 4 commits into from
Nov 11, 2023
Merged

Fixing some reported issues #280

Show file tree
Hide file tree
Changes from 3 commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
af65617
Fix 2273, 2274, 2286
JTPetter Sep 25, 2023
2640c54
Remove buggy code that was only commented out
JTPetter Sep 25, 2023
51f0d0b
Process Capability R4.3.1 reshaping issue
JTPetter Oct 2, 2023
8464088
Update R/msaGaugeRR.R
JTPetter Nov 11, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions R/attributesCharts.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -17,6 +17,7 @@

#' @export
attributesCharts <- function(jaspResults, dataset, options) {

# reading variables in from the GUI
total <- options$total
D <- options[["defectiveOrDefect"]]
Expand Down
13 changes: 5 additions & 8 deletions R/msaAttribute.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -51,7 +51,7 @@ msaAttribute <- function(jaspResults, dataset, options, ...) {
all.target = c(measurements, standards, operators, parts),
exitAnalysisIfErrors = TRUE)

if (!wideFormat && ready){
if (!wideFormat && ready) {
dataset <- dataset[order(dataset[[operators]]),]
dataset <- dataset[order(dataset[[parts]]),]
nrep <- table(dataset[operators])[[1]]/length(unique(dataset[[parts]]))
Expand Down Expand Up @@ -91,7 +91,8 @@ msaAttribute <- function(jaspResults, dataset, options, ...) {
jaspResults[["AAAtableGraphs"]] <- createJaspContainer(gettext("Attributes Agreement Analysis"))
jaspResults[["AAAtableGraphs"]]$position <- 16
}
jaspResults[["AAAtableGraphs"]] <- .aaaTableGraphs(ready = ready, dataset = dataset, measurements = measurements, parts = parts, operators = operators, options = options, standards = standards)
jaspResults[["AAAtableGraphs"]] <- .aaaTableGraphs(ready = ready, dataset = dataset, measurements = measurements,
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This doesn't look quite right, but I guess this was already the case?
As in, two lines above you do

jaspResults[["AAAtableGraphs"]] <- createJaspContainer(gettext("Attributes Agreement Analysis"))

and here you do

jaspResults[["AAAtableGraphs"]] <- .aaaTableGraphs(...)

which means that you overwrite everything that was in jaspResults[["AAAtableGraphs"]] before. I mean, it probably works because it already worked before, but it's not very pretty.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yes, I think there is quite a bit in the measurement systems analysis that is not pretty, I would keep this for now, as I have a bigger rewrite of this part planned for early next year...

parts = parts, operators = operators, options = options, standards = standards)
}else{
if (is.null(jaspResults[["AAAtableGraphs"]])) {
jaspResults[["AAAtableGraphs"]] <- createJaspContainer(gettext("Attributes Agreement Analysis"))
Expand Down Expand Up @@ -300,10 +301,8 @@ msaAttribute <- function(jaspResults, dataset, options, ...) {
}

for (measurement in measurements) {
if (is.numeric(dataset[[measurement]])) {
dataset[measurement] <- as.character(dataset[[measurement]])
dataset[standards] <- as.character(dataset[[standards]])
}
dataset[measurement] <- as.character(dataset[[measurement]])
dataset[standards] <- as.character(dataset[[standards]])
}

matchesWithin <- vector(mode = "numeric")
Expand Down Expand Up @@ -481,9 +480,7 @@ msaAttribute <- function(jaspResults, dataset, options, ...) {
numberInspected <- length(unique(dataset[[parts]]))

for (measurement in measurements) {
if (is.numeric(dataset[[measurement]])) {
dataset[measurement] <- as.character(dataset[[measurement]])
}
}

matchesWithin <- vector(mode = "numeric")
Expand Down
20 changes: 10 additions & 10 deletions R/msaGaugeLinearity.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -97,7 +97,7 @@ msaGaugeLinearity <- function(jaspResults, dataset, options, ...) {
singleMeasurementParts <- paste(names(which(table(dataset[[parts]]) < 2)), collapse = ", ")
table2$setError(gettextf("T-Test requires more than 1 measurement per part. Less than 2 valid measurement(s) detected in Part(s) %s.", singleMeasurementParts))
return(table2)
}
}
variancePerPart <- tapply(dataset[[measurements]], dataset[[parts]], var)
if(any(variancePerPart == 0)) {
noVarParts <- paste(names(which(variancePerPart == 0)), collapse = ", ")
Expand All @@ -107,7 +107,7 @@ msaGaugeLinearity <- function(jaspResults, dataset, options, ...) {
singleMeasurementParts <- paste(names(which(table(dataset[[parts]]) < 2)), collapse = ", ")
table2$setError(gettextf("T-Test requires more than 1 measurement per part. Less than 2 valid measurement(s) detected in Part(s) %s.", singleMeasurementParts))
return(table2)
}
}
variancePerPart <- tapply(dataset[[measurements]], dataset[[parts]], var)
if(any(variancePerPart == 0)) {
noVarParts <- paste(names(which(variancePerPart == 0)), collapse = ", ")
Expand Down Expand Up @@ -160,11 +160,11 @@ msaGaugeLinearity <- function(jaspResults, dataset, options, ...) {
jaspGraphs::geom_point(data = df, mapping = ggplot2::aes(x = Ref, y = Bias), fill = "red",size = 4) +
ggplot2::scale_y_continuous(limits = c(min(df2$Bias), max(df2$Bias) * 2)) +
ggplot2::annotate("text", x = mean(df2$Ref), y = max(df2$Bias)*1.25, size = 5.5,
label = sprintf("y = %.2f %s %.2fx", coefficientConstant, plusOrMin, abs(coefficientSlope)))
label = sprintf("y = %.2f %s %.2fx", coefficientConstant, plusOrMin, abs(coefficientSlope))) +
jaspGraphs::geom_rangeframe() +
jaspGraphs::themeJaspRaw()


p1 <- jaspGraphs::themeJasp(p1)
plot1$plotObject <- jaspGraphs::themeJasp(p1)
plot1$plotObject <- p1

table2$setData(list("predictor" = c("Intercept", "Slope"),
"coefficient" = coefficients,
Expand Down Expand Up @@ -200,15 +200,15 @@ msaGaugeLinearity <- function(jaspResults, dataset, options, ...) {
}

df3 <- data.frame(Source = c("Linearity", "Bias"), Percent = c(percentLin, (abs(averageBias) / options[["manualProcessVariationValue"]]) * 100))
yBreaks <- jaspGraphs::getPrettyAxisBreaks(df3$Percent)
yBreaks <- jaspGraphs::getPrettyAxisBreaks(c(0, df3$Percent))
yLimits <- range(yBreaks)

p2 <- ggplot2::ggplot() +
ggplot2::geom_col(data = df3, mapping = ggplot2::aes(x = Source, y = Percent)) +
ggplot2::scale_y_continuous(breaks = yBreaks, limits = yLimits) +
ggplot2::xlab(ggplot2::element_blank())

p2 <- jaspGraphs::themeJasp(p2)
ggplot2::xlab(ggplot2::element_blank()) +
jaspGraphs::geom_rangeframe() +
jaspGraphs::themeJaspRaw()

plot2$plotObject <- p2
}
Expand Down
24 changes: 13 additions & 11 deletions R/msaGaugeRR.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -38,8 +38,8 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) {
} else if (!wideFormat && options[["type3"]]) {
ready <- (!identical(measurements, "") && !identical(parts, ""))
}


numeric.vars <- measurements
numeric.vars <- numeric.vars[numeric.vars != ""]
factor.vars <- c(parts, operators)
Expand Down Expand Up @@ -844,30 +844,32 @@ msaGaugeRR <- function(jaspResults, dataset, options, ...) {

.gaugeVarCompGraph <- function(percentContributionValues, studyVariationValues, percentToleranceValues, Type3 = FALSE) {
sources <- gettext(c('Gauge r&R', 'Repeat', 'Reprod', 'Part-to-Part'))
if (!all(is.na(percentToleranceValues))){
if (!all(is.na(percentToleranceValues))) {
references <- gettextf(c('%% Contribution', '%% Study Variation', '%% Tolerance'))
values <- c(percentContributionValues, studyVariationValues, percentToleranceValues)
}else{
} else {
references <- gettextf(c('%% Contribution', '%% Study Variation'))
values <- c(percentContributionValues, studyVariationValues)
}
plotframe <- data.frame(source = rep(sources, length(references)),
reference = rep(references, each = 4),
value = values)
plotframe$source <- factor(plotframe$source, levels = sources)
yBreaks <- jaspGraphs::getPrettyAxisBreaks(plotframe$value)
yBreaks <- jaspGraphs::getPrettyAxisBreaks(c(0, plotframe$value))


if (Type3)
plotframe <- subset(plotframe, source != "Reprod")

p <- ggplot2::ggplot() + ggplot2::geom_bar(data = plotframe,
mapping = ggplot2::aes(fill = reference, y = value, x = source),
position="dodge", stat = "identity")
p <- jaspGraphs::themeJasp(p) + ggplot2::theme(legend.position = 'right', legend.title = ggplot2::element_blank()) +
ggplot2::xlab("") + ggplot2::scale_y_continuous(name = "Percent", breaks = yBreaks, limits = range(c(yBreaks, plotframe$value)))
p <- ggplot2::ggplot() +
ggplot2::geom_bar(data = plotframe, mapping = ggplot2::aes(fill = reference, y = value, x = source),
position="dodge", stat = "identity") +
jaspGraphs::themeJaspRaw() +
jaspGraphs::geom_rangeframe() +
ggplot2::theme(legend.position = 'right', legend.title = ggplot2::element_blank()) +
ggplot2::xlab("") +
JTPetter marked this conversation as resolved.
Show resolved Hide resolved
ggplot2::scale_y_continuous(name = "Percent", breaks = yBreaks, limits = range(c(yBreaks, plotframe$value)))
return(p)

}

.gaugeNumberDistinctCategories <- function(sdPart, sdGauge) {
Expand Down
14 changes: 10 additions & 4 deletions R/processCapabilityStudies.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -67,10 +67,16 @@ processCapabilityStudies <- function(jaspResults, dataset, options) {
measurements <- colnames(dataset)
subgroups <- ""
}else{
k <- subgroups
dataset <- .PClongTowide(dataset, k, measurements, mode = "subgroups")
measurements <- colnames(dataset)
measurements <- measurements[measurements != k]
k <- dataset[[subgroups]]
k <- na.omit(k)
# add sequence of occurence to allow pivot_wider
occurenceVector <- with(dataset, ave(seq_along(k), k, FUN = seq_along))
dataset$occurence <- occurenceVector
# transform into one group per row
dataset <- tidyr::pivot_wider(data = dataset, values_from = tidyr::all_of(measurements), names_from = occurence)
# arrange into dataframe
dataset <- as.data.frame(dataset)
measurements <- as.character(unique(occurenceVector))
}
}

Expand Down
Loading
Loading