line_plot <- function(input, network, clustering, metric, value, plotname = NULL, colour = F, palette, x_lab = 'Clustering (%)', vertical_lines=NA){
#' Returns a figure showing how conclusions could change over MOTU clustering thresholds. Nb this function assumes that all datasets analysed using metcalcs were generated with the exact same clustering thresholds
#'
#' @param input An input data frame, as output fully-formatted by the metcalcs function
#' @param network The network column of the data frame
#' @param clustering The clustering level column of the data frame
#' @param metric The column of the data frame containing the metrics desired for analysis
#' @param value The column of the data frame containing the values obtained for each metric
#' @param plotname A title for the plot, defaults to none
#' @param colour Should the plot be in colour?
#' @param palette A palette of colours to plot
#' @param x_lab The label to be used on the x-axis
#' @param vertical_lines an integer or vector of integers stating where to locate vertical guide-lines on the plot
#' @return Produces a simple plot showing which metrics are robust in your dataset to clustering-level effects
#' @seealso \code{\link{metcalcs}} which this function visualises the output of
#' @export
#' @examples
#' m <- metcalcs(networks= batnets, indices =c('functional complementarity','web asymmetry', 'Fisher alpha'), network_level = 'higher')
#' line_plot(input = m, metric = 'metric', network = 'network', clustering = 'clustering', value = 'value', plotname = 'Sabah dataset')
rankings_mat <- matrix(nrow = length(unique(input$network)), ncol = length(unique(input$clustering)))
colnames(rankings_mat) <- unique(input$clustering)
ms <- as.character(c())
clusts <- c()
ns <- c()
n_nets <- length(unique(input$network))
#cat('n_nets is ', n_nets,'\n')
for(i in 1:length(unique(input$metric))){
#for(i in 1:1){
#print(i)
met <- unique(input$metric)[i]
#print(met)
metric_subset <- input[which(input$metric==met),]
#print(metric_subset)
#Make the appropriate subset of the data to play with
for(a in 1:length(unique(metric_subset$clustering))){
clust <- unique(metric_subset$clustering)[a]
#print(clust)
metric_and_cluster_subset <- metric_subset[which(metric_subset$clustering==clust),]
#print(metric_and_cluster_subset)
#print(metric_and_cluster_subset[order(metric_and_cluster_subset$value),'network'])
#print('\n')
rankings_mat[,a] <- metric_and_cluster_subset[order(metric_and_cluster_subset$value),'network']
}
#print(rankings_mat)
for(b in 1:ncol(rankings_mat)){
cl <- as.numeric(colnames(rankings_mat)[b])
if(b==1){##We need to do this step as otherwise our counting backwards will crash things: we want to see how similar the values are to the value before them, which is confusing for the first value in the loop
#cat('length(unique(input$metric)) is ', length(unique(input$metric)), '\n')
#cat('length(unique(input$network)) is ', length(unique(input$network)), '\n')
n <- n_nets
}else{
n <- length(which(rankings_mat[,(b-1)]==rankings_mat[,b]))
}
ns <- c(ns,n)
clusts <- c(clusts, cl)
ms <- c(ms, as.character(met))
}
}
out_df <- data.frame(ms, clusts, ns)
#print(out_df)
#return(out_df)
out_df <- out_df[order(out_df$ms, decreasing = TRUE),]
# plot
# set x limits
xmin <- 91
xmax <- 98
my_rows <- length(unique(out_df$ms))
my_rows
#pdf('../Figures/reliable_range_bars.pdf')
# empty plot
par(mar=c(5,12,2.5,3))
plot(1,type="n",xlim=c(xmin,xmax),ylim=c(0,my_rows+1),axes=TRUE,xlab= x_lab, yaxt="n", ylab="",frame=FALSE)
title(main = plotname)
axis(2, at=1:length(unique(out_df$ms)), labels=unique(out_df$ms), las = 1, cex.axis=0.65)
if(!is.na(vertical_lines)){
abline(v=vertical_lines, lty=2, col="gray")
}
#for(a in 1:2){
for(a in 1:length(unique(out_df$ms))){
met <- unique(out_df$ms)[a]
#print(met)
metric_df <- out_df[which(out_df$ms == met),]
#print(out_df)
metric_df$ms <- NULL
#print(metric_df)
# dummy data
#matches <- sample(0:2,100,replace=TRUE)
#thresholds <- seq(90,100,length=100)
#cbind(thresholds,matches)
# which entries do we wish to count?
test <- rep(0,nrow(metric_df))
#print(test)
#df <- data.frame(thresholds,matches)
#cat('metric_df$ns', metric_df$ns, '\n')
#cat('n_nets -1', n_nets-1, '\n')
#print(length(unique(df$network)))
test[which(metric_df$ns>(n_nets-1))] <- 1
#print(test)
df <- data.frame(metric_df,test)
#add dummy entries to ensure we pick up the correct start and end points
df <- rbind(c(0,0,0),df)
df <- rbind(df,c(0,0,0))
# look for starts and stops, ensuring we pick up single points
start_stop <- rep(NA,nrow(df))
for(i in 2:nrow(df)){
# start points
ifelse(df$test[i]==1 & df$test[i-1]==0, start_stop[i] <- "start", start_stop[i] <- "NA")
}
# end points
for(i in 1:(nrow(df)-1))
{
if(df$test[i]==1 & df$test[i+1]==0) start_stop[i] <- "stop"
}
# single points
for(i in 2:(nrow(df)))
{
if(df$test[i]==1 & df$test[i+1]==0 & df$test[i-1]==0) start_stop[i] <- "single"
}
#For the crap bits
for(i in 1:(nrow(df)-1))
{
if(df$test[i]==0) start_stop[i] <- "crap"
}
# add to dataframe
df <- data.frame(df,start_stop)
# extract start and end points of each sequence
line_starts <- subset(df,df$start_stop=="start")[,1]
line_stops <- subset(df,df$start_stop=="stop")[,1]
bad_points <- subset(df,df$start_stop=="crap")[,1]
single_points <- subset(df,df$start_stop=='single')[,1]
line_ends <- cbind(line_starts,line_stops)
line_ends <- rbind(line_ends, cbind(bad_points, bad_points))
line_ends <- rbind(line_ends, cbind(single_points, single_points))
if(0.0 %in% line_ends[,1]){
line_ends <- line_ends[-which(line_ends[,1]==0.0),] # Remove the zero values which we'd put in earlier when generating df
}
line_ends
#cat('nrow(line_ends) is ',nrow(line_ends),'\n')
#These rows aren't in order yet, which would allow us to plot but would mess up the colour scheme. The below line sorts that
if(!is.null(nrow(line_ends))){
line_ends <- line_ends[order(line_ends[,1]),]
} #We need the if statement as some lines are nice and have one value throughout, but that means we cannot order their rows as they don't really have any
#I've now made the empty plot before initiating the loop
# guideline
#lines(matrix(c(xmin,xmax,a,a),ncol=2,byrow=FALSE),lwd=0.5,col="red")
# add lines showing matches
if(colour== F ){
if(is.null(nrow(line_ends))){
lines(matrix(c(line_ends[1],line_ends[2],a,a),ncol=2,byrow=FALSE),lwd=3,col='black')
}
else if(nrow(line_ends>0)){ #Some of the metrics have zero lines, as they're so utterly shit.
#The if statement lets us skip them, as otherwise they crash it
for(i in 1:nrow(line_ends))
{
lines(matrix(c(line_ends[i,1],line_ends[i,2],a,a),ncol=2,byrow=FALSE),lwd=3,col='black')
#print(i)
}
}
}else{if(is.null(nrow(line_ends))){
lines(matrix(c(line_ends[1],line_ends[2],a,a),ncol=2,byrow=FALSE),lwd=3,col='black')
#lines(matrix(c(line_ends[1],line_ends[2],a,a),ncol=2,byrow=FALSE),lwd=3,col=palette[i])
}
else if(nrow(line_ends>0)){ #Some of the metrics have zero lines, as they're so utterly shit.
#The if statement lets us skip them, as otherwise they crash it
for(i in 1:nrow(line_ends))
{
lines(matrix(c(line_ends[i,1],line_ends[i,2],a,a),ncol=2,byrow=FALSE),lwd=3,col=palette[i])
#print(i)
}
}
}
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.