R/measures.r

Defines functions plot.indexDilemma indexDilemma print.indexDilemma indexDilemmaInternal indexDilemmaShowCorrelationDistribution print.indexConflict3 indexConflict3Out3 indexConflict3Out2 indexConflict3Out1 indexConflict3 print.indexConflict2 indexConflict2Out2 indexConflict2Out1 indexConflict2 indexConflict1 print.indexConflict1 print.indexSelfConstruction indexSelfConstruction print.indexPolarization indexPolarization print.indexIntensity indexIntensity print.indexDilemmatic indexDilemmatic print.indexBieri indexBieri indexPvaff indexVariability indexBias print.org.matches matches print_square_matrix

Documented in indexBias indexBieri indexConflict1 indexConflict2 indexConflict3 indexDilemma indexDilemmatic indexIntensity indexPolarization indexPvaff indexSelfConstruction indexVariability matches plot.indexDilemma print.indexBieri print.indexConflict1 print.indexConflict2 print.indexConflict3 print.indexDilemma print.indexDilemmatic print.indexIntensity print.indexPolarization print.indexSelfConstruction print.org.matches print_square_matrix

#//////////////////////////////////////////////////////////////////////////////
#                                                                             #
#  			  			            GRID INDEX MEASURES     							            #
#                                                                             #
#       All function for index measures start with a lower case "i"           #
#       e.g. 'iBias' that stand for index followed by the an acronym          #
#       of what is calculated.                                                #
#                                                                             #
#//////////////////////////////////////////////////////////////////////////////

# ___________________ ----
#//////////////////////////////////////////////////////////////////////////////
#   						                   HELPERS  							                 ----
#//////////////////////////////////////////////////////////////////////////////


#' Print a square matrix in well readable format
#' 
#' Helper function to produce output for square matrices, e.g. distance
#' matrices etc. Adds a (trimmed) name and index column. Displays
#' upper triangle only by default. The function is used inside the 
#' print method of several classes.
#' 
#' @param x A square `matrix`.
#' @param names names A vector of row names.
#' @param width Column width of output (numeric).
#' @param trim Trimmed length of names (numeric).
#' @param index Whether to add an index columns (default `TRUE`).
#' @param upper Whether to only show the upper triangle (default `TRUE`).
#' @md
#' @export
#' @keywords internal
print_square_matrix <- function(x, names = NA, trim = NA,  
                                index = TRUE, width = NA, upper = TRUE)
{
  if (!is.matrix(x))
    stop("'x' muste be a matrix", call. = FALSE)
  if (dim(x)[1] != dim(x)[2])
    stop("'x' muste be a square matrix", call. = FALSE)
  if (!is.null(names) && !is.na(names[1]) && length(names) != nrow(x)) 
    stop("length of 'names' must be equal to number of rows of 'x'", call. = FALSE)
  if (!is.na(trim) && !trim >= 0)
    stop("'trim' must be NA or >= 0", call. = FALSE)
  
  # set width of columns
  if (is.na(width)) {
    width <- max(
      nchar(nrow(x)),  # length of column index
      nchar(max(x, na.rm = T))  # biggest value
    )
  }
  
  # trim names
  if (!is.null(names) && !is.na(names[1]) && 
      !is.null(trim) && !is.na(trim[1])) {
    names <- substr(names, 1, trim)
  }
  
  # fill lower triangle with blanks of correct length
  if (upper) {
    x[lower.tri(x, diag = TRUE)] <- paste0(rep(" ", width), collapse = "")
  }
  
  # add index column for neater colnames  
  if (index) {
    x <- addIndexColumnToMatrix(x) 
  } else {
    colnames(x) <- seq_len(ncol(x))
  }   
  
  # add names column in first position
  if (!is.na(names)[1]) {
    cnms <- c(" ", colnames(x))
    x <- cbind(names, x)
    colnames(x) <- cnms
  }
  
  x <- as.data.frame(x, stringsAsFactors = FALSE)
  rownames(x) <- NULL
  print(x)
}


#' Number of matches in ratings
#'
#' Count the number of matches, i.e. (near) identical ratings between two
#' elements or constructs. Matches are used as the basis for the calculation of
#' grid indexes.
#'
#' @param x A `repgrid` object.
#' @param deviation Maximal difference between ratings to be considered a match
#'   (default `0` = only identical rating scores are a match). Especially useful
#'   for long rating scale (e.g. 0 to 100).
#' @param diag.na Whether to set the diagonal of the matrices to `NA` (default
#'   is `TRUE`).
#' @return A list of class `org.matches` with:
#' 
#'  * `grid`: The grid used to calculate the matches.
#'  * `deviation` The deviation parameter.
#'  * `max_constructs` Maximum possible number of matches across constructs.
#'  * `max_elements` Maximum possible number of matches across elements.
#'  * `total_constructs` Total number of matches across constructs.
#'  * `total_elements` Total number of matches across elements.
#'  * `constructs`: Matrix with no. of matches for constructs.
#'  * `elements`: Matrix with no. of matches for elements.
#'
#' @export
#' @md
#' @example inst/examples/example-matches.R
#' 
matches <- function(x, deviation = 0, diag.na = TRUE) 
{
  stop_if_not_is_repgrid(x)
  if (!is.numeric(deviation) || deviation < 0)
    stop("'deviation' must be >= 0", call. = FALSE)
  R <- ratings(x, names = FALSE)
  
  # constructs  
  M_c <- apply(t(R), 2, function(x) {
    colSums(abs(x - t(R)) <= deviation)  # matches per column
  })
  # elements
  M_e <- apply(R, 2, function(x) {
    colSums(abs(x - R) <= deviation)  # matches per column
  })

  # set diagonal NA
  if (diag.na) {
    diag(M_c) <- NA
    diag(M_e) <- NA
  }
  
  # total number of C/E matches 
  total_constructs <- sum(M_c[upper.tri(M_c)])
  total_elements <- sum(M_e[upper.tri(M_e)])
  
  # maximal number of possible matches
  nc <- nrow(x)
  ne <- ncol(x)
  max_constructs <- unname(ne * nc * (nc - 1) / 2)
  max_elements <- unname(nc * ne * (ne - 1) / 2)
  
  l <- list(
    grid = x,
    deviation = deviation,
    total_constructs = total_constructs,
    total_elements = total_elements,
    max_constructs = max_constructs,
    max_elements = max_elements,
    constructs = unname(M_c),
    elements = unname(M_e)
  )
  class(l) <- c("org.matches", class(l))
  l
}


#' Print method for class org.matches.
#' 
#' @param l Object of class `org.matches`.
#' @param output    String with each letter indicating which parts of the output to print 
#'                  (default is `"ICE"`, order does not matter):
#'                  `I` = Information,
#'                  `C` = Constructs' matches,
#'                  `E` = Elements' matches.
#' @param names names A vector of row names.
#' @param width Column width of output (numeric).
#' @param trim Trimmed length of names (default = `50`).
#' @param index Whether to add an index columns (default `TRUE`).
#' @param upper Whether to only show the upper triangle (default `TRUE`).
#' @md
#' @export
#' @keywords internal
#'
print.org.matches <- function(l, output = "ICE", index = TRUE, 
                              names = TRUE, trim = 50, upper = TRUE, width = NA)
{
  output <- toupper(output)
  g <- l$grid
  if (names) {
    cnames <- constructs(g, collapse = TRUE)
    enames <- elements(g)  
  } else {
    cnames <- NA
    enames <- NA
  }

  # matrices with no of matches
  M_c <- l$constructs
  M_e <- l$elements
  
  cat("\n##############")
  cat("\nRATING MATCHES")
  cat("\n##############\n")
  
  ## I = Info
  if (str_detect(output, "I")) {
    cat("\nMaximal rating difference to count as match: ", l$deviation)
    cat("\n")
    cat("\nTotal no. of matches between constructs: ", l$total_constructs)
    cat("\nMaximum possible no. of matches between constructs: ", l$max_constructs)
    cat("\n")
    cat("\nTotal no. of matches between elements: ", l$total_elements)
    cat("\nMaximum possible no. of matches between elements: ", l$max_elements)
    cat("\n")
  }
  ## E = Elements
  if (str_detect(output, "E")) {
    cat(bold("\nELEMENTS\n\n"))
    print_square_matrix(M_e, names = enames, index = index, 
                        upper = upper, trim = trim, width = width)
  }
  ## C = Constructs
  if (str_detect(output, "C")) {
    cat(bold("\nCONSTRUCTS\n\n"))
    print_square_matrix(M_c, names = cnames, index = index, 
                        upper = upper, trim = trim, width = width)
  }
}


# ___________________ ----
#//////////////////////////////////////////////////////////////////////////////
#   						            SLATER MEASURES  							                 ----
#//////////////////////////////////////////////////////////////////////////////


#' Calculate 'bias' of grid as defined by Slater (1977). 
#'
#' "Bias records a tendency for reponses to accumulate at one end of the 
#' grading scale" (Slater, 1977, p.88). 
#'
#' @param  x        \code{repgrid} object.
#' @param min,max   Minimum and maximum grid scale values. Nor needed 
#'                  if they are set for the grid.
#' @param digits    Numeric. Number of digits to round to (default is 
#'                  \code{2}).
#' @return Numeric.
#' @references      Slater, P. (1977). \emph{The measurement of intrapersonal space 
#'                  by Grid technique}. London: Wiley.
#' @note STATUS:    Working and checked against example in Slater, 1977, p. 87.
#' @author          Mark Heckmann
#' @export
#' @seealso       \code{\link{indexVariability}} 
#' @examples indexBias(boeker)
#'
indexBias <- function(x, min = NULL, max = NULL, digits=2) 
{
  dat <- getRatingLayer(x)
  sc <- getScale(x)
  if (is.null(min)) 
    min <- sc[1]
  if (is.null(max)) 
    max <- sc[2]
  p <- min + (max - min) / 2 		# scale midpoint
  q <- max - p									# distance to scale limits
  n <- nrow(dat)								# number of rows (constructs)
  row.means <- apply(dat, 1, mean, na.rm = TRUE)		# means of construct rows
  bias <- (sum((row.means - p)^2) / n)^.5 / q		  # calculation of bias
  round(bias, digits)
}


#' Calculate 'variability' of a grid as defined by Slater (1977).
#'
#' Variability records a tendency for the responses to gravitate 
#' towards both end of the gradings scale. (Slater, 1977, p.88).
#'
#' @param  x      \code{repgrid} object.
#' @param min,max   Minimum and maximum grid scale values. Nor needed 
#'                  if they are set for the grid.
#' @param digits  Numeric. Number of digits to round to (default is 
#'                \code{2}).
#' @return        Numeric.
#' @references    Slater, P. (1977). \emph{The measurement of intrapersonal space 
#'                by Grid technique}. London: Wiley.
#' @note          STATUS: working and checked against example in Slater, 1977 , p.88.
#' @author        Mark Heckmann
#' @export
#' @seealso       \code{\link{indexBias}} 
#' @examples      indexVariability(boeker)
#' 
indexVariability <- function(x, min = NULL, max = NULL, digits = 2) 
{
  dat <- getRatingLayer(x)
  sc <- getScale(x)
  if (is.null(min)) 
    min <- sc[1]
  if (is.null(max)) 
    max <- sc[2]
  
  D <- as.matrix(center(x))       # row centered grid matrix
  W <- D %*% t(D)									# co-variation Matrix W
  V <- diag(W)										# extract trace (construct variations)
  V.tot <- sum(V, na.rm = TRUE)   # total variation
  
  p <- min + (max - min) / 2 				# scale midpoint
  q <- max - p								      # distance to scale limits
  n <- nrow(D)								      # number of rows (constructs)
  m <- ncol(D)								      # number of columns (elements)
  res <- (V.tot / (n * (m - 1)))^.5 / q		# calculate variability
  round(res, digits)
}


# . ----
# ___________________ ----
#//////////////////////////////////////////////////////////////////////////////
#   						                    MISC             							         ----
#//////////////////////////////////////////////////////////////////////////////


#' Percentage of Variance Accounted for by the First Factor (PVAFF)
#'
#' The PVAFF is used as a measure of cognitive complexity. It was introduced in
#' an unpublished PhD thesis by Jones (1954, cit. Bonarius, 1965). To calculate
#' it, the 'first factor' two different methods may be used. One applies
#' principal component analysis (PCA) to the construct centered raw data
#' (default), the second applies SVD to the construct correlation matrix. The
#' PVAFF reflects the amount of variation that is accounted for by a single
#' linear component. If a single latent component is able to explain the
#' variation in the grid, the cognitive complexity is said to be low. In this
#' case the construct system is regarded as 'simple' (Bell, 2003).
#' 
#' @param x         \code{repgrid} object.
#' @param method    Method to compute PVAFF: \code{1} = PCA is applied to raw data 
#'                  with centered constructs (default), \code{2} =  SVD of construct 
#'                  correlation matrix.
#' @references      Bell, R. C. (2003). An evaluation of indices used to 
#'                  represent construct structure. In G. Chiari & M. L. 
#'                  Nuzzo (Eds.), \emph{Psychological Constructivism and 
#'                  the Social World} (pp. 297-305). Milan: FrancoAngeli.
#'
#'                  Bonarius, J. C. J. (1965). Research in the personal 
#'                  construct theory of George A. Kelly: role construct 
#'                  repertory test and basic theory. In B. A. Maher (Ed.), 
#'                  \emph{Progress in experimental personality research}
#'                  (Vol. 2). New York: Academic Press.
#'
#'                  James, R. E. (1954). \emph{Identification in terms of personal 
#'                  constructs} (Unpublished doctoral thesis). Ohio State 
#'                  University, Columbus, OH.  
#' @export
#' @examples 
#'
#'    indexPvaff(bell2010)
#'
indexPvaff <- function(x, method = 1)
{
  cat("Note: As of v0.1.14 PVAFF is derived using PCA of the construct centered ratings by default.", 
     "Before that the construct correlation matrix was used (see method=2).\n\n")
  if (!inherits(x, "repgrid"))
    stop("Object must be of class 'repgrid'")
  
  if (method == 1) {
    r <- ratings(x) 
    p <- stats::prcomp(t(r), center = TRUE, scale. = FALSE)
    pvaff <- (p$sdev^2 / sum(p$sdev^2))[1]
    
  } else if (method == 2) {
    cr <- constructCor(x)
    sv <- svd(cr)$d
    pvaff <- sv[1] ^ 2 / sum(sv ^ 2)
  } else {
    stop("'method' must be 1 or 2.", call. = FALSE)
  }
  
  return(pvaff)
}


# Print method for class indexPvaff.
# 
# @param x         Object of class indexPvaff.
# @param digits    Numeric. Number of digits to round to (default is 
#                  \code{2}).
# @param ...       Not evaluated.
# @export
# @method          print indexPvaff
# @keywords        internal
#
# print.indexPvaff <- function(x, digits=2, ...)
# {
#   cat("\n########################################################")
#   cat("\nPercentage of Variance Accounted for by the First Factor")
#   cat("\n########################################################")
#   cat("\n\nPVAFF: ", round(x*100, digits), "%")
# }



#' Bieri's index of cognitive complexity
#'
#' The index builds on the number of rating matches
#' between pairs of constructs. It is the relation between
#' the total number of matches and the possible number of matches.
#' 
#' **CAVEAT**: The Bieri index will change when constructs are reversed.
#' 
#' @param x A `repgrid` object.
#' @param deviation Maximal difference between ratings to be considered a match
#'   (default `0` = identical scores for a match).
#' @return List of class `indexBieri`:
#' 
#'  * `grid`: The grid used to calculate the index
#'  * `deviation` The deviation parameter.
#'  * `matches_max` Maximum possible number of matches across constructs.
#'  * `matches` Total number of matches across constructs.
#'  * `constructs`: Matrix with no. of matches for constructs.
#'  * `bieri`: Bieri index (= matches / matches_max)
#'  
#' @example inst/examples/example-indexBieri.R
#' @export
#' @md
#' 
indexBieri <- function(x, deviation = 0) 
{
  stop_if_not_is_repgrid(x)
  
  m <- matches(x, deviation = deviation)
  n_matches <- m$total_constructs
  n_matches_max <- m$max_constructs 
  
  l <- list(
    grid = x,
    deviation = deviation,
    constructs = m$constructs,
    matches = n_matches,
    matches_max = n_matches_max,
    bieri = n_matches / n_matches_max
  )
  class(l) <- c("indexBieri", class(l))
  l
}


#' Print method for class indexBieri
#'
#' @param x Object of class `indexBieri`.
#' @param output  String with each letter indicating which parts of the output
#'   to print (default is `"IC"`, order does not matter): `I` = Information, `C`
#'   = Matrix of matches.
#' @param digits Number of digits to display.
#' @export
#' @keywords        internal
#' @md
print.indexBieri <- function(x, output = "I", digits = 3) 
{
  cat("\n######################")
  cat("\nBIERI COMPLEXITY INDEX")
  cat("\n######################\n")
  
  M_c <- x$constructs
  cnames <- constructs(x$grid, collapse = T)
  index <- TRUE
  upper <- TRUE
  width <- NA
  trim <- 50
  
  ## I = Information
  if (str_detect(output, "I")) {
    cat("\nBieri:", round(x$bieri, digits))
    cat("\n")
    cat("\nMaximal rating difference to count as match: ", x$deviation)
    cat("\nTotal no. of matches between constructs: ", x$matches)
    cat("\nMaximum possible no. of matches between constructs: ", x$matches_max)
    cat("\n")
  }
  ## C = Constructs
  if (str_detect(output, "C")) {
    cat(bold("\nMATCHES BETWEEN CONSTRUCTS\n\n"))
    print_square_matrix(M_c, names = cnames, index = index, 
                        upper = upper, trim = trim, width = width)
  }
  
}


#' Dilemmatic constructs
#'
#' A Dilemmatic Construct (DC) is one where the ideal element is rated on the
#' scale midpoint. This means, the person cannot decide which of the poles is
#' preferable. Such constructs are called "dilemmatic". For example, on a rating
#' scale from 1 to 7, a rating of 4 on the ideal element means that the
#' construct is dilemmatic. By definition, DCs can only emerge in scales with an
#' uneven number of rating options, i.e. 5-point scale, 7-point scale etc.
#' However, the function makes it possible to allow for a deviation from the
#' midpoint, to still count as dilemmatic. This is useful if the grid uses a
#' large rating scale, e.g. from 0 to 100 or a visual analog scale, as some grid
#' administration programs do. In this case you may want to set ratings, for
#' example, between 45 and 55 as close enough to the midpoint to indicate that
#' both poles are equally desirable.
#' 
#' @param x A `repgrid` object.
#' @param deviation The maximal deviation from the scale midpoint for an ideal
#'   rating to be considered dilemmatic (default = `0`). For scales larger than
#'   a 17-point rating scale a warning is raised, if deviation is `0` (see
#'   details).
#' @return List of class `indexDilemmatic`:
#' 
#'  * `ideal`: Name of the ideal element.
#'  * `n_constructs` Number of grid's constructs.
#'  * `scale`: Minimum and maximum of grid rating scale.
#'  * `midpoint`: Midpoint of rating scale.
#'  * `lower,upper`: Lower and upper value to for a rating to be considered in the midpoint range.
#'  * `midpoint_range`: Mipoint range as interval.
#'  * `n_dilemmatic`: Number of dilemmatic constructs.
#'  * `perc_dilemmatic`: Percentage of constructs which are dilemmatic.
#'  * `i_dilemmatic`: Index of dilemmatic constructs.
#'  * `dilemmatic_constructs`: Labels of dilemmatic constructs.
#'  * `summary`: Summary dataframe.
#'  
#' @example inst/examples/example-indexDilemmatic.R
#' @export
#' @md  
indexDilemmatic <- function(x, ideal, deviation = 0, warn = TRUE) 
{
  if (!is.repgrid(x))
    stop("'x' must be 'repgrid' object", call. = FALSE)
  ne <- ncol(x)
  if (ideal < 1 || ideal > ncol(x))
    stop("'ideal' must be in the range from 1 to ", ne, call. = FALSE)
  
  # warn if uneven number of rating options
  n_options <- diff(getScale(x)) + 1
  if (n_options %% 2 == 0 && warn) {
    warning("The rating scale has an even number of options (", n_options, "). ",
            "Dilemmatic constructs usually require an uneven rating scale length (see details)", call. = FALSE)
  }
  # warn if uneven number of rating options
  if (n_options >= 16 && deviation == 0 && warn) {
    warning("The rating scale is quite long (", n_options, "). ",
            "You may want to consider allowing deviations from the midpoint (see details)", call. = FALSE)
  }
  
  cnames <- constructs(x, collapse = TRUE)
  R <- ratings(x)
  r_ideal <- R[, ideal]
  m <- midpoint(x)
  sc <- getScale(x)
  lower <-  m - deviation
  upper <- m + deviation
  i_low <- r_ideal >= lower
  i_high <- r_ideal <= upper
  i_dilemmatic <- i_low & i_high
  n_dilemmatic <- sum(i_dilemmatic) 
  midpoint_range <- paste0("[", upper, ", ", lower, "]")
  
  df_dilemmatic <- data.frame(
    Construct = constructs(x, collapse = TRUE),
    Ideal = unname(r_ideal),
    MidpointRange = midpoint_range,
    Dilemmatic = i_dilemmatic
  )
  rownames(df_dilemmatic) <- NULL
  
  l <- list(
    ideal = elements(x)[ideal],
    n_constructs = nrow(x),
    scale = sc,
    midpoint = m,
    deviation = deviation,
    lower = lower,
    upper = upper,
    midpoint_range = midpoint_range,
    n_dilemmatic = n_dilemmatic,
    perc_dilemmatic = n_dilemmatic / nrow(x),
    i_dilemmatic = which(i_dilemmatic),
    dilemmatic_constructs = cnames[i_dilemmatic],
    summary = df_dilemmatic
  )
  class(l) <- c("indexDilemmatic", class(l))
  l
}


#' Print method for class indexDilemmatic
#' 
#' @param x         Object of class indexDilemmatic
#' @param output    String with each letter indicating which parts of the output to print 
#'                  (default is `"SD"`, order does not matter):
#'                  `S` = Summary,
#'                  `D` = Details (dilemmatic constructs).
#' @export
#' @method          print indexDilemmatic
#' @keywords        internal
#' @md
#'
print.indexDilemmatic <- function(x, output = "SD")
{
  output <- toupper(output)
  
  cat("\n#####################")
  cat("\nDilemmatic Constructs")
  cat("\n#####################\n")
  
  ## I = Info
  if (str_detect(output, "S")) {
    cat(bold("\nSUMMARY\n"))
    cat("\nGrid rating scale:", x$scale["min"], "(left pole) to", x$scale["max"], "(right pole)")
    cat("\nScale midpoint:", x$midpoint)
    cat("\nIdeal element:", x$ideal)
    cat("\nDilemmatic: Constructs with ideal ratings in the interval", x$midpoint_range)
    cat("\n")
    cat("\nNo. of dilemmatic constructs:", x$n_dilemmatic)
    cat("\nPercent dilemmatic constructs: ", scales::percent(x$perc_dilemmatic, .1), 
        " (", x$n_dilemmatic, "/", x$n_constructs, ")", sep = "")
  }
  
  ## C = Constructs
  if (str_detect(output, "D")) {
    cat("\n")
    cat(bold("\nDETAILS\n\n"))
    if (x$n_dilemmatic > 0) {
      x$summary %>% dplyr::filter(Dilemmatic) %>% print
    } else {
      cat("  No dilemmatic constructs found.\n")
    }
  }
}


#' Calculate intensity index.
#'
#' The Intensity index has been suggested by Bannister (1960) as a measure of
#' the amount of construct linkage. Bannister suggested that the score reflects
#' the degree of organization of the construct system under investigation
#' (Bannister & Mair, 1968). The index resulted from his and his colleagues work
#' on construction systems of patient suffering schizophrenic thought disorder.
#' The concept of intensity has a theoretical connection to the notion of
#' "tight" and "loose" construing as proposed by Kelly (1991). While tight
#' constructs lead to unvarying prediction, loose constructs allow for varying
#' predictions. Bannister hypothesized that schizophrenic thought disorder is
#' liked to a process of extremely loose construing leading to a loss of
#' predictive power of the subject's construct system. The Intensity score as a
#' structural measure is thought to reflect this type of system disintegration
#' (Bannister, 1960).
#' 
#' Implementation as in the Gridcor programme and explained on the 
#' correspoding help pages: 
#' "\ldots the sum of the squared values of the correlations 
#' of each construct with the rest of the constructs, averaged by the total 
#' number of constructs minus one. This process is repeated with each 
#' element, and the overall Intensity is calculated by averaging the 
#' intensity scores of constructs and elements."
#' \url{http://www.terapiacognitiva.net/record/pag/man11.htm}.
#' Currently the total is calculated as the unweighted average of all 
#' single scores (for elements and construct).
#'
#' @title         Intensity index 
#' @section Development: TODO: Results have not been tested against other programs' results.
#'
#' @param x       \code{repgrid} object.
#' @param rc      Whether to use Cohen's rc for the calculation of
#'                inter-element correlations. See \code{\link{elementCor}}
#'                for further explanations of this measure.
#' @param trim    The number of characters a construct is trimmed to (default is
#'                \code{30}). If \code{NA} no trimming occurs. Trimming
#'                simply saves space when displaying correlation of constructs
#'                or elements with long names.
#' @return        An object of class \code{indexIntensity} containing a list 
#'                with the following elements: \cr
#'                
#'  \item{c.int}{Intensity scores by construct.}
#'  \item{e.int}{Intensity scores by element.}
#'  \item{c.int.mean}{Average intensity score for constructs.}
#'  \item{e.int.mean}{Average intensity score for elements.}
#'  \item{total.int}{Total intensity score.}
#'
#' @export      
#' @author      Mark Heckmann
#'
#' @references    Bannister, D. (1960). Conceptual structure in 
#'                thought-disordered schizophrenics. \emph{The Journal 
#'                of mental science}, 106, 1230-49.
#' @examples 
#' 
#'  indexIntensity(bell2010)
#'  indexIntensity(bell2010, trim = NA)
#'
#'  # using Cohen's rc for element correlations
#'  indexIntensity(bell2010, rc = TRUE)
#'
#'  # save output 
#'  x <- indexIntensity(bell2010)
#'  x
#'  
#'  # printing options
#'  print(x, digits=4)
#'  
#'  # accessing the objects' content
#'  x$c.int
#'  x$e.int
#'  x$c.int.mean
#'  x$e.int.mean
#'  x$total.int
#' 
indexIntensity <- function(x, rc = FALSE, trim = 30)
{
  if (!is.repgrid(x)) 
    stop("'x' must be 'repgrid' object", call. = FALSE)
  
  cr <- constructCor(x, trim = trim)
  nc <- getNoOfConstructs(x)
  diag(cr) <- 0                                           # out zeros in diagonal (won't have an effect)
  c.int <- apply(cr^2, 2, function(x) sum(x) / (nc - 1))  # sum of squared correlations / nc -1 
  
  er <- elementCor(x, rc = rc, trim = trim) 
  ne <- getNoOfElements(x)
  diag(er) <- 0                                           # out zeros in diagonal (won't have an effect)
  e.int <- apply(er^2, 2, function(x) sum(x) / (ne - 1))  # sum of squared correlations / (ne - 1) 
  
  c.int.mean <- mean(c.int, na.rm = TRUE)       # mean of construct intensity scores
  e.int.mean <- mean(e.int, na.rm = TRUE)       # mean of element intensity scores
  
  total.int <- mean(c(c.int, e.int, na.rm = TRUE))
  
  res <- list(c.int = c.int,
              e.int = e.int,
              c.int.mean = c.int.mean,
              e.int.mean = e.int.mean,
              total.int = total.int)	            
  class(res) <- "indexIntensity"
  res
}


#' Print method for class indexIntensity.
#' 
#' @param x         Object of class indexIntensity.
#' @param digits    Numeric. Number of digits to round to (default is 
#'                  \code{2}).
#' @param output    String with each letter indicating which parts of the output to print 
#'                  (default is `"TCE"`, order does not matter):
#'                  `T` = Total Intensity,
#'                  `C` = Constructs' itenstities,
#'                  `E` = Elements' itenstities.
#' @export
#' @method          print indexIntensity
#' @keywords        internal
#' @md
#'
print.indexIntensity <- function(x, digits = 2, output = "TCE")
{
  output <- toupper(output)
  
  cat("\n################")
  cat("\nIntensity index")
  cat("\n################")
  
  ## T = Total
  if (str_detect(output, "T")) {
    cat("\n\nTotal intensity:", round(x$total.int, digits), "\n")
  }
  
  ## C = Constructs
  if (str_detect(output, "C")) {
    cat("\n\nAverage intensity of constructs:", round(x$c.int.mean, digits), "\n")
    cat("\nItensity by construct:\n")
    df.c.int <- data.frame(intensity = x$c.int)
    rownames(df.c.int) <- paste(seq_along(x$c.int), names(x$c.int))
    print(round(df.c.int, digits))
  }
  
  ## E = Elements
  if (str_detect(output, "E")) {
    cat("\n\nAverage intensity of elements:", round(x$e.int.mean, digits), "\n")
    cat("\nItensity by element:\n")
    df.e.int <- data.frame(intensity = x$e.int)
    rownames(df.e.int) <- paste(seq_along(x$e.int), names(x$e.int))
    print(round(df.e.int, digits))
  }
}


#' Polarization (percentage of extreme ratings)
#'
#' Polarization is the percentage of extreme ratings, e.g. the values 1 and 7
#' for a grid with a 7-point ratings scale.
#'
#' @param x A `repgrid` object.
#' @param deviation The maximal deviation from the end of the rating scale for
#'   values to be considered an 'extreme' rating. By default only values that
#'   lie directly on ends of the ratings scales are considered 'extreme'
#'   (default = `0`).
#' @return List of class `indexPolarization`:
#' 
#'  * `scale`: Minimum and maximum of grid rating scale.
#'  * `lower,upper` Lower and upper value to decide which ratings are considered extreme.
#'  * `polarization_total`: Grid's overall polarization.
#'  * `polarization_constructs`: Polarization per construct.
#'  * `polarization_elements`: Polarization per element.
#'    
#' @example inst/examples/example-indexPolarization.R
#' @export
#' @md
indexPolarization <- function(x, deviation = 0) 
{
  if (!is.repgrid(x))
    stop("'x' must be 'repgrid' object", call. = FALSE)
  
  R <- ratings(x)
  sc <- getScale(x)
  lower <-  sc["min"] + deviation
  upper <- sc["max"] - deviation
  i_low <- R <= lower
  i_high <- R >= upper
  ii <- i_low | i_high
  K <- R
  K[,] <- ii  # indicator matrix 0/1
  R[!ii] <- NA
  
  l <- list(
    scale = sc,
    lower = lower,
    upper = upper,
    polarization_total = data.frame(
      Ratings = prod(dim(x)),
      Extreme = sum(K),
      Polarization = mean(K)
    ),
    polarization_constructs = data.frame(
      Construct = constructs(x, collapse = TRUE),
      Ratings = unname(ncol(x)),
      Extremes = unname(rowSums(K)),
      Polarization = unname(rowMeans(K))
    ),
    polarization_elements = data.frame(
      Element = elements(x),
      Ratings = unname(nrow(x)),
      Extremes = unname(colSums(K)),
      Polarization = unname(colMeans(K))
    )
  )
  class(l) <- c("indexPolarization", class(l))
  l
}


#' Print method for class indexPolarization.
#' 
#' @param x         Object of class indexPolarization.
#' @param output    String with each letter indicating which parts of the output to print 
#'                  (default is `"ITCE"`, order does not matter):
#'                  `I` = Information,
#'                  `T` = Total Intensity,
#'                  `C` = Constructs' itenstities,
#'                  `E` = Elements' itenstities.
#' @export
#' @method          print indexPolarization
#' @keywords        internal
#' @md
#'
print.indexPolarization <- function(x, output = "ITCE")
{
  output <- toupper(output)
  
  cat("\n##################")
  cat("\nPolarization index")
  cat("\n##################\n")
  
  ## I = Info
  if (str_detect(output, "I")) {
    cat("\nThe grid is rated on a scale from", 
        x$scale["min"], "(left pole) to", x$scale["max"], "(right pole)")
    cat("\nExtreme ratings are ratings <=", x$lower, "or >=", x$upper)
  }
  
  ## T = Total
  if (str_detect(output, "T")) {
    cat("\n\n")
    cat(bold("\nPOLARIZATION OVERALL\n\n"))
    x$polarization_total %>% mutate(
      Polarization = scales::percent(Polarization, .1)
    ) %>% print
  }
  
  ## C = Constructs
  if (str_detect(output, "C")) {
    cat("\n")
    cat(bold("\nPOLARIZATION BY CONSTRUCT\n\n"))
    x$polarization_constructs %>% mutate(
      Polarization = scales::percent(Polarization, .1)
    ) %>% print
  }
  
  ## E = Elements
  if (str_detect(output, "E")) {
    cat("\n")
    cat(bold("\nPOLARIZATION BY ELEMENT\n\n"))
    x$polarization_elements %>% mutate(
      Polarization = scales::percent(Polarization, .1)
    ) %>% print
  }
}


#' Self construction profile
#' 
#' TBD
#'
#' @param x       A `repgrid` object.
#' @param self    Numeric. Index of self element.
#' @param ideal   Numeric. Index of ideal element. 
#' @param others  Numeric. Index(es) of self related "other" elements (e.g. father, friend).
#' @param method  The distance or correlation measure: 
#'   * Distances:  `euclidean`, `manhattan`, `maximum`,  `canberra`, `binary`, `minkowski`
#'   * Correlations: `pearson`, `kendall`, `spearman`
#' @param p The power of the Minkowski distance, in case `minkowski` is used as
#'   argument for `method`, otherwise it is ignored.
#' @param round   Round average rating scores for 'others' to closest integer?
#' @author    Mark Heckmann, José Antonio González Del Puerto
#' @return    List object of class `indexSelfConstruction`, containing the
#'   results from the calculations:
#'            
#'  * `grid`: Recuced grid with seld, ideal and others
#'  * `method_type`: method type (correlation or distance)
#'  * `method`: correlation or distance method used
#'  * `self_element`: name of the self element
#'  * `ideal_element`: name of the ideal element
#'  * `other_elements`: name(s) of other elements
#'  * `self_ideal`: measure between self and ideal
#'  * `self_others`: measure between self and others
#'  * `ideal_others`: measure betwen ideal and others
#' 
#' @references            
#'  TBD
#'    
#' @export
#' @example inst/examples/example-indexSelfConstruction.R
#' @md
#' 
indexSelfConstruction <- function(x, self, ideal, others = c(-self, -ideal), 
                                  method = "euclidean", p = 2, normalize = TRUE, 
                                  round = FALSE)
{
  # sanity/arg checks
  if (!is.repgrid(x))
    stop("'x' must be a repgrid object", call. = FALSE)
  nc <- ncol(x)
  if (!is.numeric(self) || !length(self) == 1  || !(self >= 1 && self <= nc))  
    stop("'self' must be ONE numeric value in the range from 1 to ", nc, call. = FALSE)
  if (!is.numeric(ideal) || !length(ideal) == 1  || !(ideal >= 1 && ideal <= nc))  
    stop("'ideal' must be ONE numeric value in the range from 1 to ", nc, call. = FALSE)
  if (!is.numeric(others) || !length(others) >= 1)  
    stop("'others' must be a numeric vector with at least one entry", call. = FALSE)
  if (!all(abs(others) >= 1) && all(abs(others) <= nc))  
    stop("indexes indicating 'others' must range between 1 and ", nc, call. = FALSE)
  if (any(others < 0) && any(others > 0))
    stop("It is not allowed to mix positive and negative indexes", call. = FALSE)
  if ( sum(duplicated(abs(others))) > 0)
    stop("duplicated indexes ore not allowed in 'others'", call. = FALSE)
  
  # treat negative indexes
  if (all(others < 0))
    others <- setdiff(1L:nc, abs(others))
  
  # warnings for potentially wring input
  if (self %in% others)
    warning("'self' is also contained in 'others'", call. = FALSE)
  if (ideal %in% others)
    warning("'ideal' is also contained in 'others'", call. = FALSE)
  
  # build a new 'others' element as average rating of all others elements
  digits <- ifelse(round, 0, Inf)
  x <- addAvgElement(x, name = "others", i = others, digits = digits)
  i_others <- ncol(x)
  
  # Select method and get measures
  distances <- c("euclidean", "manhattan", "maximum", "canberra", "binary", "minkowski")
  correlations <- c("pearson", "kendall", "spearman")
  choices <- c(distances, correlations)
  method <- match.arg(method, choices)
  method_type <- NA
  if (method %in% distances) {
    method_type <- "distance"
    S <- distance(x, along = 2, dmethod = method, p = p, normalize = normalize)
  } 
  if (method %in% c("pearson", "kendall", "spearman")) {
    method_type <- "correlation"
    S <- elementCor(x, rc = TRUE, method = method)
  }
  
  # extract relevant measures
  s_self_ideal <- S[self, ideal]
  s_self_others <- S[self, i_others]
  s_ideal_others <- S[ideal, i_others]
  
  enames <- elements(x)
  
  # return indexSelfConstruction object
  l <- list(
    grid = x[, c(self, ideal, i_others)],
    method_type = method_type,
    method = method,
    normalize = normalize,
    round = round,
    self_element = enames[self],
    ideal_element = enames[ideal],
    other_elements = enames[others],
    self_ideal = s_self_ideal,
    self_others = s_self_others,
    ideal_others = s_ideal_others
  )
  class(l) <- c("indexSelfConstruction", class(l))
  l
}


#' Print method for indexSelfConstruction
#' @export
#' @keywords internal
#' 
print.indexSelfConstruction <- function(x, digits = 2, ...) 
{
  w <- options()$width
  l <- x
  cat("=================")
  cat("\nSELF CONSTRUCTION\n")
  cat("=================\n")
  cat("\n  Mean ratings for 'others' rounded to closest integer: ", l$round)
  cat("\n\nMEASURE\n")
  normalized <- ifelse(l$normalize, "normalized", "")
  cat("\n ", normalized, l$method, l$method_type)
  if (l$method_type == "correlation") {
    cat(crayon::blue(
      strwrap("Note: All correlations use Cohen's rc version which is invariant to construct reflections",
              indent = 2, prefix = "\n", exdent = 8)))
  }
  cat("\n")
  cat("\nCOMPARISONS\n",
      "\n  * Self - Ideal: ", round(l$self_ideal, digits),
      "\n  * Self - Others: ", round(l$self_others, digits),
      "\n  * Ideal - Others: ", round(l$ideal_others, digits))
  cat("\n")
  cat("\nELEMENTS\n")
  cat("\n  * self:", l$self_element)
  cat("\n  * ideal:", l$ideal_element)
  cat("\n  * others:", strwrap(paste(l$other_elements, collapse = ", "), width = w - 12, exdent = 12, prefix = "\n", initial = ""))
  cat("\n")
}


# # Alternative using cli package. I do not like the look
# print.indexSelfConstruction <- function(x, digits = 2, ...) 
# {
#   w <- options()$width
#   l <- x
#   cli_h1("COGNITIVE PROFILE")
#   
#   cli_h3("MEASURE")
#   cat_line()
#   cat_line("  ", l$method, " ", l$method_type)
#   if (l$method_type == "correlation") {
#     cat(crayon::blue(
#       strwrap("Note: All correlations use Cohen's rc version which is invariant to construct reflections",
#               indent = 2, prefix = "\n", exdent = 8)))
#   }
#   cli_h3("COMPARISONS")
#   cat_line()
#   comp <- 
#     c(paste("Self - Ideal: ", round(l$self_ideal, digits)),
#       paste("Self - Others: ", round(l$self_others, digits)),
#       paste("Ideal - Others: ", round(l$ideal_others, digits))
#     )
#   cat_bullet(comp)
#   cli_h3("ELEMENTS")
#   cat_line()
#   elems <- 
#     c(paste("self: ", l$self_element),
#       paste("ideal: ", l$ideal_element),
#       paste("others:", strwrap(paste(l$other_elements, collapse = ", "), width = w - 12, exdent = 12, prefix = "\n", initial = ""), collapse = " ")
#     )
#   
#   cat_bullet(elems)
# }


# . ----------
# ___________________ ----
#//////////////////////////////////////////////////////////////////////////////
#      					            CONFLICT MEASURES       							         ----
#//////////////////////////////////////////////////////////////////////////////


# __ Misc ----------------------------------

#' Print function for class indexConflict1
#' 
#' @param x         Object of class indexConflict1.
#' @param digits    Numeric. Number of digits to round to (default is \code{1}).
#' @param ...       Not evaluated.
#' @export
#' @method          print indexConflict1
#' @keywords        internal
#' 
print.indexConflict1 <- function(x, digits=1, ...)
{
  cat("\n################################")
  cat("\nConflicts based on correlations")
  cat("\n################################") 
  cat("\n\nAs devised by Slade & Sheehan (1979)")
  
  cat("\n\nTotal number of triads:", x$total)
  cat("\nNumber of imbalanced triads:",x$imbalanced)
  
  cat("\n\nProportion of balanced triads:", 
      round(x$prop.balanced * 100, digits = digits), "%")
  cat("\nProportion of imbalanced triads:", 
      round(x$prop.imbalanced * 100, digits = digits), "%")
}


#' Conflict measure as proposed by Slade and Sheehan (1979) 
#'
#' The first approach to mathematically derive a conflict measure based on grid
#' data was presented by Slade and Sheehan (1979). Their operationalization is
#' based on an approach by Lauterbach (1975) who applied the \emph{balance
#' theory} (Heider, 1958) for a quantitative assessment of psychological
#' conflict. It is based on a count of balanced and imbalanced triads of
#' construct correlations. A triad is imbalanced if one or all three of the
#' correlations are negative, i. e. leading to contrary implications. This
#' approach was shown by Winter (1982) to be flawed. An improved version was
#' proposed by Bassler et al. (1992) and has been implemented in the function
#' \code{indexConflict2}.
#'
#' The table below shows when a triad made up of the constructs A, B, and C is
#' balanced and imbalanced.
#'
#' \tabular{cccc}{
#'  cor(A,B) \tab  cor(A,C) \tab  cor(B,C) \tab  Triad characteristic \cr
#'  +   \tab  +   \tab  +   \tab   balanced               \cr
#'  +   \tab  +   \tab  -   \tab   imbalanced             \cr
#'  +   \tab  -   \tab  +   \tab   imbalanced             \cr
#'  +   \tab  -   \tab  -   \tab   balanced               \cr
#'  -   \tab  +   \tab  +   \tab   imbalanced             \cr
#'  -   \tab  +   \tab  -   \tab   balanced               \cr
#'  -   \tab  -   \tab  +   \tab   balanced               \cr
#'  -   \tab  -   \tab  -   \tab   imbalanced             \cr
#' }
#'
#' @title         Conflict measure for grids (Slade & Sheehan, 1979) based on correlations.
#'
#' @param x       \code{repgrid} object.
#' @return        A list with the following elements:
#' 
#'    \item{total}{Total number of triads} 
#'    \item{imbalanced}{Number of imbalanced triads} 
#'    \item{prop.balanced}{Proportion of balanced triads} 
#'    \item{prop.imbalanced}{Proportion of imbalanced triads} 
#'
#' @references    Bassler, M., Krauthauser, H., & Hoffmann, S. O. (1992). 
#'                A new approach to the identification of cognitive conflicts 
#'                in the repertory grid: An illustrative case study. 
#'                \emph{Journal of Constructivist Psychology, 5}(1), 95-111.
#'
#'                Heider, F. (1958). \emph{The Psychology of Interpersonal Relation}.
#'                John Wiley & Sons.
#'
#'                Lauterbach, W. (1975). Assessing psychological conflict. 
#'                \emph{The British Journal of Social and Clinical Psychology, 14}(1), 43-47.
#'
#'                Slade, P. D., & Sheehan, M. J. (1979). The measurement of 
#'                'conflict' in repertory grids. \emph{British Journal 
#'                of Psychology, 70}(4), 519-524.
#'  
#'                Winter, D. A. (1982). Construct relationships, psychological 
#'                disorder and therapeutic change. \emph{The British Journal of 
#'                Medical Psychology, 55} (Pt 3), 257-269.
#' 
#' @author        Mark Heckmann
#' @export
#' @seealso \code{\link{indexConflict2}} for an improved version of this measure;
#'          see \code{\link{indexConflict3}} for a measure based on distances.
#'
#' @examples 
#'    
#'    indexConflict1(feixas2004)
#'    indexConflict1(boeker)
#'
indexConflict1 <- function(x) 
{
  if (!inherits(x, "repgrid")) 
    stop("Object must be of class 'repgrid'")
  
  r <- constructCor(x)                    # construct correlation matrix
  z <- fisherz(r)
  nc <- getNoOfConstructs(x)              # number of constructs
  comb <- t(combn(nc, 3))                 # all possible correlation triads
  balanced <- rep(NA, nrow(comb))         # set up result vector
  
  for (i in 1:nrow(comb)) {
    z.triad <- z[t(combn(comb[i, ], 2))]  # correlations of triad
    z.prod <- prod(z.triad)
    if (sign(z.prod) > 0)   # triad is imbalanced if product of correlations is negative
      balanced[i] <- TRUE else
        balanced[i] <- FALSE
  } 
  prop.balanced <- sum(balanced) / length(balanced)    # proportion of 
  prop.imbalanced <- 1 - prop.balanced                                # proportion of 
  
  res <- list(total = length(balanced),
              imbalanced = sum(!balanced),
              prop.balanced = prop.balanced, 
              prop.imbalanced = prop.imbalanced)
  class(res) <- "indexConflict1"
  res
}


#' Conflict measure as proposed by Bassler et al. (1992). 
#'
#' The function calculates the conflict measure as devised by Bassler et al.
#' (1992). It is an improved version of the ideas by Slade and Sheehan (1979)
#' that have been implemented in the function \code{\link{indexConflict1}}. The
#' new approach also takes into account the magnitude of the correlations in a
#' traid to assess whether it is balanced or imbalanced. As a result, small
#' correlations that are psychologically meaningless are considered accordingly.
#' Also, correlations with a  small magnitude, i. e. near zero, which may  be
#' positive or negative due to chance alone will no longer distort the measure
#' (Bassler et al., 1992).
#' 
#' Description of the balance / imbalance assessment:
#'
#' \enumerate{
#'    \item   Order correlations of the triad by absolute magnitude, so that
#'            \eqn{ r_{max} > r_{mdn} > r_{min} }{r_max > r_mdn > r_min}.
#'    \item   Apply Fisher's Z-transformation and devision by 3
#'            to yield values between 1 and -1  
##            (\eqn{ Z_{max} > Z_{mdn} > Z_{min} }{Z_max > Z_mdn > Z_min}).
#'    \item   Check whether the triad is balanced by assessing if the 
#'            following relation holds:
#'    \itemize{
#'        \item   If \eqn{ Z_{max} Z_{mdn} > 0 }{ Z_max x Z_mdn > 0}, 
#'                the triad is balanced if \eqn{ Z_{max} Z_{mdn} - Z_{min} <= crit }
#'                { Z_max x Z_mdn - Z_min <= crit }.
#'        \item   If \eqn{ Z_{max} Z_{mdn} < 0 }{ Z_max x Z_mdn < 0}, 
#'                the triad is balanced if \eqn{ Z_{min}  - Z_{max} Z_{mdn} <= crit }
#'                { Z_min - Z_max x Z_mdn <= crit }.
#'    }        
#'  }
#'
#' @section Personal remarks (MH): I am a bit suspicious about step 2 from above. To devide by 3 appears pretty arbitrary.
#'        The r for a z-values of 3 is 0.9950548 and not 1.
#'        The r for 4 is 0.9993293. Hence, why not a value of 4, 5, or 6?
#'        Denoting the value to devide by with \code{a}, the relation for the
#'        first case translates into \eqn{ a  Z_{max}  Z_{mdn} <= \frac{crit}{a} + Z_{min} }
#'        { a x Z_max x Z_mdn =< crit/a + Z_min}. This shows that a bigger value of \code{a}
#'        will make it more improbabale that the relation will hold.
#'
#'
#' @title         Conflict measure for grids (Bassler et al., 1992) based on correlations.
#'
#' @param x       \code{repgrid} object.
#' @param crit    Sensitivity criterion with which triads are marked as 
#'                unbalanced. A bigger values willl lead to less imbalanced 
#'                triads. The default is \code{0.03}. The value should
#'                be adjusted with regard to the researchers interest.
#' @references    Bassler, M., Krauthauser, H., & Hoffmann, S. O. (1992). 
#'                A new approach to the identification of cognitive conflicts 
#'                in the repertory grid: An illustrative case study. 
#'                \emph{Journal of Constructivist Psychology, 5}(1), 95-111.
#'
#'                Slade, P. D., & Sheehan, M. J. (1979). The measurement of 
#'                'conflict' in repertory grids. \emph{British Journal 
#'                of Psychology, 70}(4), 519-524.
#'
#' @author        Mark Heckmann
#' @export
#' @seealso       See \code{\link{indexConflict1}} for the older version 
#'                of this measure; see \code{\link{indexConflict3}} 
#'                for a measure based on distances instead of correlations.
#'
#' @examples \dontrun{
#'
#'  indexConflict2(bell2010)
#'   
#'  x <- indexConflict2(bell2010)  
#'  print(x)
#'  
#'  # show conflictive triads
#'  print(x, output = 2)
#'  
#'  # accessing the calculations for further use
#'  x$total
#'  x$imbalanced
#'  x$prop.balanced
#'  x$prop.imbalanced
#'  x$triads.imbalanced
#' }
#' 
indexConflict2 <- function(x, crit = .03) 
{
  if (!inherits(x, "repgrid")) 
    stop("Object must be of class 'repgrid'")

  r <- constructCor(x)                    # construct correlation matrix
  z <- fisherz(r)
  nc <- getNoOfConstructs(x)              # number of constructs
  comb <- t(combn(nc, 3))                 # all possible correlation triads
  balanced <- rep(NA, nrow(comb))         # set up result vector
  
  for (i in 1:nrow(comb)) {	
    z.triad <- z[t(combn(comb[i, ], 2))]      # z-values of triad
    ind <- order(abs(z.triad), decreasing = TRUE)  # order for absolute magnitude
    z.triad <- z.triad[ind]               # reorder z values by magnitude               
    z.12 <- prod(z.triad[1:2])            # product of two biggest z values
    z.3 <- z.triad[3]                     # minimal absolute z value
    # select case for inequality relation assessment
    if (sign(z.12) > 0) {
      balanced[i] <- z.12 - z.3 <= crit
    } else {
      balanced[i] <- z.3 - z.12 <= crit
    }  
  } 
  prop.balanced <- sum(balanced) / length(balanced)    # proportion of 
  prop.imbalanced <- 1 - prop.balanced                 # proportion of 
  
  res <- list(total = length(balanced),
              imbalanced = sum(!balanced),
              prop.balanced = prop.balanced, 
              prop.imbalanced = prop.imbalanced,
              triads.imbalanced = comb[!balanced, ])
  class(res) <- "indexConflict2"
  res
}


indexConflict2Out1 <- function(x, digits=1) 
{
  cat("\n###############################")
  cat("\nConflicts based on correlations")
  cat("\n###############################") 
  cat("\n\nAs devised by Bassler et al. (1992)")
  
  cat("\n\nTotal number of triads:", x$total)
  cat("\nNumber of imbalanced triads:", x$imbalanced)  
  cat("\n\nProportion of balanced triads:", 
      round(x$prop.balanced * 100, digits = digits), "%")
  cat("\nProportion of imbalanced triads:", 
      round(x$prop.imbalanced * 100, digits = digits), "%\n")
}


indexConflict2Out2 <- function(x) 
{
  cat("\nConstructs that form imbalanced triads:\n")
  df <- as.data.frame(x$triads.imbalanced)
  colnames(df) <- c(" ", "  ", "   ")
  print(df)
}


#' Print method for class indexConflict2
#' 
#' @param x       A \code{repgrid} object.
#' @param digits  Numeric. Number of digits to round to (default is 
#'                \code{1}).
#' @param output  Numeric. The output printed to the console. \code{output=1} (default) 
#'                will print information about the conflicts to the console.
#'                \code{output = 2} will additionally print the conflictive
#'                triads. 
#' @param ...     Not evaluated.
#' @export
#' @method        print indexConflict2
#' @keywords      internal
#'
print.indexConflict2 <- function(x, digits = 1, output = 1, ...) 
{
  indexConflict2Out1(x, digits = digits) 
  if (output == 2) 
    indexConflict2Out2(x)
} 


#' Conflict measure as proposed by Bell (2004). 
#'
#' Measure of conflict or inconsistency as proposed by Bell (2004). The
#' identification of conflict is based on distances rather than correlations as
#' in other measures of conflict \code{\link{indexConflict1}} and
#' \code{\link{indexConflict2}}. It assesses if the distances between all
#' components of a triad, made up of one element and two constructs, satisfies
#' the "triangle inequality" (cf. Bell, 2004). If not, a triad is regarded as
#' conflictive. An advantage of the measure is that it can be interpreted not
#' only as a global measure for a grid but also on an element, construct, and
#' element by construct level making it valuable for detailed feedback. Also,
#' differences in conflict can be submitted to statistical testing procedures.
#'
#' Status:  working; output for euclidean and manhattan distance 
#'          checked against Gridstat output. \cr
#' TODO:    standardization and z-test for discrepancies; 
#'          Index of Conflict Variation.
#'
#' @title       Conflict or inconsistenciy measure for grids (Bell, 2004) based on distances.
#'
#' @param x             \code{repgrid} object.
#' @param p             The power of the Minkowski distance. \code{p=2} (default) will result
#'                      in euclidean distances, \code{p=1} in city block
#'                      distances.
#' @param e.out         Numeric. A vector giving the indexes of the elements
#'                      for which detailed stats (number of conflicts per element,
#'                      discrepancies for triangles etc.) are promted 
#'                      (default \code{NA}, i.e. no detailed stats for any element).
#' @param e.threshold   Numeric. Detailed stats are prompted for those elements with a an 
#'                      attributable percentage to the overall conflicts 
#'                      higher than the supplied threshold
#'                      (default \code{NA}).
#' @param c.out         Numeric. A vector giving the indexes of the constructs
#'                      for which detailed stats (discrepancies for triangles etc.) 
#'                      are promted (default \code{NA}, i. e. no detailed stats).
#' @param c.threshold   Numeric. Detailed stats are prompted for those constructs with a an 
#'                      attributable percentage to the overall conflicts 
#'                      higher than the supplied threshold
#'                      (default \code{NA}).
#' @param trim          The number of characters a construct (element) is trimmed to (default is
#'                      \code{10}). If \code{NA} no trimming is done. Trimming
#'                      simply saves space when displaying the output.
#'
#' @return              A list (invisibly) containing containing: \cr
#'                      \item{potential}{number of potential conflicts}
#'                      \item{actual}{count of actual conflicts}
#'                      \item{overall}{percentage of conflictive relations}
#'                      \item{e.count}{number of involvements of each element in conflictive relations}
#'                      \item{e.perc}{percentage of involvement of each element in total of conflictive relations}
#'                      \item{e.count}{number of involvements of each construct in conflictive relation}
#'                      \item{c.perc}{percentage of involvement of each construct in total of conflictive relations}
#'                      \item{e.stats}{detailed statistics for prompted elements}
#'                      \item{c.stats}{detailed statistics for prompted constructs}                     
#'                      \item{e.threshold}{threshold percentage. Used by print method}
#'                      \item{c.threshold}{threshold percentage. Used by print method}
#'                      \item{enames}{trimmed element names. Used by print method}
#'                      \item{cnames}{trimmed construct names. Used by print method}
#'
#' @references    Bell, R. C. (2004). A new approach to measuring inconsistency 
#'                or conflict in grids. Personal Construct Theory & Practice, 
#'                (1), 53-59.
#' @section output: For further control over the output see \code{\link{print.indexConflict3}}.
#' @author        Mark Heckmann
#' @export
#' @seealso       See \code{\link{indexConflict1}} and \code{\link{indexConflict2}} 
#'                for conflict measures based on triads of correlations.
#'
#' @examples \dontrun{
#'
#'  # calculate conflicts
#'  indexConflict3(bell2010)
#'  
#'  # show additional stats for elements 1 to 3
#'  indexConflict3(bell2010, e.out = 1:3)
#'  
#'  # show additional stats for constructs 1 and 5
#'  indexConflict3(bell2010, c.out = c(1,5))
#'  
#'  # finetune output
#'  ## change number of digits
#'  x <- indexConflict3(bell2010)
#'  print(x, digits = 4)
#'
#'  ## omit discrepancy matrices for constructs
#'  x <- indexConflict3(bell2010, c.out = 5:6)
#'  print(x, discrepancies = FALSE)
#'  
#' }
#'
#'
indexConflict3 <- function(x, p = 2,  
                           e.out = NA, 
                           e.threshold = NA,
                           c.out = NA, 
                           c.threshold = NA,
                           trim = 20) {
  # To assess the triangle inequality we need:
  #
  # - d.ij   'distance'  between element i and constuct j
  # - d.ik   'distance'  between element i and constuct k
  # - d.jk   distance between the constructs j and k
  #
  # Let the distance between element i and a construct j (i.e. d.ij)
  # be the rating of element i on construct j.
  # The distance between the constucts it the distance (euclidean or city block)
  # between them without taking into account the element under consideration.
  
  s <- getRatingLayer(x)            # grid scores matrix
  ne <- getNoOfElements(x)
  nc <- getNoOfConstructs(x)
  enames <- getElementNames2(x, index = T, trim = trim,  pre = "", post = " ")
  cnames <- getConstructNames2(x, index = T, trim = trim, mode = 1, pre = "", post = " ")
  
  # set up result vectors
  # confict.disc      discrepancy for each triangle (indexed e, c1, c2)
  # confict.e         number of conflicts for each element
  # conflict.c        number of conflicts for each construct
  # conflict.total    overall value of conflictive triangles
  conflict.disc  <- array(NA, dim = c(nc, nc, ne))
  conflict.e  <- rep(0, ne)
  conflict.c  <- rep(0, nc)
  conflict.total <- 0
  conflicts.potential <-  ne * nc * (nc - 1 ) / 2
  # e is i, c1 is j and c2 is k in Bell's Fortran code
  
  for (e in seq_len(ne)) {
    # average distance between constructs c1 and c2 not taking into account
    # the element under consideration. Generalization for any minkwoski metric
    dc <- dist(s[, -e], method = "minkowski", p = p) / (ne - 1)^(1 / p)     # Bell averages the unsquared distances (euclidean), 
    dc <- as.matrix(dc)   # convert dist object to matrix             # i.e. divide euclidean dist by root of n or p in the general case
    
    for (c1 in seq_len(nc)) {
      for (c2 in seq_len(nc)) {
        if (c1 < c2) {
          d.jk <- dc[c1, c2]
          d.ij <- s[c1, e]
          d.ik <- s[c2, e]
          
          # assess if triangle inequality fails., i.e. if one distance is bigger 
          # than the sum of the other two distances. The magnitude it is bigger
          # is recorded in disc (discrepancy)
          if (d.ij > (d.ik + d.jk))
            disc <- d.ij - (d.ik + d.jk) else 
              if (d.ik > (d.ij + d.jk))
                disc <- d.ik - (d.ij + d.jk) else 
                  if (d.jk > (d.ij + d.ik))
                    disc <- d.jk - (d.ij + d.ik) else 
                      disc <- NA
          
          # store size of discrepancy in confict.disc and record discrepancy
          # by element (confict.e) construct (confict.c) and overall (confict.total)
          if (!is.na(disc)) {
            conflict.disc[c1, c2, e]  <- disc
            conflict.disc[c2, c1, e]  <- disc
            conflict.e[e]  <- conflict.e[e] + 1       
            conflict.c[c1]  <- conflict.c[c1] + 1
            conflict.c[c2]  <- conflict.c[c2] + 1
            conflict.total <- conflict.total + 1
          }
        }
      }   
    }
  }
  
  # add e and c names to results
  dimnames(conflict.disc)[[3]] <- enames  
  conflict.e.df <- data.frame(percentage = conflict.e)
  rownames(conflict.e.df) <- enames
  conflict.c.df <- data.frame(percentage = conflict.c)
  rownames(conflict.c.df) <- cnames
  
  
  ### Detailed stats for elements ###
  
  conflictAttributedByConstructForElement <- function(e){
    e.disc.0 <- e.disc.na <- conflict.disc[ , , e]          # version with NAs and zeros for no discrepancies
    e.disc.0[is.na(e.disc.0)] <- 0                          # replace NAs by zeros
    
    e.disc.no <- apply(!is.na(e.disc.na), 2, sum)           # number of conflicts per construct   
    e.disc.perc <- e.disc.no / sum(e.disc.no) * 100         # no conf. per as percentage
    e.disc.perc.df <- data.frame(percentage = e.disc.perc)  # convert to dataframe
    rownames(e.disc.perc.df) <- cnames                      # add rownames
    
    n.conflict.pairs <-  sum(e.disc.no) / 2                 # number of conflicting construct pairs all elements
    disc.avg <- mean(e.disc.0)                              # average level of discrepancy
    disc.sd <- sd(as.vector(e.disc.na), na.rm = TRUE)       # sd of discrepancies
    
    disc.stand <- (e.disc.na - disc.avg) / disc.sd          # standardized discrepancy
    
    list(e = e, 
         disc = e.disc.na,
         pairs = n.conflict.pairs,
         constructs = e.disc.perc.df,
         avg = disc.avg,
         sd = disc.sd)#,
    #disc.stand=round(disc.stand, digits))
  }
  
  
  ### Detailed stats for constructs ###
  
  conflictAttributedByElementForConstruct <- function(c1) 
  {
    c1.disc.0 <- c1.disc.na <- conflict.disc[c1, , ]     # version with NAs and zeros for no discrepancies
    rownames(c1.disc.na) <- paste("c", seq_len(nrow(c1.disc.na)))
    colnames(c1.disc.na) <- paste("e", seq_len(ncol(c1.disc.na)))
    
    c1.disc.0[is.na(c1.disc.0)] <- 0                     # replace NAs by zeros
    
    disc.avg <- mean(c1.disc.0)                          # average level of discrepancy
    disc.sd <- sd(as.vector(c1.disc.na), na.rm = TRUE)   # sd of discrepancies
    list(c1 = c1, 
         disc = c1.disc.na,
         avg = disc.avg,
         sd = disc.sd)#,
    #disc.stand=round(disc.stand, digits))
  }
  
  # Select which detailed stats for elements. Either all bigger than
  # a threshold or the ones selected manually.
  if (!is.na(e.out[1]))
    e.select <- e.out else 
      if (!is.na(e.threshold[1]))
        e.select <- which(conflict.e / conflict.total * 100 > e.threshold) else
          e.select <- NA
  
  e.stats <- list()               # list with detailed results
  if (!is.na(e.select[1])) {
    for (e in seq_along(e.select))
      e.stats[[e]] <- conflictAttributedByConstructForElement(e.select[e]) 
    names(e.stats) <- enames[e.select]   
  }
  
  # Select which detailed stats for constructs. Either all bigger than
  # a threshold or the ones selected manually.
  if (!is.na(c.out[1]))
    c.select <- c.out else 
      if (!is.na(c.threshold[1]))
        c.select <- which(.5 * conflict.c / conflict.total * 100 > c.threshold) else
          c.select <- NA
  
  c.stats <- list()               # list with detailed results
  if (!is.na(c.select[1])) {
    for (c in seq_along(c.select))
      c.stats[[c]] <- conflictAttributedByElementForConstruct(c.select[c])
    names(c.stats) <- cnames[c.select]   
  }
  
  res <- list(potential = conflicts.potential,
              actual = conflict.total,  
              overall = conflict.total/conflicts.potential * 100,
              e.count = conflict.e,
              e.perc = conflict.e.df / conflict.total * 100,
              c.count = conflict.c,
              c.perc = .5 * conflict.c.df / conflict.total * 100,
              e.stats = e.stats,
              c.stats = c.stats,
              e.threshold = e.threshold,    # threshold for elements
              c.threshold = c.threshold,
              enames = enames,                # element names
              cnames = cnames)
  class(res) <- "indexConflict3"
  res
}


### Output to console ###
indexConflict3Out1 <- function(x, digits = 1) 
{
  cat("\n##########################################################")
  cat("\nCONFLICT OR INCONSISTENCIES BASED ON TRIANGLE INEQUALITIES")
  cat("\n##########################################################\n")
  cat("\nPotential conflicts in grid: ", x$potential)
  cat("\nActual conflicts in grid: ", x$actual) 
  cat("\nOverall percentage of conflict in grid: ", 
      round(x$actual / x$potential * 100, digits), "%\n") 
  
  cat("\nELEMENTS")
  cat("\n########\n")
  cat("\nPercent of conflict attributable to element:\n\n")
  print(round(x$e.perc * 100, digits)) 
  cat("\nChi-square test of equal count of conflicts for elements.\n")
  print(chisq.test(x$e.count))
  
  cat("\nCONSTRUCTS")
  cat("\n##########\n")
  cat("\nPercent of conflict attributable to construct:\n\n")
  print(round(x$c.perc , digits))
  cat("\nChi-square test of equal count of conflicts for constructs.\n")
  print(chisq.test(x$c.count))
  #print(sd(conflict.c.perc))
  #print(var(conflict.c.perc))    
}


indexConflict3Out2 <- function(x, digits=1, discrepancies=TRUE) 
{
  e.stats <- x$e.stats
  e.threshold <- x$e.threshold
  enames <- x$enames
  
  if (length(e.stats) == 0)     # stop function in case  
    return(NULL)
  
  cat("\n\nCONFLICTS BY ELEMENT")
  cat("\n####################\n")
  if (!is.na(e.threshold))
    cat("(Details for elements with conflict >", e.threshold, "%)\n")
  
  for (e in seq_along(e.stats)) {
    m <- e.stats[[e]]
    if (!is.null(m)) {
      cat("\n\n### Element: ", enames[m$e], "\n")
      cat("\nNumber of conflicting construct pairs: ", m$pairs, "\n")
      if (discrepancies) {
        cat("\nConstruct conflict discrepancies:\n\n")
        disc <- round(m$disc, digits)
        print(as.data.frame(formatMatrix(disc, rnames = "", 
                                         mode = 2, diag = FALSE), stringsAsFactors = FALSE))
      }
      cat("\nPercent of conflict attributable to each construct:\n\n")    
      print(round(m$constructs, digits))
      cat("\nAv. level of discrepancy:   ", round(m$avg, digits), "\n")
      cat("\nStd. dev. of discrepancies: ", round(m$sd, digits + 1), "\n")
    }
  }
}


indexConflict3Out3 <- function(x, digits = 1, discrepancies = TRUE) 
{
  c.threshold <- x$c.threshold
  c.stats <- x$c.stats
  cnames <- x$cnames
  
  if (length(c.stats) == 0)     # stop function in case  
    return(NULL)
  
  cat("\n\nCONFLICTS BY CONSTRUCT")
  cat("\n######################\n")
  if (!is.na(c.threshold))
    cat("(Details for constructs with conflict >", c.threshold, "%)\n")
  
  for (c in seq_along(c.stats)) {
    x <- c.stats[[c]]
    if (!is.null(x)) {
      cat("\n\n### Construct: ", cnames[x$c1], "\n")
      if (discrepancies) {
        cat("\nElement-construct conflict discrepancies:\n\n")
        disc <- round(x$disc, digits)
        print(as.data.frame(formatMatrix(disc, 
                                         rnames = paste("c", seq_len(nrow(x$disc)), sep = ""), 
                                         cnames = paste("e", seq_len(ncol(x$disc)), sep = ""),
                                         pre.index = c(FALSE, FALSE),
                                         mode = 2, diag = FALSE), stringsAsFactors = FALSE))
      }
      cat("\nAv. level of discrepancy:   ", round(x$avg, digits), "\n")
      cat("\nStd. dev. of discrepancies: ", round(x$sd, digits + 1), "\n")
    }
  }
}


#' print method for class indexConflict3
#' 
#' @param x             Output from funtion indexConflict3
#' @param output        Type of output. \code{output=1} will print all results
#'                      to the console, \code{output=2} will only print the
#'                      detailed statistics for elements and constructs. 
#' @param digits        Numeric. Number of digits to round to (default is 
#'                      \code{2}).
#' @param discrepancies Logical. Whether to show matrices of discrepancies in 
#'                      detailed element and construct stats (default \code{TRUE}).
#' @param ...           Not evaluated.
#' @export
#' @method              print indexConflict3
#' @keywords            internal
#'                    
print.indexConflict3 <- function(x, digits = 2, output = 1, discrepancies = TRUE, ...)
{
  if (output == 1)
    indexConflict3Out1(x, digits = digits) 
  indexConflict3Out2(x, digits = digits, discrepancies = discrepancies)
  indexConflict3Out3(x, digits = digits, discrepancies = discrepancies) 
}


# . ----
# __ Implicative Dilemma ----------------------------------

# plots distribution of construct correlations
#
indexDilemmaShowCorrelationDistribution <- function(x, e1, e2)
{
  rc.including <- constructCor(x)  
  rc.excluding <- constructCor(x[, -c(e1, e2)])
  rc.inc.vals <- abs(rc.including[lower.tri(rc.including)])
  rc.exc.vals <- abs(rc.excluding[lower.tri(rc.excluding)])
  
  histDensity <- function(vals, probs = c(.2, .4, .6, .8, .9), ...) {
    h <- hist(vals, breaks = seq(0, 1.01, len = 21), freq = FALSE, 
              xlim = c(0, 1), border = "white", col = grey(.8), ...)
    d <- density(vals)
    lines(d$x, d$y)
    q <- quantile(vals, probs = probs)
    abline(v = q, col = "red")
    text(q, 0, paste(round(probs * 100, 0), "%"), cex = .8, pos = 2, col = "red")  
  }
  
  layout(matrix(c(1,2), ncol = 1))
  par(mar = c(3,4.2,2.4,2))
  histDensity(rc.inc.vals, cex.main = .8, cex.axis = .8, cex.lab = .8,
              main = "Distribution of absolute construct-correlations \n(including 'self' and 'ideal self')")
  histDensity(rc.exc.vals,  cex.main = .8, cex.axis = .8, cex.lab = .8, 
              main = "Distribution of absolute construct-correlations \n(excluding 'self' and 'ideal self')")
}


# internal workhorse for indexDilemma
#
# @param x               \code{repgrid} object.
# @param self            Numeric. Index of self element.
# @param ideal           Numeric. Index of ideal self element. 
# @param diff.mode       Numeric. Method adopted to classify construct pairs into congruent 
#                        and discrepant. With \code{diff.mode=1}, the minimal and maximal 
#                        score difference criterion is applied. With \code{diff.mode=0} the Mid-point
#                        rating criterion is applied. Default is \code{diff.mode=1}.

# @param diff.congruent  Is used if \code{diff.mode=1}. Maximal difference between
#                        element ratings to define construct as congruent (default
#                        \code{diff.congruent=1}). Note that the value
#                        needs to be adjusted by the user according to the rating scale
#                        used.
# @param diff.discrepant Is used if \code{diff.mode=1}. Minimal difference between
#                        element ratings to define construct as discrepant (default
#                        \code{diff.discrepant=4}). Note that the value
#                        needs to be adjusted by the user according to the rating scale
#                        used.
# @param diff.poles      Not yet implemented.
# @param r.min           Minimal correlation to determine implications between
#                        constructs ([0, 1]).
# @param exclude         Whether to exclude the elements self and ideal self 
#                        during the calculation of the inter-construct correlations.
#                        (default is \code{FALSE}).
# @param index           Whether to print index numbers in front of each construct 
#                        (default is \code{TRUE}).
# @param trim            The number of characters a construct (element) is trimmed to (default is
#                        \code{20}). If \code{NA} no trimming is done. Trimming
#                        simply saves space when displaying the output.
# @param digits          Numeric. Number of digits to round to (default is 
#                        \code{2}).
# @author                Mark Heckmann
# @export
# @keywords internal
# @return                A list with four elements containing different steps of the 
#                        calculation.
#
#
indexDilemmaInternal <- function(x, self, ideal, 
                            diff.mode = 1, diff.congruent = 1,
                            diff.discrepant = 4, diff.poles = 1, 
                            r.min, exclude = FALSE, digits = 2,
                            index = T, trim = FALSE) # CHANGE: set defaults
                                                     # to RECORD 5.0 defaults
{
  nc <- nrow(x)
  ne <- ncol(x)
  enames <- elements(x)
  e_ii <- seq_len(ne) # possible element indexes
  
  if (!self %in% e_ii) 
    stop("'self' element index must be within interval [", 1, ",", ne, "]", call. = FALSE)
  if (!ideal %in% e_ii) 
    stop("'ideal' element index must be within interval [", 1, ",", ne, "]", call. = FALSE)
  if (diff.congruent < 0)
    stop("'diff.congruent' must be non-negative", call. = FALSE)
  if (diff.discrepant < 0)
    stop("'diff.discrepant' must be non-negative", call. = FALSE)
  if (diff.congruent >= diff.discrepant)
    stop("'diff.congruent' must be smaller than 'diff.discrepant'", call. = FALSE)
  if (r.min < 0 | r.min > 1 )
    stop("'r.min' must lie in interval [0, 1]", call. = FALSE)

  # r.min <- abs(r.min)  # direction does not matter the way we process
  s <- ratings(x)      # grid scores matrix
  # create a vector of inverted scores for the 'self' element:
  # invscr = 8 - scr
  # Example: 2 -> 8 - 2 -> 6
  #          5 -> 8 - 5 -> 3
  s_inverted <- ratings(swapPoles(x)) # grid with inverted scores
  cnames <- getConstructNames2(x, index = index, trim = trim, mode = 1, pre = "", post = " ")
  sc <- getScale(x)
  midpoint <- getScaleMidpoint(x)   # NEW (DIEGO) get scale midpoint this is importat in
                                    # when Alejandro's code check whether self/ideal   
                                    # is == to the midpoint or not (see below "Get Dilemmas" section)
  
  # FLAG ALL CONSTRUCTS AS DISCREPANT, CONGRUENT OR NEITHER    
  
  diff.between <- abs(s[, self] - s[, ideal])  # self - ideal difference  
  is.congruent <- logical()
  type.c <- character()
 
  # CORRECTION (ALEJANDRO): 
  # a construct can't be congruent if it's 'self' score is 4 (AKA self-disorientation). 
  # Neither can be congruent if IDEAL is 4 (i.e. midpoint).
  # CORRECTION (Diego): I have just updated this avoid hardcoding the midpoint!!
  if (diff.mode == 1) {
    for (i in 1L:nc) {
      if (s[, self][i] != midpoint) {
        if (s[, ideal][i] != midpoint) {
          is.congruent[i] <- diff.between[i] <= diff.congruent        
        } else{
          is.congruent[i] <- FALSE
        }
      } else {
        is.congruent[i] <- FALSE
      }
    }
    is.discrepant <- diff.between >= diff.discrepant
    is.neither <- !is.congruent & !is.discrepant
    
    type.c[is.congruent] <- "congruent"
    type.c[is.discrepant] <- "discrepant"
    type.c[is.neither] <- "neither"
  }
  
  # # difference from poles NOT YET IMPLEMENTED
  # sc <- getScale(x)
  # diff.pole1 <- abs(s[, c(e.self, e.ideal)] - sc[1])
  # diff.pole2 <- abs(s[, c(e.self, e.ideal)] - sc[2])
  # #are both elements within the allowed distance from the poles and at the same pole (congruent)
  # is.congruent.p <- diff.pole1[,1] <= diff.poles & diff.pole1[,2] <= diff.poles |
  #                   diff.pole2[,1] <= diff.poles & diff.pole2[,2] <= diff.poles
  # is.discrepant.p <- diff.pole1[,1] <= diff.poles & diff.pole2[,2] <= diff.poles |
  #                     diff.pole1[,1] <= diff.poles & diff.pole2[,2] <= diff.poles
  # 
  # is.neither.p <- !is.congruent.p & !is.discrepant.p 
  # type.c.poles[is.congruent.p] <- "congruent"
  # type.c.poles[is.discrepant.p] <- "discrepant"
  # type.c.poles[is.neither.p] <- "neither"
  #
  #
  #//////////////////////////////////////////////////////////////////////////////
  ## MIDPOINT-BASED CRITERION TO IDENTIFY CONGRUENT AND DISCREPANT constructs 
  #//////////////////////////////////////////////////////////////////////////////
  #### added by DIEGO
  #   I have tried to implement here the other popular method for the identification of 
  #   Congruent and Discrepant constructs. This proposed below is that applied by IDIOGRID
  #   software (V.2.3)
  #   IDIOGRID uses "the scale midpoint as the 'dividing line' for discrepancies; for example, 
  #   if the actual self (the Subject Element) is rated above the scale midpoint and the ideal 
  #   self (the Target Element) is rated below the midpoint, then a discrepancy exists (and 
  #   vice versa). If the two selves are rated on the same side of the scale or if either 
  #   the actual self or the ideal self are rated at the midpoint of the scale, then a discre- 
  #   pancy does not exist." (from IDIOGRID manual)

  else if (diff.mode == 0) {
    
    is.congruent <- (s[, self] < midpoint  &  s[, ideal] < midpoint) | 
                    (s[, self] > midpoint  &  s[, ideal] > midpoint)
    is.discrepant <- (s[, self] < midpoint  &  s[, ideal] > midpoint) | 
                     (s[, self] > midpoint  &  s[, ideal] < midpoint)
    is.neither <- !is.congruent & !is.discrepant
    type.c[is.congruent] <- "congruent"
    type.c[is.discrepant] <- "discrepant"
    type.c[is.neither] <- "neither"
  } else {
    stop("Differentiation method (diff.mode) must be 0 or 1", call. = FALSE)
  }

  #--------------- END OF MIDPOINT-BASED CRITERION -----------------------------#
  
  #//////////////////////////////////////////////////////////////////////////////
  # DIEGO: This that I have commented-out is now redundant as the variables are not duplicates 
  # anymore and are calculated only in their conditional loop. This is more efficient
  #//////////////////////////////////////////////////////////////////////////////
  #  if (diff.mode == 1){
  #  is.congruent <- is.congruent.e
  #  is.discrepant <- is.discrepant.e
  #  type.construct <- type.c.elem
  #  } else if (diff.mode == 0){ ##### ADDED CHOICE "0" for MIDPOINT RATING CRITERION
  #  is.congruent <- is.congruent.p
  #  is.discrepant <- is.discrepant.p
  #  type.construct <- type.c.poles 
  #  }
  # we just need the next line to reconnect with the original indexdilemma routine
  #//////////////////////////////////////////////////////////////////////////////
  
  type.construct <- type.c
  # GET CORRELATIONS
  
  # inter-construct correlations including and excluding 
  # the elements self and ideal self
  rc.include <- constructCor(x)                     # TODO digits=digits
  rc.exclude <- constructCor(x[, -c(self, ideal)])  #digits=digits
  
  # correlations to use for evaluation
  if (exclude) {
    rc.use <- rc.exclude 
  } else {
    rc.use <- rc.include
  }
    
  # type.c.poles <- type.c.elem <- rep(NA, nrow(s)) # set up results vectors
  type.c <- rep(NA, nrow(s))
  # GET DILEMMAS
  
  # which pairs of absolute construct correlations are bigger than r.min?
  comb <- t(combn(nc, 2)) # all possible correlation pairs (don't repeat)
  n_construct_pairs <- nrow(comb)   # = factorial(n) / (2*factorial(n - 2))
  needs.to.invert <- logical()
  
  # set up result vectors
  check <- bigger.rmin <- r.include <- r.exclude <- type.c1 <- type.c2 <- rep(NA, nrow(comb))
  
  # check every pair of constructs for characteristics
  for (i in 1L:nrow(comb)) {
    c1 <- comb[i,1]
    c2 <- comb[i,2]
    r.include[i] <- rc.include[c1, c2]
    r.exclude[i] <- rc.exclude[c1, c2]
    type.c1[i] <- type.construct[c1]
    type.c2[i] <- type.construct[c2]
    
    # CORRECTION:
    # To create a dilemma, the 'self' scores of both contructs must be
    # on the same pole. We have to check for that.
    
    # REMOVED HARDCODED MIDPOINT
    # DIEGO: 4 is the midpoint and it was "hardcoded". This is not good if we have a scoring range
    # that is not 1-7 because in that case the midpoint will NOT be 4!
    #
    # DIEGO: another bug-fix is that in the section where the scripts "reorient" the constructs:
    # the code to re-orient the constructs is not controlling for self or ideal self to be scored 
    # as the midpoint. This causes the script break. I have added a condition for those combinations 
    # equivalent to self-score != midpoint
    
    if (s[c1, self] != midpoint & s[c2, self] != midpoint) {
      if (s[c1, self] > midpoint & s[c2, self] > midpoint) {   
        if (rc.use[c1, c2] >= r.min) # CORRECTION: don't use ABS values,
          # we invert scores to check constructs
          # to find correlations the other way
          bigger.rmin[i] <- TRUE else
            bigger.rmin[i] <- FALSE
          check[i] <- (is.congruent[c1] & is.discrepant[c2]) |
            (is.discrepant[c1] & is.congruent[c2])
          needs.to.invert[c1] <- TRUE
          needs.to.invert[c2] <- TRUE
      }
      else if (s[c1, self] < midpoint & s[c2, self] < midpoint) {
        if (rc.use[c1, c2] >= r.min)
          bigger.rmin[i] <- TRUE else
            bigger.rmin[i] <- FALSE
          check[i] <- (is.congruent[c1] & is.discrepant[c2]) |
            (is.discrepant[c1] & is.congruent[c2])
          needs.to.invert[c1] <- FALSE
          needs.to.invert[c2] <- FALSE
      }
      
      # NEW:
      # Now check for inverted scores.
      # You only need to invert one construct at a time
      
      if (s_inverted[c1, self] > midpoint & s[c2, self] > midpoint) {
        r.include[i] = cor(s_inverted[c1,], s[c2,])
        r.exclude[i] = "*Not implemented"
        if (r.include[i] >= r.min) 
          bigger.rmin[i] <- TRUE else
            bigger.rmin[i] <- FALSE
        check[i] <- (is.congruent[c1] & is.discrepant[c2]) |
          (is.discrepant[c1] & is.congruent[c2])
        needs.to.invert[c2] <- TRUE
      }
      else if (s_inverted[c1, self] < midpoint & s[c2, self] < midpoint) {
        r.include[i] = cor(s_inverted[c1,], s[c2,])
        r.exclude[i] = "*Not implemented"
        if (r.include[i] >= r.min) 
          bigger.rmin[i] <- TRUE else
            bigger.rmin[i] <- FALSE
        check[i] <- (is.congruent[c1] & is.discrepant[c2]) |
          (is.discrepant[c1] & is.congruent[c2])
        needs.to.invert[c1] <- TRUE
      }
      
      if (s[c1, self] > midpoint & s_inverted[c2, self] > midpoint) {
        r.include[i] = cor(s[c1,], s_inverted[c2,])
        r.exclude[i] = "*Not implemented"
        if (r.include[i] >= r.min) 
          bigger.rmin[i] <- TRUE else
            bigger.rmin[i] <- FALSE
        check[i] <- (is.congruent[c1] & is.discrepant[c2]) |
          (is.discrepant[c1] & is.congruent[c2])
        needs.to.invert[c1] <- TRUE
      }
      else if (s[c1, self] < midpoint & s_inverted[c2, self] < midpoint) {
        r.include[i] = cor(s[c1,], s_inverted[c2,])
        r.exclude[i] = "*Not implemented"
        if (r.include[i] >= r.min) 
          bigger.rmin[i] <- TRUE else
            bigger.rmin[i] <- FALSE
        check[i] <- (is.congruent[c1] & is.discrepant[c2]) |
          (is.discrepant[c1] & is.congruent[c2])
        needs.to.invert[c2] <- TRUE
      }
    }
    else {# DIEGO: closing of the if() where I put the condition for self to be != to the midpoint score
    needs.to.invert[c1] <- FALSE
    needs.to.invert[c2] <- FALSE
    }
    #print(paste(needs.to.invert,s[c1,self],s[c2,self])) # Diego debug printout of variables
  }
  # New: invert construct label poles if needed
  needs.to.invert[is.na(needs.to.invert)] <- FALSE
  leftpole <- constructs(x)$leftpole 
  rightpole <- constructs(x)$rightpole

  for (i in 1L:nc) {
    if (needs.to.invert[i]) {
      s[i, self] <- s_inverted[i, self]
      s[i, ideal] <- s_inverted[i, ideal]
      cnames[i] = paste(rightpole[i], leftpole[i], sep = ' - ')
    } else {
      cnames[i] = paste(leftpole[i], rightpole[i], sep = ' - ')
    }
  }
  
  # GET RESULTS
  
  ## 1: this data frame contains information related to 'self' and 'ideal' elements
  construct_classification <- data.frame(construct = cnames, a.priori = type.construct, self = s[, self], ideal = s[, ideal], 
                                         stringsAsFactors = FALSE)
  colnames(construct_classification) <- c("Construct", "Classification", "Self", "Ideal")
  rownames(construct_classification) <- NULL
  construct_classification <- construct_classification %>% 
    mutate(
      Difference = abs(Self - Ideal)
    ) %>% 
    select(Construct, Self, Ideal, Difference, Classification)
  
  ## 2: This dataframe stores the information for all posible construct combinations
  all_pairs <- data.frame(c1 = comb[,1], c2 = comb[,2], r.inc = r.include, 
                     r.exc = r.exclude, bigger.rmin, type.c1, type.c2, check,
                     name.c1 = cnames[comb[,1]], name.c2 = cnames[comb[,2]], 
                     stringsAsFactors = FALSE) 
  
  ## 3: This dataframe contains information for all the dilemmas
  dilemmas_info <- subset(all_pairs, check == TRUE & bigger.rmin == TRUE)  
  no_ids <- nrow(dilemmas_info)  # Number of implicative dilemmas
  cnstr.labels = character()
  cnstr.labels.left <- cnstr.labels.right <- cnstr.labels
  cnstr.id.left <- cnstr.id.right <- numeric()
    
  # Put all discrepant constructs to the right
  if (no_ids != 0) {
    for (v in seq_len(no_ids)) {
      if (dilemmas_info$type.c1[v] == 'discrepant') {
        cnstr.labels.left[v] = dilemmas_info[v, "name.c2"]
        cnstr.labels.right[v] = dilemmas_info[v, "name.c1"]
        cnstr.id.left[v] = dilemmas_info[v, "c2"]
        cnstr.id.right[v] = dilemmas_info[v, "c1"]
      }
      else {
        cnstr.labels.left[v] = dilemmas_info[v, "name.c1"]
        cnstr.labels.right[v] = dilemmas_info[v, "name.c2"]
        cnstr.id.left[v] = dilemmas_info[v, "c1"]
        cnstr.id.right[v] = dilemmas_info[v, "c2"]
      }
    }
  }

  
  ## 4: reordered dilemma output
  cnstr.labels.left <- paste0(cnstr.id.left, ". ", cnstr.labels.left)
  cnstr.labels.right <- paste0(cnstr.id.right, ". ", cnstr.labels.right)
  if (no_ids == 0) {
    cnstr.id.left <- numeric()
    cnstr.id.right <- numeric()
    cnstr.labels.left <- character()
    cnstr.labels.right <- character()
  }
  dilemmas_df <- data.frame(cnstr.id.left, cnstr.labels.left, 
                            cnstr.id.right, cnstr.labels.right, 
                            Rtot = dilemmas_info[,3], RexSI = dilemmas_info[,4], 
                            stringsAsFactors = FALSE)                
  # colnames(dilemmas_df) = c('Self - Not self', 'Rtot', 'Self - Ideal', 'RexSI')
  colnames(dilemmas_df) = c("id_c", "Congruent", "id_d", "Discrepant", 'R', 'RexSI')
  
  ## 5: measures
  d = no_ids
  r <- dilemmas_df$R  # correlations between ID pairs
  
  # PID
  # percentage of IDs over total number of possible constructs pairs
  pid = d / nrow(comb) 
  
  # IID
  # Intensity of the implicative dilemma (IID), quotient of the number of 
  # constructs by the probability of finding implicative dilemmas given the matrix size.
  # iid = sqrt(sum(r^2)) / d * 100    # "correct" version from paper
  iid = sum(r) / d * 100          # version as in Gridcor (not as in paper)
  
  # PICID
  # proportion of the intensity of constructs of implicative dilemmas
  # picid = sqrt(sum(r^2)) / n_construct_pairs * 100   # "correct" version from paper
  picid = sum(r) / n_construct_pairs * 100  # version in Gridcor (not as in paper)
  
  # gather measures
  measures <- list(
    iid = iid,
    pid = pid,
    picid = picid
  )

  # REALIGEND GRID
  ii_swap <- which(needs.to.invert)
  x_aligned <- swapPoles(x, pos = ii_swap)
  
  # CONSTRUCTS INVOLVED in IDS
  i_involved <- union(dilemmas_info$c1, dilemmas_info$c2)  
  
  # indexDilemma object
  l <- list(no_ids = no_ids,
            n_construct_pairs = n_construct_pairs,  # = factorial(n) / (2*factorial(n - 2))
            self = self,
            reversed = which(needs.to.invert),
            constructs_involved = i_involved,
            ideal = ideal, 
            elements = enames, 
            diff.discrepant = diff.discrepant, 
            diff.congruent = diff.congruent,
            exclude = exclude, 
            r.min = r.min, 
            diff.mode = diff.mode,
            midpoint = midpoint,
            measures = measures,
            # dataframes
            construct_classification = construct_classification,  # discrepant / congruent
            dilemmas_info = dilemmas_info, 
            dilemmas_df = dilemmas_df,  # table with dilemmas and correlations
            grid_aligned = x_aligned
            )
  class(l) <- c("indexDilemma", class(l))
  l
}


#' Print method for class indexDilemma
#' 
#' @param x         Object of class indexDilemma
#' @param digits    Numeric. Number of digits to round to (default is \code{2}).
#' @param output    String with each letter indicating which parts of the output to print 
#'                  (default is \code{"OCD"}, order does not matter):
#'                  \code{S} = Summary (Number of IDs, PID, etc.),
#'                  \code{P} = Analysis parameters,
#'                  \code{C} = Construct classification table, 
#'                  \code{D} = Implicative dilemmas table. 
#' @param ...       Not evaluated.
#' @method          print indexDilemma
#' @keywords        internal
#' @export
print.indexDilemma <- function(x, digits = 2, output = "SPCD", ...) 
{
  output <- toupper(output)
  enames <- x$elements
  self <- x$self
  ideal <- x$ideal
  diff.mode <- x$diff.mode
  diff.discrepant <- x$diff.discrepant
  diff.congruent <- x$diff.congruent
  r.min <- x$r.min
  no_ids <- x$no_ids
  n_construct_pairs <- x$n_construct_pairs
  exclude <- x$exclude
  midpoint <- x$midpoint
  dilemmas_df <- x$dilemmas_df
  
  # measures
  pid <- x$measures$pid
  iid <- x$measures$iid
  picid <- x$measures$picid
  
  cat("\n####################\n")
  cat("Implicative Dilemmas")
  cat("\n####################\n")
  
  ## Summary and Measures
  if (str_detect(output, "S")) {
    cat("\n-------------------------------------------------------------------------------")
    cat(bold("\n\nSUMMARY:\n"))
    cat("\nNo. of Implicative Dilemmas (IDs):", no_ids)
    cat("\nNo. of possible construct pairs:", n_construct_pairs)
    pid_perc <- scales::percent(pid, .1)
    pid_no <- paste0("(", no_ids, "/", n_construct_pairs, ")")
    cat("\nPercentage of IDs (PID):", pid_perc, pid_no)
    cat("\nIntensity of IDs (IID):", round(iid, 1))
    cat("\nProportion of the intensity of constructs of IDs (PICID):", round(picid, 1))
  }  
  
  ## Parameters
  if (str_detect(output, "P")) {
    cat("\n\n-------------------------------------------------------------------------------")
    cat(bold("\n\nPARAMETERS:\n"))
    cat("\nSelf: Element No.", paste0(self, " = ", enames[self]))
    cat("\nIdeal: Element No.",  paste0(ideal, " = ", enames[ideal]))
    cat("\n\nCorrelation Criterion: >=", r.min)
    if (exclude) {
      cat("\nNote: Correlation calculated excluding elements Self & Ideal") 
    } else {
      cat("\nNote: Correlation calculated including elements Self & Ideal\n")
    }
    cat("\nCriteria (for construct classification):")
    # differentiation mode 0 for midpoint-based criterion (Grices - Idiogrid) OR
    # differentiation mode 1 for Feixas "correlation cut-off" criterion
    if (diff.mode == 1) {
      cat("\nDiscrepant if Self-Ideal difference: >=", diff.discrepant)
      cat("\nCongruent if Self-Ideal difference: <=", diff.congruent)
    } else if (diff.mode == 0) {
      cat("\nUsing Midpoint rating criterion")
    }
  }
  #Extreme Criteria:
  #Discrepant Difference: Self-Ideal greater than or equal to, Max Other-Self difference
  #Congruent Difference: Self-Ideal less than or equal to, Min Other-Self difference  

  ## Classification of constructs:
  if (str_detect(output, "C")) {
    cat("\n\n-------------------------------------------------------------------------------")
    cat(bold("\n\nCLASSIFICATION OF CONSTRUCTS:\n"))
    cat(blue("\n   Note: Constructs aligned so 'Self' corresponds to left pole\n\n"))
    
    # cat(paste0("\n   Note: 'Self' corresponds to left pole ", 
    #            "unless score equals the midpoint (", midpoint, " = undecided)\n\n"))
    print(x$construct_classification)
  }
  
  ## Implicative Dilemmas:
  if (str_detect(output, "D")) {
    cat("\n-------------------------------------------------------------------------------")
    cat(bold("\n\nIMPLICATIVE DILEMMAS:\n"))
    cat(blue("\n   Note: Congruent constructs on the left - Discrepant constructs on the right"))
    cat("\n\n")
    
    if (nrow(dilemmas_df) > 0) {
      dilemmas_df <- dilemmas_df %>% select(-id_c, -id_d)
      dilemmas_df$R <- round(dilemmas_df$R, digits)
      ii <- str_detect(dilemmas_df$RexSI, "\\.")
      dilemmas_df$RexSI[ii] <- as.character(round(as.numeric(dilemmas_df$RexSI[ii]), digits))
      print(dilemmas_df)
      cat("\n\tR = Correlation including Self & Ideal")
      cat("\n\tRexSI = Correlation excluding Self & Ideal")
      cor.used <- ifelse(exclude, "RexSI", "R")
      cat("\n\t", cor.used, " was used as criterion", sep = "")
    } else {
      cat("No implicative dilemmas detected")
    }
  }
}



#' Implicative Dilemmas
#'
#' Implicative dilemmas are closely related to the notion of conflict. An
#' implicative dilemma arises when a desired change on one construct is
#' associated with an undesired implication on another construct. E. g. a timid
#' subject may want to become more socially skilled but associates being
#' socially skilled with different negative characteristics (selfish,
#' insensitive etc.). Hence, he may anticipate that becoming less timid will
#' also make him more selfish (cf. Winter, 1982). As a consequence, the subject
#' will resist to the change if the negative presumed implications will threaten
#' the patients identity and the predictive power of his construct system. From
#' this stance the resistance to change is a logical consequence coherent with
#' the subjects construct system (Feixas, Saul, & Sanchez, 2000). The
#' investigation of the role of cognitive dilemma in different disorders in the
#' context of PCP is a current field of research (e.g. Feixas & Saul, 2004,
#' Dorough et al. 2007).
#'
#' The detection of implicative dilemmas happens in two steps. First the 
#' constructs are classified as being 'congruent' or 'discrepant'. Secondly,
#' the correlation between a congruent and discrepant construct pair
#' is assessed if it is big enough to indicate an implication.
#' 
#' \bold{Classifying the construct} \cr
#' To detect implicit dilemmas the construct pairs are first identified as
#' 'congruent' or 'discrepant'. The assessment is based on the rating
#' differences between the elements 'self' and 'ideal self'.
#' A construct is 'congruent' if the construction of the 'self' and the
#' preferred state (i.e. ideal self) are the same or similar. A construct is
#' discrepant if the construction of the 'self' and the 'ideal' is dissimilar.
#'
#' There are two popular accepted methods to identify congruent and discrepant constructs:
#' \enumerate{
#'    \item  "Scale Midpoint criterion" (cf. Grice 2008)
#'    \item  "Minimal and maximal score difference" (cf. Feixas & Saul, 2004)
#' }
#'
#' \emph{"Scale Midpoint criterion" (cf. Grice 2008)}
#'
#' As reported in the Idiogrid (v. 2.4) manual: "[..] The Scale Midpoint uses the 
#' scales as the 'dividing line' for discrepancies; for example, if the actual 
#' element is rated above the midpoint, then the discrepancy exists (and vice versa). 
#' If the two selves are the same as the actual side of the scale, then a discrepancy 
#' does not exist". As an example:
#' Assuming a scoring range of 1-7, the midpoint score will be 4, we then look at self 
#' and ideal-self scoring on any given construct and we proceed as follow:
#'
#' \itemize{
#'    \item If the scoring of Self AND Ideal Self are both < 4: construct is "Congruent"
#'    \item If the scoring of Self AND Ideal Self are both > 4: construct is "Congruent"
#'    \item If the scoring of Self is < 4 AND Ideal Self is > 4 (OR viceversa): construct is "discrepant"
#'    \item If scoring Self OR Ideal Self = 4 then the construct is NOT Discrepant and it is "Undifferentiated"
#' }
#'
#' \emph{Minimal and maximal score difference criterion (cf. Feixas & Saul, 2004)}
#'
#' This other method is more conservative and it is designed to minimize Type I errors by a) setting
#' a default minimum correlation between constructs of \code{r = .34}; b) discarding cases where the 
#' ideal Self and self are neither congruent or discrepant; c) discarding cases where ideal self is 
#' "not oriented", i.e. scored at the midpoint.
#'
#' E.g. suppose the element 'self' is rated 2 and 'ideal self' 5 on 
#' a scale from 1 to 6. The ratings differences are 5-2 = 3. If this 
#' difference is smaller than e.g. 1 the construct is 'congruent', if it
#' is bigger than 3 it is 'discrepant'. \cr
#'
#' The values used to classify the constructs 'congruent'
#' or 'discrepant' can be determined in several ways (cf. Bell, 2009):
#' \enumerate{
#'    \item   They are set 'a priori'.
#'    \item   They are implicitly derived by taking into account the rating
#'            differences to the other constructs. 
#'            (Not yet implemented)
#' }
#'
#' The value mode is determined via the argument \code{diff.mode}.\cr
#' If no 'a priori' criteria to determine wether the construct
#' is congruent or discrepant is supplied as an argument, the values are chosen
#' according to the range of the rating scale used. For the following scales
#' the defaults are chosen as:
#'
#' \tabular{ll}{
#' Scale                \tab 'A priori' criteria        \cr
#' 1 2                  \tab --> con: <=0    disc: >=1  \cr
#' 1 2 3                \tab --> con: <=0    disc: >=2  \cr
#' 1 2 3 4              \tab --> con: <=0    disc: >=2  \cr
#' 1 2 3 4 5            \tab --> con: <=1    disc: >=3  \cr
#' 1 2 3 4 5 6          \tab --> con: <=1    disc: >=3  \cr
#' 1 2 3 4 5 6 7        \tab --> con: <=1    disc: >=4  \cr
#' 1 2 3 4 5 6 7 8      \tab --> con: <=1    disc: >=5  \cr
#' 1 2 3 4 5 6 7 8 9    \tab --> con: <=2    disc: >=5  \cr
#' 1 2 3 4 5 6 7 8 9 10 \tab --> con: <=2    disc: >=6  \cr
#' }
#' 
#' \bold{Defining the correlations} \cr
#' As the implications between constructs cannot be derived from a 
#' rating grid directly, the correlation between two constructs 
#' is used as an indicator for implication. A large correlation means
#' that one construct pole implies the other. A small correlation 
#' indicates a lack of implication. The minimum criterion for a correlation
#' to indicate implication is set to .35 (cf. Feixas & Saul, 2004).
#' The user may also choose another value. To get a an impression
#' of the distribution of correlations in the grid, a visualization can 
#' be prompted via the argument \code{show}.
#' When calculating the correlation used to assess if an implication
#' is given or not, the elements under consideration (i. e. self and ideal self)
#' can be included (default) or excluded. The options will cause different
#' correlations (see argument \code{exclude}). \cr \cr
#'
#' \bold{Example of an implicative dilemma} \cr
#' A depressive person considers herself as 'timid' and 
#' wished to change to the opposite pole she defines as 'extraverted'. 
#' This construct is called discrepant as the construction of the 'self'
#' and the desired state (e.g. described by the 'ideal self') on 
#' this construct differ. The person also considers herself as 
#' 'sensitive' (preferred pole) for which the opposite pole is 'selfish'. 
#' This construct is congruent, as the person construes herself as 
#' she would like to be. If the person now changed on the discrepant 
#' construct from the undesired to the desired pole, i.e. from timid 
#' to extraverted, the question can be asked what consequences such a 
#' change has. If the person construes being timid and being sensitive 
#' as related and that someone who is extraverted will not be timid, a 
#' change on the first construct will imply a change on the congruent 
#' construct as well. Hence, the positive shift from timid to extraverted
#' is presumed to have a undesired effect in moving from sensitive towards
#' selflish. This relation is called an implicative dilemma. As the 
#' implications of change on a construct cannot be derived from a rating 
#' grid directly, the correlation between two constructs is used as an 
#' indicator of implication.
#'
#'
#' @title                 Detect implicative dilemmas (conflicts).
#'
#' @param x               \code{repgrid} object.
#' @param self            Numeric. Index of self element.
#' @param ideal           Numeric. Index of ideal self element. 
#' @param diff.mode       Numeric. Method adopted to classify construct pairs into congruent 
#'                        and discrepant. With \code{diff.mode=1}, the minimal and maximal 
#'                        score difference criterion is applied. With \code{diff.mode=0} the Mid-point
#'                        rating criterion is applied. Default is \code{diff.mode=1}.
#'
#' @param diff.congruent  Is used if \code{diff.mode=1}. Maximal difference between
#'                        element ratings to define construct as congruent (default
#'                        \code{diff.congruent=1}). Note that the value
#'                        needs to be adjusted by the user according to the rating scale
#'                        used.
#' @param diff.discrepant Is used if \code{diff.mode=1}. Minimal difference between
#'                        element ratings to define construct as discrepant (default
#'                        \code{diff.discrepant=3}). Note that the value
#'                        needs to be adjusted by the user according to the rating scale
#'                        used.
#' @param diff.poles      Not yet implemented.
#' @param r.min           Minimal correlation to determine implications between
#'                        constructs.
#' @param exclude         Whether to exclude the elements self and ideal self 
#'                        during the calculation of the inter-construct correlations.
#'                        (default is \code{FALSE}).
#' @param show            Whether to additionally plot the distribution
#'                        of correlations to help the user assess what level
#'                        is adequate for \code{r.min}.
#' @param index           Whether to print index numbers in front of each construct 
#'                        (default is \code{TRUE}).
#' @param trim            The number of characters a construct (element) is trimmed to (default is
#'                        \code{20}). If \code{NA} no trimming is done. Trimming
#'                        simply saves space when displaying the output.
#' @param digits          Numeric. Number of digits to round to (default is 
#'                        \code{2}).
#'
#' @author                Mark Heckmann, Alejandro García, Diego Vitali
#' @return                List object of class \code{indexDilemma}, containing
#'                        the result from the calculations.
#' @references            
#'                        Bell, R. C. (2009). \emph{Gridstat version 5 - A Program for Analyzing
#'                        the Data of A Repertory Grid} (manual). University of Melbourne,
#'                        Australia: Department of Psychology.
#'                        
#'                        Dorough, S., Grice, J. W., & Parker, J. (2007). Implicative 
#'                        dilemmas and psychological well-being. \emph{Personal Construct
#'                        Theory & Practice}, (4), 83-101.
#'
#'                        Feixas, G., & Saul, L. A. (2004). The Multi-Center Dilemma 
#'                        Project: an investigation on the role of cognitive conflicts 
#'                        in health. \emph{The Spanish Journal of Psychology, 7}(1), 69-78.
#'
#'                        Feixas, G., Saul, L. A., & Sanchez, V. (2000). Detection and 
#'                        analysis of implicative dilemmas: implications for the therapeutic
#'                        process. In J. W. Scheer (Ed.), \emph{The Person in Society: 
#'                        Challenges to a Constructivist Theory}. Giessen: Psychosozial-Verlag.
#'
#'                        Winter, D. A. (1982). Construct relationships, psychological
#'                        disorder and therapeutic change. \emph{British Journal of Medical 
#'                        Psychology, 55} (Pt 3), 257-269.
#'
#'                        Grice, J. W. (2008). Idiogrid: Idiographic Analysis with Repertory 
#'                        Grids (Version 2.4). Oklahoma: Oklahoma State University.
#' @seealso \code{\link{print.indexDilemma}}, \code{\link{plot.indexDilemma}}
#' @export
#' @example inst/examples/example-implicative-dilemmas.R
#'  
indexDilemma <- function(x, self = 1, ideal = ncol(x), 
                         diff.mode = 1, diff.congruent = NA,
                         diff.discrepant = NA, diff.poles = 1, 
                         r.min = .35, exclude = FALSE, digits = 2, show = FALSE,
                         output = 1, index = TRUE, trim = 20) 
{
  # automatic selection of a priori criteria
  sc <- getScale(x)
  if (is.na(diff.congruent))
    diff.congruent <- floor(diff(sc) * .25)
  if (is.na(diff.discrepant))
    diff.discrepant <-  ceiling(diff(sc) * .6)
  
  # detect dilemmas
  res <- indexDilemmaInternal(x, self = self, ideal = ideal, 
                              diff.mode = diff.mode, diff.congruent = diff.congruent,
                              diff.discrepant = diff.discrepant, diff.poles = diff.poles,
                              r.min = r.min, exclude = exclude, digits = digits, 
                              index = index, trim = trim)
  if (show) 
    indexDilemmaShowCorrelationDistribution(x, self, ideal)
  
  res
}



#' Plot method for indexDilemma (network graph)
#'
#' Produces a network graph using of the detected implicative dilemmas using the 
#'  `igraph` package.
#'
#' @param id Object returned by `indexDilemma`.
#' @param layout Name of layout. One of `rows`, `circle`, `star`, or `nicely` or a 
#'   `igraph` layout function.
#' @param both.poles Show both construct poales? (default `TRUE`). If `FALSE`
#' only the poles corresponding to the implied undesired changes are shown.
#' @param digits Number of digits for correlations.
#' @param node.size Size of nodes (default `50`).
#' @param node.text.cex Text size of construct labels.
#' @param node.label.color Color of construct labels.
#' @param node.color.discrepant,node.color.congruent Color of discrepant and congruent constructs nodes. 
#' @param edge.label.color,edge.label.cex Color and size of correlation labels.
#' @param edge.color,edge.arrow.size Color and Size of arrow.
#' @param edge.lty Linetype of arrow.
#' @keywords internal
#' @export
#' @md
plot.indexDilemma <- function(
  id, 
  layout = "rows", 
  both.poles = TRUE, 
  node.size = 50,
  node.text.cex = 1,
  node.label.color = "black",
  node.color.discrepant = "darkolivegreen3",
  node.color.congruent = "lightcoral",
  edge.label.color = grey(.4),
  edge.label.cex = 1,
  edge.digits = 2,
  edge.arrow.size = .5, 
  edge.color = grey(.6),
  edge.lty = 2
) 
{
  # response in case no dilemmas were found
  if (id$no_ids == 0) {
    plot.new()
    text(.5, .5, "No implicative dilemmas detected")
    return(invisible(NULL))
  }
  
  # rename args
  vertex.size <- node.size
  vertex.label.cex <- node.text.cex
  
  # get relevant data from indexDilemma object
  x <- id$grid  
  r.min <- id$r.min
  dilemmas_df <- id$dilemmas_df
  x <- id$grid_aligned
  i_involved <- id$constructs_involved # constructs involved in IDs
  R <- constructCor(x, trim = NA)
  if (both.poles) {
    vertex_labels <- rownames(R) 
  } else {
    vertex_labels <- constructs(x)$rightpole
  }
  vertex_labels <- vertex_labels[i_involved] %>% str_wrap(width = 15)
  
  # Create directed indicator matrix. Only one direction, i.e. from
  # discrepant to congruent construct = negative implication
  # direction in matrix from row (discrepant) to column (congruent)
  K <- R
  K[,] <- 0
  for (i in 1L:nrow(dilemmas_df)) {
    K[ dilemmas_df$id_d[i], dilemmas_df$id_c[i] ] <- 1  # row -> column
  }
  edge_labels <- R[K == 1] %>% round(edge.digits)  # round correlations
  
  # remove non-ID constructs
  W_red <- K[i_involved, i_involved]
  g <- igraph::graph_from_adjacency_matrix(W_red, diag = FALSE, 
                                           mode  = "directed", weighted = TRUE)
  vertex_colors <- dplyr::recode(id$construct_classification$Classification, 
                                 "congruent" = node.color.congruent, 
                                 "discrepant" = node.color.discrepant, 
                                 "neither" = "grey")
  vertex_colors <- vertex_colors[i_involved]
  igraph::V(g)$color <- vertex_colors
  
  # type vector for bipartite layout (boolean)
  vertex_bipart_type <- dplyr::recode(id$construct_classification$Classification, 
                                      "congruent" = T, 
                                      "discrepant" = F, 
                                      "neither" = NA)
  vertex_bipart_type <- vertex_bipart_type[i_involved]
  igraph::V(g)$type <- vertex_bipart_type
  
  # simplified selection among sensible igraph layouts
  if (is.function(layout)) {
    layout <- layout
  } else if (layout == "star") {
    layout <- igraph::layout_as_star
  } else if (layout == "circle") {
    layout <- igraph::layout_in_circle
  } else if (layout == "rows") {
    layout <- igraph::layout_as_bipartite
  } else {
    layout <- igraph::layout_nicely
  } 
  
  old_par <- par(oma = c(0,0,0,0), mar = c(0,0,0,0))
  on.exit(old_par)
  igraph::plot.igraph(g, frame = FALSE, ylim = c(-1.3, 1),
                      layout = layout, rescale = TRUE,
                      edge.curved = FALSE,
                      edge.arrow.size = edge.arrow.size, 
                      edge.label.cex = edge.label.cex,
                      edge.lty = edge.lty, 
                      edge.width = 1.5,
                      edge.label = edge_labels,
                      edge.color = edge.color,
                      edge.label.color = edge.label.color,
                      vertex.size = vertex.size,
                      vertex.size2 = vertex.size,
                      vertex.label = vertex_labels,
                      vertex.label.color = node.label.color,
                      vertex.label.cex = vertex.label.cex,
                      vertex.label.family = "sans",
                      vertex.color = vertex_colors,
                      vertex.frame.color = grey(.5))
  legend(x = "bottom", 
         legend = c("a desired change on 'discrepant' construct", "implies an undesired change on 'congruent' construct"), 
         bty = "n", cex = 1, inset = c(0, 0), 
         xjust = .5, box.col = FALSE, horiz = FALSE, yjust = 1,
         fill = c(node.color.discrepant, node.color.congruent))
}


# dilemmaViz <- function(x) 
# {
  # self <- id$self
  # ideal <- id$ideal
  # i <- 1
  # id$dilemmas_info
  # 
  # r <- ratings(x)  
  # r_self <- r[i, self]
  # r_ideal <- r[i, ideal]
  # 
  # r = .39                      1   2   3   4   5   6   7
  # congruent:  jayn jnay inay  |SI-----------------------| jayn jnay inay
  # discrepant:  sxknsx kmsx    |S----------I-------------| iisxsxsxsxsx
  # 
  # library(crayon)
  #   
  # 
# }




#//////////////////////////////////////////////////////////////////////////////

# Pemutation test to test if grid is random.
# "The null hypothesis [is] that a particular grid 
# is indis- tinguishable from an array of random numbers" 
# (Slater, 1976, p. 129).
#
# randomTest <- function(x){
#   x
# }
# permutationTest
# Hartmann 1992: 
# To illustrate: If a person decided to produce a nonsense grid, 
# the most appropriate way to achieve this goal would be to rate 
#(rank) the elements randomly. The variation of the elements on 
# the con- structs would lack any psychological sense. Every 
# statistical analysis should then lead to noninterpretable results.
markheckmann/OpenRepGrid documentation built on April 30, 2021, 2:33 a.m.