Skip to content

Commit

Permalink
finished scatter plot function and add function for line plot
Browse files Browse the repository at this point in the history
  • Loading branch information
@Konrad1991
Konrad1991 committed Mar 20, 2024
1 parent 59b9a02 commit ad60752
Showing 1 changed file with 142 additions and 78 deletions.
220 changes: 142 additions & 78 deletions BiostatsGithubPage/plottingInternally.R
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,21 @@
calcParams <- function(df, formula, method) {
annotateDF <- function(p, method, level = 2) {
pB <- ggplot_build(p) # issue: otherwise data is empty
df <- pB$data[[1]]
l <- pB$layout$layout
l <- data.frame(PANEL = l$PANEL, names = l$`<unknown>`)
df$PANEL <- l[match(df$PANEL, l$PANEL), 2]
# https://stackoverflow.com/questions/40854225/how-to-identify-the-function-used-by-geom-smooth
formula <- p$layers[[level]]$stat$setup_params(df, p$layers[[level]]$stat_params)$formula
df$interaction <- interaction(df$PANEL, df$group)
results <- lapply(unique(df$interaction), function(x) {
sub <- df[df$interaction == x, ]
calcParams(sub, formula, method)
})
df <- Reduce(rbind, results)
return(df)
}

calcParams <- function(df, formula, method) {
if (method == "lm") {
model <- lm(formula, data = df)
r_squared <- summary(model)$r.squared
Expand Down Expand Up @@ -37,7 +54,6 @@
return(df)
} else if(method == "gam") {
model <- gam(formula, data = df)
print(formula)
r_squared <- summary(model)$r.sq
f_value <- summary(model)$p.t
coefficients <- coef(model)
Expand All @@ -55,59 +71,92 @@
df$yPos <- max(df$y)
return(df)
} else if(method == "loess") {
return(p)
model <- loess(formula, data = df)
fitted_values <- predict(model)
r_squared <- cor(df$y, fitted_values)^2
n <- nrow(df)
annotations <- paste("R-squared:", round(r_squared, 2),
"Sample Size (n):", n)
df$annotation <- annotations
df$xPos <- mean(df$x)
df$yPos <- max(df$y)
return(df)
}
}
}

addFacet <- function(p, facetVar, facetMode) {
if(facetMode == "facet_wrap") {
return(p + facet_wrap(.~ .data[[facetVar]], scales = "free"))
} else if(facetMode == "facet_grid") {
return(p + facet_grid(.~ .data[[facetVar]], scales = "free") )
}
}

ReCreatePlot <- function(df, plotMethod) {
DotplotFct <- function(df, x, y, xLabel, yLabel,
fitMethod,
colourVar, legendTitleColour,
colourTheme, facetMode, facetVar, k = 10) {
aes <- aes(x = .data[[x]], y = .data[[y]])
aesColour = NULL
aesFill = NULL
p <- NULL
if(plotMethod == "box") {
p <- ggplot(data = df, aes(x = x, y = y, group = x)) +
geom_boxplot()
} else if(plotMethod == "dot") {
p <- ggplot(data = df, aes(x = x, y = y)) +
geom_point()
} else if(plotMethod == "line") {
p <- ggplot(data = df, aes(x = x, y = y)) +
geom_line()
if (!missing(colourVar)) {
aesColour <- aes(colour = .data[[colourVar]])
}
return(p)
}

annotatePlot <- function(p, method, plotMethod, level = 2, k = 5) {
pB <- ggplot_build(p) # issue: otherwise data is empty
df <- pB$data[[1]]
# https://stackoverflow.com/questions/40854225/how-to-identify-the-function-used-by-geom-smooth
formula <- p$layers[[level]]$stat$setup_params(df, p$layers[[level]]$stat_params)$formula
df$interaction <- interaction(df$PANEL, df$group)
results <- lapply(unique(df$interaction), function(x) {
sub <- df[df$interaction == x, ]
calcParams(sub, formula, method)
})
df <- Reduce(rbind, results)
names(df) <- ifelse(names(df) == "PANEL", "Panel", names(df))
p <- ReCreatePlot(df, plotMethod)
if(method != "gam") {
p <- p + geom_smooth(method = method) +
facet_wrap(.~ Panel)
return(p + geom_text(aes(x = xPos, y = yPos, label = annotation), size = 4))
} else {
p <- p + geom_smooth(method = method, formula = y ~ s(x, bs = "cs", k = k)) +
facet_wrap(.~ Panel)
return(p + geom_text(aes(x = xPos, y = yPos, label = annotation), size = 4))
p <- ggplot(data = df,
aes(!!!aes, !!!aesColour, !!!aesFill)) +
geom_point()
if (!missing(xLabel)) p <- p + xlab(xLabel)
if (!missing(yLabel)) p <- p + ylab(yLabel)
if (!missing(legendTitleColour)) p <- p + guides(colour = guide_legend(title = legendTitleColour))
if (!missing(colourTheme)) p <- p + scale_color_brewer(palette = colourTheme)
if (!missing(facetVar) | !missing(facetMode)) {
p <- addFacet(p, facetVar, facetMode)
}

if (!missing(fitMethod)) {
if(fitMethod == "gam") {
p <- p + geom_smooth(method = fitMethod,
formula = y ~ s(x, bs = "cs", k = k))
} else {
p <- p + geom_smooth(method = fitMethod)
}
df <- annotateDF(p, fitMethod) # issue: add k as parameter
names(df) <- ifelse(names(df) == "PANEL", "Panel", names(df))
if(fitMethod == "gam") {
p <- ggplot(data = df, aes(x = x, y = y, colour = colour)) +
geom_point() +
geom_smooth(method = fitMethod,
formula = y ~ s(x, bs = "cs", k = k)) +
geom_text(aes(x = xPos, y = yPos,
label = annotation, size = 3),
show.legend = FALSE, position = position_dodge(width = .9))

} else {
p <- ggplot(data = df, aes(x = x, y = y, colour = colour)) +
geom_point() +
geom_smooth(method = fitMethod) +
geom_text(aes(x = xPos, y = yPos,
label = annotation, size = 3),
show.legend = FALSE, position = position_dodge(width = .9))
}

if (!missing(xLabel)) p <- p + xlab(xLabel)
if (!missing(yLabel)) p <- p + ylab(yLabel)
if (!missing(legendTitleColour)) p <- p + guides(colour = guide_legend(title = legendTitleColour))
if (!missing(colourTheme)) p <- p + scale_color_brewer(palette = colourTheme)
if (missing(facetVar) | missing(facetMode)) {
return(p)
} else {
p <- addFacet(p, "Panel", facetMode)
return(p)
}
return(p)
}
}

addFacet <- function(p, facetVar, facetMode) {
if(facetMode == "facet_wrap") {
p <- p + facet_wrap(.~ .data[[facetVar]], scales = "free")
}
#else if(facetMode == "facet_grid") {
#return(p + facet_grid(.~ .data[[facetVar]], scales = "free") )
#}
}
return(p)
}

BoxplotFct <- function(df, x, y, xLabel, yLabel,
BoxplotFct <- function(df, x, y, xLabel, yLabel,
fillVar, legendTitleFill, fillTheme,
colourVar, legendTitleColour,
colourTheme, facetMode, facetVar) {
Expand Down Expand Up @@ -138,34 +187,49 @@
p <- addFacet(p, facetVar, facetMode)
}
return(p)
}
}

LineplotFct <- function(df, x, y, xLabel, yLabel,
colourVar, legendTitleColour,
colourTheme, facetMode, facetVar) {
aes <- aes(x = .data[[x]], y = .data[[y]])
aesColour = NULL
p <- NULL
if (!missing(colourVar)) {
aesColour <- aes(colour = .data[[colourVar]])
}
p <- ggplot() +
geom_line(data = df,
aes(!!!aes, !!!aesColour,
group = interaction(.data[[x]],
!!!aesColour) ) )
if (!missing(xLabel)) p <- p + xlab(xLabel)
if (!missing(yLabel)) p <- p + ylab(yLabel)
if (!missing(legendTitleColour)) p <- p + guides(colour = guide_legend(title = legendTitleColour))
if (!missing(colourTheme)) p <- p + scale_color_brewer(palette = colourTheme)
if (missing(facetVar) | missing(facetMode)) {
return(p)
} else {
p <- addFacet(p, facetVar, facetMode)
}
return(p)
}

#BoxplotFct(CO2, "conc", "uptake", xLabel = "bla", yLabel = "uptake2",
# fillVar = "Treatment", legendTitleFill = "Treament fill", fillTheme = "PuOr",
# colourVar = "Type", legendTitleColour = "bla", colourTheme = "hue",
# "facet_wrap", "Type")

BoxplotFct(CO2, "conc", "uptake", xLabel = "bla", yLabel = "uptake2",
fillVar = "Treatment", legendTitleFill = "Treament fill", fillTheme = "PuOr",
colourVar = "Type", legendTitleColour = "bla", colourTheme = "hue",
"facet_wrap", "Type")
#BoxplotFct(CO2, "conc", "uptake", colourVar = "Type")
#BoxplotFct(CO2, "conc", "uptake", colourVar = "Type")
#PlFct("dot", CO2, "conc", "uptake", colourVar = "Type", fillVar = "Treatment")
#method <- "lm"
#p <- ggplot(data = CO2, aes(x = conc, y = uptake)) +
# geom_point(size = 0) +
# geom_boxplot(data = CO2, aes(x = conc, y = uptake, group = conc)) +
# geom_smooth(method = method)
#p
#annotatePlot(p, method, "box", 3)
#DotplotFct(df = CO2, x = "conc", y = "uptake", "xLabel", "yLabel",
# colourVar = "Treatment",
# facetMode = "facet_wrap", facetVar = "Type")
DotplotFct(df = CO2, x = "conc", y = "uptake", "xLabel", "yLabel",
colourVar = "Treatment",
facetMode = "facet_wrap", facetVar = "Type",
fitMethod = "gam", k = 5)
DotplotFct(df = CO2, x = "conc", y = "uptake", "xLabel", "yLabel",
colourVar = "Treatment")

# y
# x
# type of x: numeric or factor
# x label
# y label
# fitting method: none, lm, glm, gam & loess
# fill variable
# legend title fill
# colour variable
# legend title colour
# colour theme
# fill theme
# facet mode: none, wrap, grid
# split plot by
LineplotFct(CO2, "conc", "uptake", xLabel = "bla", yLabel = "uptake2",
colourVar = "Type", legendTitleColour = "bla",
facetMode = "facet_wrap", facetVar = "Type")

0 comments on commit ad60752

Please sign in to comment.