# R/Graphs.R In thectar: Hermeneutic Content Analysis

#### Documented in highlallhighlpoints

#####################################################################
### This file contains the functions producing graphs
#####################################################################

#####################################################################
### highlall (Highlight Similarities version 1)
#####################################################################

#' Highlight highest similarities overall (highlall)
#'
#' \code{highlall} draws the highest similarities (overall) into an MDS graph.
#'
#' This function is applicable to an MDS solution computed with the package
#' '\code{smacof}' (Mair, De Leeuw, Borg, & Groenen) or a set of
#' coordinates. It adds the \code{quantile} percent of highest similarities, as
#' indicated by the similarity matrix \code{similarity}, to the plot of the
#'  respective map. The objects must occur in the same order in the results/
#'  coodinates and the similarity matrix.
#' @param similarity Similarity matrix.
#' @param results Results of \code{smacofSym} or a set of coordinates.
#' @param quantile Percentage of the highest similarities that should be drawn.
#' Default is \code{30}.
#' @param col Color of the graph. Default is \code{black}.
#' @param coordinates If \code{TRUE}, the input \code{results} consist of a set
#' of coordinates. Default is \code{FALSE}.
#' @param add If \code{TRUE}, the points will be added to the existing plot.
#' Default is \code{FALSE}.
#' @param xlim Numeric vector giving the x coordinates range.
#' @param cex.labels Numeric value indicating font size of the labels.
#' @param main Title of the plot.
#' @return Nothing.
#' @export
#' @examples
#' ## Calculating an MDS using the package 'smacof' and showing the 25%
#' ## highest similarities
#' data(SDG_coocurrence)
#' SDG_coocurrence <- SDG_coocurrence[,-2] # Drop second column
#' similarities <- simi(SDG_coocurrence, method = "as")
#' dissimilarities <- 1 - similarities
#' res <- smacof::smacofSym(dissimilarities, type = "ordinal")
#' highlall(similarities, res, quantile = 25, main = "25% Highest Similarities")

highlall <- function(similarity, results, quantile = 30, col = "black",
coordinates = FALSE, add = FALSE, xlim = NULL,
cex.labels = 0.8, main = NULL){

# Find the cut-off value

similarity_dual <- similarity[lower.tri(similarity, diag = FALSE)]
quantile <- (100 - quantile) / 100
quantile <- quantile(similarity_dual, quantile)

# Find the values that are above or equal to the cut-off value

highest_values <- (similarity >= quantile)
highest_values[upper.tri(highest_values, diag = TRUE)] = FALSE

# Find the points to which the values belong

ind <- 1
i <- 1
j <- 1

coordinates_high <- matrix(c(rep(0, length(which(highest_values)) * 2)), ncol = 2)

while(i < length(highest_values[, 1]) + 1){
while(j < length(highest_values[, 1]) + 1){
if(highest_values[i, j] == TRUE){
coordinates_high[ind, 1] <- i
coordinates_high[ind, 2] <- j
ind <- ind + 1
} #while
j <- j + 1
} #while
j = 1
i <- i + 1
} #while

# Plot the graph and draw the lines

if(coordinates == FALSE){
coordinates_points <- results\$conf
}else{
coordinates_points <- results
} #ifelse

if(add == FALSE && coordinates == FALSE){
graphics::plot(results, pch = 19, asp = 1, col = col, xlim = xlim, label.conf = list(label = TRUE, pos =2, col = col, cex = cex.labels), main = main)
}else if(add == FALSE && coordinates == TRUE){
graphics::plot(coordinates_points, asp = 1, pch = 19, col = col,
xlim = xlim, main = main)
graphics::text(coordinates_points + 0.05, rownames(coordinates_points),
cex = cex.labels)
}else{
graphics::points(coordinates_points[,1], coordinates_points[,2],
pch = 19, col = col, xlim = xlim)
graphics::text(coordinates_points + 0.05, rownames(coordinates_points),
cex = cex.labels)
} #ifelse

i <- 1
j <- 1

while(i < length(coordinates_high[, 1]) + 1){
graphics::segments(coordinates_points[coordinates_high[i, 1], 1],
coordinates_points[coordinates_high[i, 1], 2],
coordinates_points[coordinates_high[i, 2], 1],
coordinates_points[coordinates_high[i, 2], 2],
lwd = c(1.9), col = col)
i <- i + 1
} #while

} # function

#####################################################################
### highlpoints (Highlight Similarities version 2)
#####################################################################

#' Highlight highest similarities per point (highlpoints)
#'
#' \code{highlpoints} draws the highest similarities (per point) into an MDS graph.
#'
#' This function is applicable to an MDS solution computed with the package
#' '\code{smacof}' (Mair, De Leeuw, Borg, & Groenen) or a set of
#' indicated by the similarity matrix \code{similarity}, to the plot of the
#' respective map. The links belonging to one point are displayed in
#' the same color. If there is more than one similarity on the last rank
#' \code{link}, all will be shown. The objects must occur in the same order in
#' the results/ coodinates and the similarity matrix.
#' @param similarity Similarity matrix.
#' @param results Results of \code{smacofSym} or a set of coordinates.
#' @param links Number of similarities that should be drawn per point.
#' Default is \code{3}.
#' @param col Color of the points in the graph. Default is \code{black}.
#' @param coordinates If \code{TRUE}, the input \code{results}  consist of a set
#' of coordinates. Default is \code{FALSE}.
#' @param add If \code{TRUE}, the points will be added to the existing plot.
#' Default is \code{FALSE}.
#' @param xlim Numeric vector giving the x coordinates range.
#' @param cex.labels Numeric value indicating font size of the labels.
#' @param main Title of the plot.
#' @return Nothing.
#' @export
#' @examples
#' ## Calculating an MDS using the package 'smacof' and showing the 3 highest
#' ## similarities per point
#' data(SDG_coocurrence)
#' SDG_coocurrence <- SDG_coocurrence[,-2] # Drop second column
#' similarities <- simi(SDG_coocurrence, method = "as")
#' dissimilarities <- 1 - similarities
#' res <- smacof::smacofSym(dissimilarities, type = "ordinal")
#' highlpoints(similarities, res, links = 3,
#' main = "3 Highest Similarities Per Point")

highlpoints <- function(similarity, results, links = 3, col = "black", coordinates = FALSE, add = FALSE, xlim = NULL, cex.labels = 0.8, main = NULL){

# Find the values that fit the criteria

similarity[row(similarity) == col(similarity)] <- 0
highest_values <- matrix(c(rep(FALSE, c(nrow(similarity) *
ncol(similarity)))),
nrow = nrow(similarity), ncol = ncol(similarity))

i <- 1
j <- 1
ind <- 1

v <- 0

while(i < length(similarity[ ,1]) + 1){
max <- which.max(similarity[i, ])
highest_values[i, max] <- TRUE
number <- similarity[i, max]
similarity[i, max] <- c(-1)
v <- rbind(v, i)

if(ind == links) { ### Is this the last turn of the loop? If so we must check that there is not an other equal number.
number_k <- sum(similarity[i, ] == number) ### Is there a same number in the column? How many?
number_i = 1
while(number_i < number_k + 1){
max <- which.max(similarity[i, ]) ### We add these numbers to the list.
highest_values[i, max] <- TRUE
similarity[i,max] <- c(-1)
number_i <- number_i + 1
v <- rbind(v, i)
} #while
} #if

ind <- ind + 1

} #while
ind <- 1
i <- i + 1
} #while

v <- v[-1]

# Find the points to which the values belong

ind <- 1
i <- 1
j <- 1

coordinates_high <- matrix(c(rep(0, length(which(highest_values)) * 2)), ncol = 2)

while(i < length(highest_values[, 1]) + 1){
while(j < length(highest_values[, 1]) + 1){
if(highest_values[i, j] == TRUE){
coordinates_high[ind, 1] <- i
coordinates_high[ind, 2] <- j
ind <- ind + 1
} #if
j <- j + 1
} #while
j <- 1
i <- i + 1
} #while

# Plot the graph and draw the lines

if(coordinates == FALSE){
coordinates_points <- results\$conf
}else{
coordinates_points <- results
} #ifelse

if(add == FALSE && coordinates == FALSE){
graphics::plot(results, pch = 19, asp = 1, col = col, xlim = xlim,
label.conf = list(label = TRUE, pos =2, col = col,
cex = cex.labels), main = main)
}else if(add == FALSE && coordinates == TRUE){
graphics::plot(coordinates_points, asp = 1, pch = 19, col = col,
xlim = xlim, main = main)
graphics::text(coordinates_points + 0.05, rownames(coordinates_points),
cex = cex.labels)
}else{
graphics::points(coordinates_points, pch = 19, col = col, xlim = xlim)
graphics::text(coordinates_points + 0.05, rownames(coordinates_points),
cex = cex.labels)
} #ifelseelse

i <- 1
j <- 1

while(i < length(coordinates_high[, 1]) + 1){
graphics::segments(coordinates_points[coordinates_high[i, 1], 1] +
c((max(coordinates_points[, 1]) -
min(coordinates_points[, 1])) / 186),
coordinates_points[coordinates_high[i, 1], 2] +
c((max(coordinates_points[, 1]) -
min(coordinates_points[, 1])) / 172),
coordinates_points[coordinates_high[i, 2], 1],
coordinates_points[coordinates_high[i, 2], 2],
col = v[i], lty = 1)
i <- i + 1
} #while

} #function

## Try the thectar package in your browser

Any scripts or data that you put into this service are public.

thectar documentation built on Nov. 16, 2019, 1:07 a.m.