#' @importFrom magrittr %>%
ahpsurveyClass <- if (requireNamespace('jmvcore', quietly = TRUE))
R6::R6Class(
"ahpsurveyClass",
inherit = ahpsurveyBase,
private = list(
.htmlwidget = NULL,
.init = function() {
private$.htmlwidget <- HTMLWidget$new()
if (is.null(self$data) | is.null(self$options$vars)) {
self$results$instructions$setVisible(visible = TRUE)
}
self$results$instructions$setContent(private$.htmlwidget$generate_accordion(
title = "Instructions",
content = paste(
'<div style="border: 2px solid #e6f4fe; border-radius: 15px; padding: 15px; background-color: #e6f4fe; margin-top: 10px;">',
'<div style="text-align:justify;">',
'<ul>',
'<li>The R package <b>ahpsurvey</b> is described in the <a href="https://cran.r-project.org/web/packages/ahpsurvey/vignettes/my-vignette.html" target = "_blank">page</a>.</li>',
'<li>Feature requests and bug reports can be made on my <a href="https://github.com/hyunsooseol/seolmatrix/issues" target="_blank">GitHub</a>.</li>',
'</ul></div></div>'
)
))
if (self$options$sumcr)
self$results$sumcr$setNote("Note", "Mean CR<0.1 is acceptable for consistency ratio.")
if (isTRUE(self$options$plot1)) {
width <- self$options$width1
height <- self$options$height1
self$results$plot1$setSize(width, height)
}
},
.run = function() {
# Ready--------
ready <- TRUE
if (is.null(self$options$vars) ||
length(self$options$vars) < 2)
ready <- FALSE
if (ready) {
data <- private$.cleanData()
results <- private$.compute(data)
#populate 'Aggregated priorities'------------
private$.populateApTable(results)
# populate 'Aggregated individual judgements' table----
private$.populateAjTable(results)
# Consistency ratio of each decision-maker---------
private$.populateCrOutputs(results)
# populate sumcr table-----------
private$.populateSumcrTable(results)
}
},
.compute = function(data) {
# get variables---------------------------------
vars <- self$options$vars
method <- self$options$method
method1 <- self$options$method1
############################################################
atts <- strsplit(self$options$atts, ',')[[1]]
matahp <- ahpsurvey::ahp.mat(df = data,
atts = atts,
negconvert = T)
##########################################################
# 'Aggregated priorities' table----------
geo <- ahpsurvey::ahp.aggpref(matahp, atts, method = method)
df <- data.frame(Value = geo)
# Aggregated individual judgements table--------
aj <- ahpsurvey::ahp.aggjudge(matahp, atts, aggmethod = method1)
item <- as.matrix(aj)
# Consistency ratio of each decision-maker-------
cr <- ahpsurvey::ahp.cr(matahp, atts)
cr1 <- data %>%
ahpsurvey::ahp.mat(atts, negconvert = T) %>%
ahpsurvey::ahp.cr(atts)
tab <- as.vector(table(cr1 <= 0.1))
# Individual preference plot1----------
if (self$options$plot1 == TRUE) {
me <- self$options$method2
me2 <- self$options$method3
m <- ahpsurvey::ahp.indpref(matahp, atts, method = me)
m2 <- ahpsurvey::ahp.indpref(matahp, atts, method = me2)
error <- data.frame(id = 1:length(matahp),
maxdiff = apply(abs(m - m2), 1, max))
image <- self$results$plot1
image$setState(error)
}
results <-
list(
'df' = df,
'item' = item,
'cr' = cr,
'cr1' = cr1,
'tab' = tab
)
},
#Populate table----------------------------
.populateSumcrTable = function(results) {
table <- self$results$sumcr
cr <- results$cr
cr1 <- results$cr1
tab <- results$tab
mcr <- round(mean(cr), 3)
ve <- c(tab, mcr)
row <- list()
row[['NO']] <- ve[[1]]
row[['YES']] <- ve[[2]]
row[['Mean CR']] <- ve[[3]]
table$setRow(rowNo = 1, values = row)
},
.populateApTable = function(results) {
table <- self$results$ap
df <- results$df
names <- dimnames(df)[[1]]
table <- self$results$ap
for (name in names) {
row <- list()
row[['value']] <- df[name, 1]
table$addRow(rowKey = name, values = row)
}
},
.populateAjTable = function(results) {
table <- self$results$aj
item <- results$item
names <- dimnames(item)[[1]]
dims <- dimnames(item)[[2]]
table <- self$results$aj
for (dim in dims) {
table$addColumn(name = paste0(dim), type = 'number')
}
for (name in names) {
row <- list()
for (j in seq_along(dims)) {
row[[dims[j]]] <- item[name, j]
}
table$addRow(rowKey = name, values = row)
}
},
# COnsistency ration of each decision-maker-----
.populateCrOutputs = function(results) {
cr <- results$cr
if (self$options$cr
&& self$results$cr$isNotFilled()) {
self$results$cr$setRowNums(rownames(self$data))
self$results$cr$setValues(cr)
}
},
.plot1 = function(image, ggtheme, theme, ...) {
if (is.null(image$state))
return(FALSE)
error <- image$state
library(ggplot2)
plot1 <- ggplot2::ggplot(data = error, ggplot2::aes(x = id, y = maxdiff)) +
geom_point() +
geom_hline(yintercept = 0.05,
linetype = "dashed",
color = "red") +
geom_hline(yintercept = 0, color = "gray50") +
scale_x_continuous("Respondent ID") +
scale_y_continuous("Maximum difference")
plot1 + ggtheme
print(plot1)
TRUE
},
### Helper functions =================================
.cleanData = function() {
items <- self$options$vars
data <- list()
for (item in items)
data[[item]] <-
jmvcore::toNumeric(self$data[[item]])
attr(data, 'row.names') <-
seq_len(length(data[[1]]))
attr(data, 'class') <- 'data.frame'
data <- jmvcore::naOmit(data)
return(data)
}
)
)
# if(self$options$plot2==TRUE){
#
# thres <- 0.1
# atts <- strsplit(self$options$atts, ',')[[1]]
#
# cr <- data %>%
# ahp.mat(atts, negconvert = T) %>%
# ahp.cr(atts)
#
#
# cr.df <- data %>%
# ahp.mat(atts, negconvert = TRUE) %>%
# ahp.cr(atts) %>%
# data.frame() %>%
# mutate(rowid = 1:length(cr), cr.dum = as.factor(ifelse(cr <= thres, 1, 0))) %>%
# select(cr.dum, rowid)
#
#
# cityahp <- data %>%
# ahp.mat(atts, negconvert = T)
#
# eigentrue <- ahp.indpref(cityahp, atts, method = "eigen")
#
# d <- data %>%
# ahpsurvey::ahp.mat(atts = atts, negconvert = TRUE) %>%
# ahpsurvey::ahp.indpref(atts, method = "eigen") %>%
# dplyr::mutate(rowid = 1:nrow(eigentrue)) %>%
# dplyr::left_join(cr.df, by = 'rowid') %>%
# tidyr::gather(atts, key = "var", value = "pref")
#
# state<-list(d, cr)
# image <- self$results$plot2
# image$setState(state)
# }
#
# .plot2 = function(image,ggtheme, theme,...) {
#
# if (is.null(image$state))
# return(FALSE)
#
# atts <- strsplit(self$options$atts, ',')[[1]]
# thres <- 0.1
#
# d <- image$state[[1]]
# cr <- image$state[[2]]
#
# plot2 <- d |> ggplot(aes(x = var, y = pref)) +
# geom_violin(alpha = 0.6, width = 0.8, color = "transparent", fill = "gray") +
# geom_jitter(alpha = 0.6, height = 0, width = 0.1, aes(color = cr.dum)) +
# geom_boxplot(alpha = 0, width = 0.3, color = "#808080") +
# scale_x_discrete("Attribute", label = atts) +
# scale_y_continuous("Weight (dominant eigenvalue)",
# labels = scales::percent,
# breaks = c(seq(0,0.7,0.1))) +
# guides(color=guide_legend(title=NULL))+
# scale_color_discrete(breaks = c(0,1),
# labels = c(paste("CR >", thres),
# paste("CR <", thres))) +
# labs(NULL, caption = paste("n =", nrow(data), ",", "Mean CR =",
# round(mean(cr),3)))+
# #theme_minimal()
#
# theme(
# axis.text.x = element_text(size = 12, color = "black") # adjust size and darkness of x-axis text
# #axis.text.x.bottom = element_text(angle = 90, hjust = 1) # rotate x-axis text by 90 degrees
# )
#
# plot2+ggtheme
#
# if (self$options$angle > 0) {
# plot2 <- plot2 + ggplot2::theme(
# axis.text.x = ggplot2::element_text(
# angle = self$options$angle, hjust = 1
# )
# )
# }
#
#
# print(plot2)
# TRUE
#
# },
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.