diff --git a/LegendBasicViewer/PlotsAndTables.R b/LegendBasicViewer/PlotsAndTables.R index 96526987..4b036e22 100644 --- a/LegendBasicViewer/PlotsAndTables.R +++ b/LegendBasicViewer/PlotsAndTables.R @@ -6,9 +6,9 @@ createTitle <- function(tcoDbs) { titles <- paste(tcoDbs$outcomeName, "risk in new-users of", - uncapitalize(tcoDbs$targetName), + tcoDbs$targetName, "versus", - uncapitalize(tcoDbs$comparatorName), + tcoDbs$comparatorName, "for", uncapitalize(tcoDbs$indicationId), "in the", @@ -108,7 +108,7 @@ prepareFollowUpDistTable <- function(followUpDist) { prepareMainResultsTable <- function(mainResults, analyses) { table <- mainResults - table$hr <- sprintf("%.2f (%.2f - %.2f)", mainResults$rr, mainResults$ci95lb, mainResults$ci95ub) + table$hr <- sprintf("%.2f (%.2f - %.2f)", mainResults$rr, mainResults$ci95Lb, mainResults$ci95Ub) table$p <- sprintf("%.2f", table$p) table$calHr <- sprintf("%.2f (%.2f - %.2f)", mainResults$calibratedRr, @@ -352,6 +352,7 @@ plotPs <- function(ps, targetName, comparatorName) { ps <- rbind(data.frame(x = ps$preferenceScore, y = ps$targetDensity, group = targetName), data.frame(x = ps$preferenceScore, y = ps$comparatorDensity, group = comparatorName)) ps$group <- factor(ps$group, levels = c(as.character(targetName), as.character(comparatorName))) + levels(ps$group) <- paste0(" " , levels(ps$group), " ") # Add space between legend labels theme <- ggplot2::element_text(colour = "#000000", size = 12) plot <- ggplot2::ggplot(ps, ggplot2::aes(x = x, y = y, color = group, group = group, fill = group)) + @@ -506,24 +507,24 @@ getCoverage <- function(controlResults) { d <- rbind(data.frame(yGroup = "Uncalibrated", logRr = controlResults$logRr, seLogRr = controlResults$seLogRr, - ci95lb = controlResults$ci95lb, - ci95ub = controlResults$ci95ub, + ci95Lb = controlResults$ci95Lb, + ci95Ub = controlResults$ci95Ub, trueRr = controlResults$effectSize), data.frame(yGroup = "Calibrated", logRr = controlResults$calibratedLogRr, seLogRr = controlResults$calibratedSeLogRr, - ci95lb = controlResults$calibratedCi95Lb, - ci95ub = controlResults$calibratedCi95Ub, + ci95Lb = controlResults$calibratedCi95Lb, + ci95Ub = controlResults$calibratedCi95Ub, trueRr = controlResults$effectSize)) d <- d[!is.na(d$logRr), ] - d <- d[!is.na(d$ci95lb), ] - d <- d[!is.na(d$ci95ub), ] + d <- d[!is.na(d$ci95Lb), ] + d <- d[!is.na(d$ci95Ub), ] if (nrow(d) == 0) { return(NULL) } d$Group <- as.factor(d$trueRr) - d$Significant <- d$ci95lb > d$trueRr | d$ci95ub < d$trueRr + d$Significant <- d$ci95Lb > d$trueRr | d$ci95Ub < d$trueRr temp2 <- aggregate(Significant ~ Group + yGroup, data = d, mean) temp2$coverage <- (1 - temp2$Significant) @@ -537,23 +538,23 @@ plotScatter <- function(controlResults) { d <- rbind(data.frame(yGroup = "Uncalibrated", logRr = controlResults$logRr, seLogRr = controlResults$seLogRr, - ci95lb = controlResults$ci95lb, - ci95ub = controlResults$ci95ub, + ci95Lb = controlResults$ci95Lb, + ci95Ub = controlResults$ci95Ub, trueRr = controlResults$effectSize), data.frame(yGroup = "Calibrated", logRr = controlResults$calibratedLogRr, seLogRr = controlResults$calibratedSeLogRr, - ci95lb = controlResults$calibratedCi95Lb, - ci95ub = controlResults$calibratedCi95Ub, + ci95Lb = controlResults$calibratedCi95Lb, + ci95Ub = controlResults$calibratedCi95Ub, trueRr = controlResults$effectSize)) d <- d[!is.na(d$logRr), ] - d <- d[!is.na(d$ci95lb), ] - d <- d[!is.na(d$ci95ub), ] + d <- d[!is.na(d$ci95Lb), ] + d <- d[!is.na(d$ci95Ub), ] if (nrow(d) == 0) { return(NULL) } d$Group <- as.factor(d$trueRr) - d$Significant <- d$ci95lb > d$trueRr | d$ci95ub < d$trueRr + d$Significant <- d$ci95Lb > d$trueRr | d$ci95Ub < d$trueRr temp1 <- aggregate(Significant ~ Group + yGroup, data = d, length) temp2 <- aggregate(Significant ~ Group + yGroup, data = d, mean) temp1$nLabel <- paste0(formatC(temp1$Significant, big.mark = ","), " estimates") @@ -630,7 +631,7 @@ plotScatter <- function(controlResults) { } plotLargeScatter <- function(d, xLabel) { - d$Significant <- d$ci95lb > 1 | d$ci95ub < 1 + d$Significant <- d$ci95Lb > 1 | d$ci95Ub < 1 oneRow <- data.frame(nLabel = paste0(formatC(nrow(d), big.mark = ","), " estimates"), meanLabel = paste0(formatC(100 * @@ -871,10 +872,19 @@ judgePropensityScore <- function(ps, bias) { } uncapitalize <- function(x) { - if (is.character(x)) { - substr(x, 1, 1) <- tolower(substr(x, 1, 1)) - } - x + if (length(x) > 1) { + x <- x[1] + } + terms <- strsplit(x, split = " & ") + terms <- sapply(terms, FUN = function(y) { + substr(y, 1, 1) <- tolower(substr(y, 1, 1)) + y <- gsub("aCE", "ACE", y) + y <- gsub("CCB)", "CCBs)", y) + y + }) + result <- paste(terms, collapse = " and ") + names(result) <- NULL + result } capitalize <- function(x) {