--- title: "Axonal Length" author: "Sergio D?ez Hermano" date: '`r format(Sys.Date(),"%e de %B, %Y")`' output: html_document: highlight: tango toc: yes toc_depth: 4 toc_float: collapsed: no --- ```{r setup, include=FALSE} require(knitr) # include this code chunk as-is to set options opts_chunk$set(comment = NA, prompt = FALSE, fig.height=5, fig.width=5, dpi=300, fig.align = "center", echo = TRUE, message = FALSE, warning = FALSE, cache=FALSE) Sys.setlocale("LC_TIME", "C") ``` ##Load libraries and functions ```{r} library(R.matlab) library(lattice) library(dplyr) library(ggplot2) library(ggridges) library(hrbrthemes) library(viridis) library(ggpubr) library(mltools) library(data.table) library(caret) library(interactions) # library(performance) library(MASS) library(geepack) library(pstools) library(MXM) library(rmcorr) library(multcomp) library(Hmisc) options(digits = 10) # https://rstudio-pubs-static.s3.amazonaws.com/297778_5fce298898d64c81a4127cf811a9d486.html ################ # Bootstrap PI # ################ the.replication <- function(reg, s, x_Np1 = 0){ # Make bootstrap residuals ep.star <- sample(s, size=length(reg$residuals),replace=TRUE) # Make bootstrap Y y.star <- fitted(reg) + ep.star # Do bootstrap regression lp <- model.frame(reg)[,2] nt <- model.frame(reg)[,3] bs.reg <- lm(y.star ~ lp:nt - 1) # Create bootstrapped adjusted residuals bs.lev <- influence(bs.reg)$hat bs.s <- residuals(bs.reg)/sqrt(1-bs.lev) bs.s <- bs.s - mean(bs.s) # Calculate draw on prediction error # xb.xb <- coef(my.reg)["(Intercept)"] - coef(bs.reg)["(Intercept)"] xb.xb <- (coef(my.reg)[1] - coef(bs.reg)[1])*x_Np1 return(unname(xb.xb + sample(bs.s, size=1))) } ############################ # Bootstrap PI generalized # ############################ the.replication.gen <- function(reg, s, axType, x_Np1 = 0){ # Make bootstrap residuals ep.star <- sample(s, size=length(reg$residuals), replace=TRUE) # Make bootstrap Y y.star <- fitted(reg) + ep.star # Do bootstrap regression lp <- model.frame(reg)[,2] nt <- model.frame(reg)[,3] bs.reg <- lm(y.star ~ lp:nt - 1) # Create bootstrapped adjusted residuals bs.lev <- influence(bs.reg)$hat bs.s <- residuals(bs.reg)/sqrt(1-bs.lev) bs.s <- bs.s - mean(bs.s) # Calculate draw on prediction error # xb.xb <- coef(my.reg)["(Intercept)"] - coef(bs.reg)["(Intercept)"] xb.xb <- (coef(my.reg)[axType] - coef(bs.reg)[axType])*x_Np1 return(unname(xb.xb + sample(bs.s, size=1))) } ############################## # Bootstrap PI per axon type # ############################## the.replication.type <- function(reg, s, x_Np1 = 0){ # Make bootstrap residuals ep.star <- sample(s, size=length(reg$residuals),replace=TRUE) # Make bootstrap Y y.star <- fitted(reg) + ep.star # Do bootstrap regression lp <- model.frame(reg)[,2] bs.reg <- lm(y.star ~ lp - 1) # Create bootstrapped adjusted residuals bs.lev <- influence(bs.reg)$hat bs.s <- residuals(bs.reg)/sqrt(1-bs.lev) bs.s <- bs.s - mean(bs.s) # Calculate draw on prediction error # xb.xb <- coef(my.reg)["(Intercept)"] - coef(bs.reg)["(Intercept)"] xb.xb <- (coef(my.reg) - coef(bs.reg))*x_Np1 return(unname(xb.xb + sample(bs.s, size=1))) } ############################## # Stratified random sampling # ############################## stratified <- function(df, group, size, select = NULL, replace = FALSE, bothSets = FALSE) { if (is.null(select)) { df <- df } else { if (is.null(names(select))) stop("'select' must be a named list") if (!all(names(select) %in% names(df))) stop("Please verify your 'select' argument") temp <- sapply(names(select), function(x) df[[x]] %in% select[[x]]) df <- df[rowSums(temp) == length(select), ] } df.interaction <- interaction(df[group], drop = TRUE) df.table <- table(df.interaction) df.split <- split(df, df.interaction) if (length(size) > 1) { if (length(size) != length(df.split)) stop("Number of groups is ", length(df.split), " but number of sizes supplied is ", length(size)) if (is.null(names(size))) { n <- setNames(size, names(df.split)) message(sQuote("size"), " vector entered as:\n\nsize = structure(c(", paste(n, collapse = ", "), "),\n.Names = c(", paste(shQuote(names(n)), collapse = ", "), ")) \n\n") } else { ifelse(all(names(size) %in% names(df.split)), n <- size[names(df.split)], stop("Named vector supplied with names ", paste(names(size), collapse = ", "), "\n but the names for the group levels are ", paste(names(df.split), collapse = ", "))) } } else if (size < 1) { n <- round(df.table * size, digits = 0) } else if (size >= 1) { if (all(df.table >= size) || isTRUE(replace)) { n <- setNames(rep(size, length.out = length(df.split)), names(df.split)) } else { message( "Some groups\n---", paste(names(df.table[df.table < size]), collapse = ", "), "---\ncontain fewer observations", " than desired number of samples.\n", "All observations have been returned from those groups.") n <- c(sapply(df.table[df.table >= size], function(x) x = size), df.table[df.table < size]) } } temp <- lapply( names(df.split), function(x) df.split[[x]][sample(df.table[x], n[x], replace = replace), ]) set1 <- do.call("rbind", temp) if (isTRUE(bothSets)) { set2 <- df[!rownames(df) %in% rownames(set1), ] list(SET1 = set1, SET2 = set2) } else { set1 } } ``` ##Load data ```{r} # Get file paths axonNames <- list.files(paste("ProyeccionData/", sep=""), full.names=T) # Load matlab file axonFiles <- lapply(axonNames, function(x) readMat(x)) names(axonFiles) <- c("Type1", "Type2", "Type3", "Type4") # VAR NAMES # REAL_LENGTH, PROYECTION_LENGTH_XY, PROYECTION_LENGTH_XZ, PROYECTION_LENGTH_YZ # Extract data realLength <- lapply(axonFiles, function(x) x$REAL.LENGTH) planeXY <- lapply(axonFiles, function(x) x$PROYECTION.LENGTH.XY) planeXZ <- lapply(axonFiles, function(x) x$PROYECTION.LENGTH.XZ) planeYZ <- lapply(axonFiles, function(x) x$PROYECTION.LENGTH.YZ) # Get number of neurons per type numberTypes <- unlist(lapply(realLength, function(x) length(x))) # Store in data frames by plane xyData <- data.frame(id = 1:length(unlist(realLength)), LR = unlist(realLength), LP = unlist(planeXY), Plane = rep("XY", sum(numberTypes)), neurType = rep(c("Type1", "Type2", "Type3", "Type4"), numberTypes)) xzData <- data.frame(id = 1:length(unlist(realLength)), LR = unlist(realLength), LP = unlist(planeXZ), Plane = rep("XZ", sum(numberTypes)), neurType = rep(c("Type1", "Type2", "Type3", "Type4"), numberTypes)) yzData <- data.frame(id = 1:length(unlist(realLength)), LR = unlist(realLength), LP = unlist(planeYZ), Plane = rep("YZ", sum(numberTypes)), neurType = rep(c("Type1", "Type2", "Type3", "Type4"), numberTypes)) # Merge into a single data frame and sort by id allData <- do.call("rbind", list(xyData, xzData, yzData)) allData <- allData[order(allData$id),] # Add different number for every neuron-plane combination allData$NeurPlane <- c(rep(c(1,2,3), numberTypes[1]), rep(c(4,5,6), numberTypes[2]), rep(c(7,8,9), numberTypes[3]), rep(c(10,11,12), numberTypes[4])) allData$interact <-interaction(allData$neurType, allData$Plane, lex.order=T) allData$idR <- 1:dim(allData)[1] # Create data frame w/o Type4 dataNo4 <- allData[allData$neurType != "Type4", ]; dataNo4$neurType <- factor(dataNo4$neurType) # Data in short format dataShort <- data.frame(id = 1:length(unlist(realLength)), LR = unlist(realLength), XY = unlist(planeXY), XZ = unlist(planeXZ), YZ = unlist(planeYZ), neurType = rep(c("Type1", "Type2", "Type3", "Type4"), numberTypes)) ``` ##CV-Bootstrap Pred Interval RUN ONLY ONCE, AFTERWARDS LOAD THE FILE IN MEAN ERRORS CHUNK ```{r} # Ensure reproducibility set.seed(123456) axList <- list() for (h in unique(allData$neurType)) { # Subset axon type dataCV <- allData[allData$neurType == h, ] # List to store CV repetitions cvList <- list () cvRand <- list() # Stratified random 5-fold sets setList <- list() sampSize <- 0.2*length(unique(dataCV$id)) groupDat1 <- dataCV %>% group_by(Plane) set1<- sample_n(groupDat1, sampSize) groupDat2 <- groupDat1[-set1$idR, ] set2 <- sample_n(groupDat2, sampSize) groupDat3 <- groupDat2[-set2$idR, ] set3 <- sample_n(groupDat3, sampSize) groupDat4 <- groupDat3[-set3$idR, ] set4 <- sample_n(groupDat4, sampSize) groupDat5 <- groupDat4[-set4$idR, ] set5 <- sample_n(groupDat5, sampSize) # Store sets (ungrouped) setList <- lapply(list(set1, set2, set3, set4, set5), ungroup) axList[[h]]$sets <- setList # List to store CV cvList <- list() for (i in 1:5) { # Stratified random training/test sets trainSet <- do.call(rbind, setList[-i]) testSet <- setList[[i]] # OLS with training set my.reg <- lm(LR ~ LP - 1, trainSet) # Create adjusted residuals leverage <- influence(my.reg)$hat my.s.resid <- residuals(my.reg)/sqrt(1-leverage) my.s.resid <- my.s.resid - mean(my.s.resid) # List to store planes planeList <- list() # Bootstrapping on test set for (j in c("XY", "XZ", "YZ")) { # Subset plane dataSub <- testSet[testSet$Plane == j, ] # List to store errors epList <- list() epCount <- 1 for (k in dataSub[ , "LP"]) { # Do bootstrap with 100 replications ep.draws <- replicate(n=100, the.replication.type(reg = my.reg, s = my.s.resid, x_Np1 = k)) # Store in list epList[[epCount]] <- ep.draws epCount <- epCount + 1 } # Store in list planeList[[j]] <- epList print(paste("CV", i, "Plane", j, "finished")) } # Store in list cvList[[i]] <- planeList } # Store in list axList[[h]]$cv <- cvList print(paste("Axon", h, "finished")) } saveRDS(axList, paste("projection_5CV_allAxons.rds", sep = "")) ``` ##Estimate porcentual errors ```{r, fig.width=8, fig.height=8} # Load 5-fold CV axList <- readRDS("ProyeccionAnalysis/projection_5CV_allAxons.rds") # Estimate and store in list peList <- list() peCount <- 1 lrLength <- list() for (h in c("Type1", "Type2", "Type3", "Type4")) { for (i in 1:5) { for (j in c("XY", "XZ", "YZ")) { # Extract LR values lr <- axList[[h]]$sets[[i]] lr <- lr[lr$Plane == j, "LR"] # Extract LP values lp <- axList[[h]]$cv[[i]][[j]][[1]] for (k in 1:dim(lr)[1]) { # Divide errors by LR to get porcentual errors pe <- lp[k, ] / lr$LR[k] # Store in list peList[[peCount]] <- pe*100 peCount <-peCount + 1 } } } lrLength[h] <- dim(lr)[1] } # Store in data frame lrLength <- unlist(lrLength) peFrame <- data.frame(pe = unlist(peList), neurType = rep(c("Type1", "Type2", "Type3", "Type4"), times = lrLength*5*3*100), Plane = c(rep(rep(c("XY", "XZ", "YZ"), each = lrLength[1]*100), 5), rep(rep(c("XY", "XZ", "YZ"), each = lrLength[2]*100), 5), rep(rep(c("XY", "XZ", "YZ"), each = lrLength[3]*100), 5), rep(rep(c("XY", "XZ", "YZ"), each = lrLength[4]*100), 5))) peFrame$interact <- interaction(peFrame$neurType, peFrame$Plane, lex.order=T) ``` ####Plot density and histogram ```{r} # Plot # peGroup <- peFrame %>% group_by(interact) # peSample <- sample_n(peGroup, 100) setwd("ProyeccionFigures/") png(filename=paste("prederrorDistributions_5CV.png", sep=""), type="cairo", units="in", width=8, height=10, pointsize=12, res=300) (p <- ggplot(peFrame, aes(x = `pe`, y = `interact`, fill = ifelse(..x.. >=-5 & ..x.. <=5, ">= -5", "< 5"))) + scale_fill_manual(values = c("gray70", "coral2"), name = NULL) + geom_density_ridges_gradient(alpha = 0.8) + theme_ridges() + theme(legend.position = "none") + xlab("% Error")) + xlim(c(-40,40)) dev.off() png(filename=paste("prederrorHistogram_5CV.png", sep=""), type="cairo", units="in", width=8, height=10, pointsize=12, res=300) # Histogram # nint 300 bootPI # nint 500 bootPI_full # nint 400 bootPI_full_replace (h <- histogram( ~ pe | Plane + neurType, peFrame, nint = 300, type ="density", xlim = c(-50,50))) dev.off() ``` #####Insets ```{r} # Find mean bandwidth bwFrame <- aggregate(pe ~ neurType + Plane, peFrame, function(x) density(x)$bw) # Named color vector colVec <- c("limegreen", "blue", "red") names(colVec) <- c("XY", "XZ", "YZ") setwd("ProyeccionFigures/") for (i in unique(peFrame$neurType)) { png(filename=paste("insetProb_", i, ".png", sep=""), type="cairo", units="in", width=5, height=5, pointsize=12, res=300) par(mfrow = c(3,2), oma = c(5,4,0,0) + 0.1, mar = c(0,0,1,1) + 0.1) for (j in unique(peFrame$Plane)) { # Estimate density dens <- density(peFrame[peFrame$neurType == i & peFrame$Plane == j, "pe"], bw = mean(bwFrame$pe)) # 5% x1 <- min(which(dens$x >= -5)) x2 <- max(which(dens$x < 5)) plot(dens, ylim = c(0, 0.15), xlim = c(-20,20), zero.line = FALSE, main = "", ylab = "", xlab = "", axes = FALSE) with(dens, polygon(x=c(x[c(x1,x1:x2,x2)]), y= c(0, y[x1:x2], 0), col=colVec[[j]], border = NA)) lines(dens) # Add y axis axis(side = 2, at=seq(-0.05,0.15,0.05), labels = seq(-0.05,0.15,0.05), cex.axis = 1.2) # Different x axis for bottom plot if (j == "YZ") { axis(side = 1, at=seq(-30,30,10), labels = seq(-30,30,10), cex.axis = 1.2) } else { axis(side = 1, at=seq(-30,30,10), labels = FALSE) } # 10% x1 <- min(which(dens$x >= -10)) x2 <- max(which(dens$x < 10)) plot(dens, ylim = c(0, 0.15), xlim = c(-20,20), zero.line = FALSE, main = "", ylab = "", xlab = "", axes = FALSE) with(dens, polygon(x=c(x[c(x1,x1:x2,x2)]), y= c(0, y[x1:x2], 0), col=colVec[[j]], border = NA)) lines(dens) # Add y axis axis(side = 2, at=seq(-0.05,0.15,0.05), labels = FALSE) # Different x axis for bottom plot if (j == "YZ") { axis(side = 1, at=seq(-30,30,10), labels = seq(-30,30,10), cex.axis = 1.2) } else { axis(side = 1, at=seq(-30,30,10), labels = FALSE) } } title(xlab = "% Error", ylab = "Density", outer = TRUE, line = 3, cex.lab = 1.5) dev.off() } ``` ####Errors vs cumul probability RUN ONLY ONCE, AFTERWARDS LOAD THE FILE IN PLOT CHUNKS ```{r, fig.height=5, fig.width=20} # Inverse quantile quantInv <- function(distr, value) ecdf(distr)(value) #ecdf plot example # plot(ecdf(peFrame[peFrame$interact == "Type1.XY", "pe"])) # lines(ecdf(peFrame[peFrame$interact == "Type1.XZ", "pe"]), col = "red") # lines(ecdf(peFrame[peFrame$interact == "Type1.YZ", "pe"]), col = "blue") probList <- list() binProb <- 0.5 probSeq <- seq(binProb, 100, binProb) for (i in unique(peFrame$interact)) { dataProb <- peFrame[peFrame$interact == i, "pe"] probVec <- numeric() for (j in probSeq) { errProb <- quantInv(dataProb, j) - quantInv(dataProb, -j) probVec <- c(probVec, errProb) } probList[[i]] <- probVec } setwd("ProyeccionAnalysis/") saveRDS(probList, "cumProb_5CV.rds") ``` #####Plot ```{r, fig.height=5, fig.width=20} # Plot with limited axis setwd("ProyeccionFigures/") probList <- readRDS("cumProb_5CV.rds") png(filename=paste("errorProbabilityCum_bin", binProb, "_5CV.png", sep=""), type="cairo", units="in", width=20, height=5, pointsize=12, res=300) par(mfrow = c(1,4)) hlist <- list() axCount <- 1 for (i in seq(1,10,3)) { # Extract height for 5% error h5 <- sapply(probList[i:(i+2)], function(x) x[5/binProb]) max5 <- max(h5) # Extract height for 10% error h10 <- sapply(probList[i:(i+2)], function(x) x[10/binProb]) max10 <- max(h10) # Plot cumulative curves plot(probSeq, probList[[i]], type = "l", col = "limegreen", lwd = 1.5, ylim = c(0,1), xlim = c(0.5, 40), ylab = "Cumulative probability", xlab = "% Error", main = paste("Axon Type", axCount)) lines(probSeq, probList[[i + 1]], col = "red", lwd = 1.5) lines(probSeq, probList[[i + 2]], col = "blue", lwd = 1.5) # Plot vertical segments at 5% and 10% segments(5, -0.1, 5, max5, lty = "dashed", col = "gray") segments(10, -0.1, 10, max10, lty = "dashed", col = "gray") # Plot horizontal segments at cumul prob for 5% and 10% transp <- 0.8 segments(-2, h5[1], 5, h5[1], lty = "dashed", col = alpha("limegreen", transp)) segments(-2, h5[2], 5, h5[2], lty = "dashed", col = alpha("red", transp)) segments(-2, h5[3], 5, h5[3], lty = "dashed", col = alpha("blue", transp)) segments(-2, h10[1], 10, h10[1], lty = "dashed", col = alpha("limegreen", transp)) segments(-2, h10[2], 10, h10[2], lty = "dashed", col = alpha("red", transp)) segments(-2, h10[3], 10, h10[3], lty = "dashed", col = alpha("blue", transp)) # Add legend # legend("bottomright", c("XY", "XZ", "YZ"), lwd = 1.5, col = c("limegreen", "red", "blue")) # Store to check later hlist[[paste("Type", axCount, sep="")]] <- data.frame(h5 = h5, h10 = h10) axCount <- axCount + 1 } dev.off() # Plot with free axis png(filename=paste("errorProbabilityCum_bin", binProb, "_freeAxis_5CV.png", sep=""), type="cairo", units="in", width=20, height=5, pointsize=12, res=300) par(mfrow = c(1,4)) hlist <- list() axCount <- 1 for (i in seq(1,10,3)) { # Extract height for 5% error h5 <- sapply(probList[i:(i+2)], function(x) x[5/binProb]) max5 <- max(h5) # Extract height for 10% error h10 <- sapply(probList[i:(i+2)], function(x) x[10/binProb]) max10 <- max(h10) # Plot cumulative curves plot(probSeq, probList[[i]], type = "l", col = "green", lwd = 1.5, ylab = "Cumulative probability", xlab = "% Error", main = paste("Axon Type", axCount)) lines(probSeq, probList[[i + 1]], col = "red", lwd = 1.5) lines(probSeq, probList[[i + 2]], col = "blue", lwd = 1.5) # Plot vertical segments at 5% and 10% segments(5, -0.1, 5, max5, lty = "dashed", col = "gray") segments(10, -0.1, 10, max10, lty = "dashed", col = "gray") # Plot horizontal segments at cumul prob for 5% and 10% segments(-2, h5[1], 5, h5[1], lty = "dashed", col = "yellowgreen") segments(-2, h5[2], 5, h5[2], lty = "dashed", col = "tomato") segments(-2, h5[3], 5, h5[3], lty = "dashed", col = "lightskyblue") segments(-2, h10[1], 10, h10[1], lty = "dashed", col = "yellowgreen") segments(-2, h10[2], 10, h10[2], lty = "dashed", col = "tomato") segments(-2, h10[3], 10, h10[3], lty = "dashed", col = "lightskyblue") # Add legend legend("bottomright", c("XY", "XZ", "YZ"), lwd = 1.5, col = c("green", "red", "blue")) # Store to check later hlist[[paste("Type", axCount, sep="")]] <- data.frame(h5 = h5, h10 = h10) axCount <- axCount + 1 } dev.off() ``` ##Full figure ```{r, fig.width=20} ## show the regions that have been allocated to each plot # layout.show(8) ############# # Load data # ############# probList <- readRDS("ProyeccionAnalysis/cumProb_5CV.rds") ############## # MAIN PLOTS # ############## setwd("ProyeccionFigures/") png(filename=paste("errorProbabilityCum_bin", binProb, "_5CV_FULL.png", sep=""), type="cairo", units="in", width=20, height=5, pointsize=12, res=300) # Graphical parameters par(oma = c(1,4,1,1), mar = c(4,0,3,0) + 0.5, cex.axis = 1.5, cex.lab = 1.5, cex.main = 2) layout(matrix(c(1,1,2,2,3,3,0,4,4, 1,5,2,7,3,9,0,4,11, 1,6,2,8,3,10,0,4,12, 1,0,2,0,3,0,0,4,0), 4, 9, byrow = TRUE), widths = c(2.5,2.5,2.5,2.5,2.5,2.5,1,3,2.5), heights = c(1.6,1.6,1.6,1.2)) # layout.show(12) # Plot loop hlist <- list() axCount <- 1 for (i in seq(1,10,3)) { # Extract height for 5% error h5 <- sapply(probList[i:(i+2)], function(x) x[5/binProb]) # Extract height for 10% error h10 <- sapply(probList[i:(i+2)], function(x) x[10/binProb]) # Plot cumulative error and Axis labels if (axCount == 1) { plot(probSeq, probList[[i]], type = "l", col = "limegreen", lwd = 1.5, ylim = c(0,1), xlim = c(0.5, 40), main = paste("Axon Type", axCount), yaxt = "n", xaxt = "n", xlab = "", ylab = "") lines(probSeq, probList[[i + 1]], col = "red", lwd = 1.5) lines(probSeq, probList[[i + 2]], col = "blue", lwd = 1.5) title(ylab = "Cumulative probability", outer = TRUE, line=3) } else if (axCount == 2) { plot(probSeq, probList[[i]], type = "l", col = "limegreen", lwd = 1.5, ylim = c(0,1), xlim = c(0.5, 40), main = paste("Axon Type", axCount), yaxt = "n", xaxt = "n", xlab = "", ylab = "") lines(probSeq, probList[[i + 1]], col = "red", lwd = 1.5) lines(probSeq, probList[[i + 2]], col = "blue", lwd = 1.5) title(xlab="% Error", line=3) } else if (axCount == 3) { plot(probSeq, probList[[i]], type = "l", col = "limegreen", lwd = 1.5, ylim = c(0,1), xlim = c(0.5, 40), main = paste("Axon Type", axCount), yaxt = "n", xaxt = "n", xlab = "", ylab = "") lines(probSeq, probList[[i + 1]], col = "red", lwd = 1.5) lines(probSeq, probList[[i + 2]], col = "blue", lwd = 1.5) } else if (axCount == 4) { par(mar = c(4,5,3,0) + 0.5) plot(probSeq, probList[[i]], type = "l", col = "limegreen", lwd = 1.5, ylim = c(0,1), xlim = c(0.5, 40), main = paste("Axon Type", axCount), yaxt = "n", xaxt = "n", xlab = "", ylab = "") lines(probSeq, probList[[i + 1]], col = "red", lwd = 1.5) lines(probSeq, probList[[i + 2]], col = "blue", lwd = 1.5) title(ylab = "Cumulative probability", xlab="% Error", line=3) } # Add x axis axis(side = 1, at=seq(-10,40,10), labels = seq(-10,40,10)) # Different y axis for Type1 and Type4 if (axCount == 1) { axis(side = 2, at=seq(-0.2,1,0.2), labels = seq(-0.2,1,0.2)) } else if (axCount == 4) { axis(side = 1, at=seq(-10,40,10), labels = seq(-10,40,10)) axis(side = 2, at=seq(-0.2,1,0.2), labels = seq(-0.2,1,0.2)) } # Plot vertical segments at 5% and 10% for XY plane segments(5, -0.1, 5, h5[1], lty = "dashed", col = "darkgray") segments(10, -0.1, 10, h10[1], lty = "dashed", col = "darkgray") # Plot horizontal segments at cumul prob for 5% and 10% for XY plane transp <- 0.8 segments(-2, h5[1], 5, h5[1], lty = "dashed", col = alpha("darkgray", transp)) segments(-2, h10[1], 10, h10[1], lty = "dashed", col = alpha("darkgray", transp)) # Store to check later hlist[[paste("Type", axCount, sep="")]] <- data.frame(h5 = h5, h10 = h10) axCount <- axCount + 1 } ############### # PLOT INSETS # ############### # Find mean bandwidth bwFrame <- aggregate(pe ~ neurType + Plane, peFrame, function(x) density(x)$bw) for (i in unique(peFrame$neurType)) { # Estimate density dens <- density(peFrame[peFrame$neurType == i & peFrame$Plane == "XY", "pe"], bw = mean(bwFrame$pe)) # 5% x1 <- min(which(dens$x >= -5)) x2 <- max(which(dens$x < 5)) par(mar = c(0.2,5,0.2,2)) plot(dens, ylim = c(0, 0.15), xlim = c(-20,20), zero.line = FALSE, main = "", ylab = "", xlab = "", axes = FALSE) with(dens, polygon(x=c(x[c(x1,x1:x2,x2)]), y= c(0, y[x1:x2], 0), col="limegreen", border = NA)) lines(dens) # Add y axis axis(side = 2, at=seq(-0.05,0.15,0.05), labels = seq(-0.05,0.15,0.05), cex.axis = 1.2) # 10% x1 <- min(which(dens$x >= -10)) x2 <- max(which(dens$x < 10)) plot(dens, ylim = c(0, 0.15), xlim = c(-20,20), zero.line = FALSE, main = "", ylab = "", xlab = "", axes = FALSE) with(dens, polygon(x=c(x[c(x1,x1:x2,x2)]), y= c(0, y[x1:x2], 0), col="limegreen", border = NA)) lines(dens) # Add y axis axis(side = 2, at=seq(-0.05,0.15,0.05), labels = seq(-0.05,0.15,0.05), cex.axis = 1.2) # Add x axis axis(side = 1, at=seq(-30,30,10), labels = seq(-30,30,10), cex.axis = 1.2) } dev.off() ```