########################################################################################################## # THREADNET Graphics functions # This software may be used according to the terms provided in the # GNU General Public License (GPL-3.0) https://opensource.org/licenses/GPL-3.0? # Absolutely no warranty! ########################################################################################################## # graphic functions used in Shiny App. # some plotly, but some from other packages # explicitly add packages/functions to the NAMESPACE #' @importFrom grDevices colorRampPalette #' @importFrom graphics plot ###### Pie charts for context factors #### # It would be nice to display some other helpful information, perhaps (like the % of possible combinations that occur) #' @title Creates pie charts for one or more contextual factors #' @description When selecting contextual factors that define threads, events and comparisons, this function provide visual feedback about the number of factors levels #' and also the number of levels when the factors are combined #' @name CF_multi_pie #' @param oc data frame of occurrences #' @param CF list of contextual factors (columns) to include in the display #' @return plotyly pie charts (one or more) #' @export CF_multi_pie <- function(oc,CF){ # print(paste('in CF_multiPie, oc colnames=',colnames(oc))) # print(paste('in CF_multiPie, CF=',CF)) # avoid unpleasant error messages if (length(CF)==0) {return(plotly_empty(type='scatter',mode='markers'))} # make sure the necessary columns are present if (!all(CF %in% colnames(oc))) {return(plotly_empty(type='scatter',mode='markers'))} # first add the combined column if there is more than one if (length(CF) >1){ oc = combineContextFactors(oc, CF, "COMBINED") CF = c(CF, "COMBINED") } # get number of plots, which now includes the combined plot nPlots = length(CF) # nPies+1 ### compute layout information # compute the offset = half the width of each plot offset = 1/(2*nPlots) # Locate the centers for the plots -- this is where the annotations will go ctrPlot = (0:(nPlots-1))/nPlots + offset # locate upper and lower bounds on the domains of the plots (LB & UB) plotDomainLB = ctrPlot - offset plotDomainUB = ctrPlot + offset # Now loop for each CF, computing entropy and adding on the next "trace" to the plot # start with blank plot object. Assign type=scatter to suppress warnings. pies = plot_ly() max_combos = 1 for (i in 1:nPlots) { # make table information for each plot, including the combined one cfData = as.data.frame(table(oc[CF[i]])) # take out rows with zero frequency cfData = cfData[(cfData[,"Freq"]>0),] #N levels CFlevels = length(cfData[,"Freq"]) # keep track of max possible combinations max_combos = max_combos*CFlevels #compute entropy for each plot CFentropy = compute_entropy(cfData[,"Freq"]) # Add the new plots pies = pies %>% add_pie(data = cfData, labels = ~Var1, values = ~Freq, textinfo='label',textposition='none', name=as.character(CF[i]), domain = list(x = c(plotDomainLB[i], plotDomainUB[i])) ) %>% add_annotations(text=paste0(CF[i],"
N=",CFlevels,"
entropy=",format(CFentropy, digits=2)),showarrow=FALSE,xanchor="center", font=list(size="14",color="white"), xref="paper",yref="paper",y=.5,x=ctrPlot[i]) } pies = pies %>% plotly::layout(showlegend=FALSE, xaxis = list(showgrid = FALSE,zeroline = FALSE, showticklabels = FALSE), yaxis = list(showgrid = FALSE, zeroline = FALSE,showticklabels = FALSE) # , # autosize = F, width = "100%", height = "100px") ) return(pies) } #################################################### # use the same general layout, but just for one event # need to pass in the levels for each CF to use as the column names # e is a data.frame with events (created by OccToEvents1 or OccToEvents2) # CF = list of context factor names used to define events # r is the row name for the event being examined # # Call this for one CF at a time # o is the raw occurrences. This is where we get the labels. # e is the events. This is where we get the frequencies # cf is the column name for one CF (e.g., "actor") # r is one row (or cluster ID) # zm is the zoom column number. make_df_for_one_pie <- function(o,e,cf,r,zm){ # get the labels from the occurrences (o), get the frequencies from events cfdf = data.frame(Freq = aggregate_VCF_for_cluster(e,cf,r,zm), Label= levels(o[[cf]]) ) return(cfdf) } # e = events # o = occurrences # CF = list of the event_CF # zoom level as an integer (so you can grab it from the slider) # r = row number or cluster number. Should be the number on the event # z = integer for zoom column #' @title CF_multi_pie_event #' @description Make multi-pie for click event from force network layout. Generate a small plot of context factor pie charts when you click on a node in the graph #' @name CF_multi_pie_event #' @param o data frame of raw occurrences (for the names) #' @param e data frame with events #' @param CF list of contextual factors (columns) to include in the display #' @param r row number of cluster (the number of the event node) #' @param zm integer for zoom column #' @return plotyly pie charts (one or more) #' @export CF_multi_pie_event <- function(o, e,CF,r, zm){ # avoid unpleasant error messages if (length(CF)==0) {return(plotly_empty(type='scatter',mode='markers'))} # print(paste('in CF_multi_pie_event, r=',r)) if (is.na(as.numeric(r))) {return(plotly_empty(type='scatter',mode='markers'))} # get number of plots nPlots = length(CF) # paste "V_" onto the contextual factor names # CF = paste0("V_",CF) ### compute layout information # compute the offset = half the width of each plot offset = 1/(2*nPlots) # Locate the centers for the plots -- this is where the annotations will go ctrPlot = (0:(nPlots-1))/nPlots + offset # locate upper and lower bounds on the domains of the plots (LB & UB) plotDomainLB = ctrPlot - offset plotDomainUB = ctrPlot + offset n=length # Now loop for each CF, computing entropy and adding on the next "trace" to the plot # start with blank plot object. Assign type = scatter to suppress warnings. # pies = plot_ly(type='scatter') pies = plot_ly() max_combos = 1 for (i in 1:nPlots) { # make table information for each plot # cfData = data.frame(Freq=as.matrix(unlist(e[r,CF[i]])),Var1= letters[seq( from = 1, to = length(unlist(e[r,CF[i]])) )]) cfData = make_df_for_one_pie(o,e,CF[i],r,zm) # take out rows with zero frequency cfData = cfData[(cfData[,"Freq"]>0),] #N levels CFlevels = length(cfData[,"Freq"]) # Add the new plots if(CFlevels==1){ pies = pies %>% add_pie(data = cfData, labels = ~Label, values = ~Freq, textinfo='label',textposition='none', name=as.character(CF[i]), domain = list(x = c(plotDomainLB[i], plotDomainUB[i])) ) %>% add_annotations(text=paste0(CF[i],"
",cfData$Label),showarrow=FALSE,xanchor="center", font=list(size="14",color="white"), xref="paper",yref="paper",y=.5,x=ctrPlot[i]) } else { pies = pies %>% add_pie(data = cfData, labels = ~Label, values = ~Freq, textinfo='label',textposition='none', name=as.character(CF[i]), domain = list(x = c(plotDomainLB[i], plotDomainUB[i])) ) %>% add_annotations(text=paste0(CF[i],"
N=",CFlevels),showarrow=FALSE,xanchor="center", font=list(size="14",color="white"), xref="paper",yref="paper",y=.5,x=ctrPlot[i]) } } pies = pies %>% plotly::layout(showlegend=FALSE, xaxis = list(showgrid = FALSE,zeroline = FALSE, showticklabels = FALSE), yaxis = list(showgrid = FALSE, zeroline = FALSE,showticklabels = FALSE) # , # autosize = F, width = "100%", height = "100px") ) return(pies) } ###################################################################### # ThreadMap shows the threads in a horizongal layout #' @title threadMap shows threads in a horizontal layout #' @description Creates a plotly chart of threads in either clock time or event time, depending on the timescale parameter. #' @name threadMap #' @param or Dataframe of threads #' @param TN name of column with thread number #' @param timescale name of column that will be used to plot x-axis of events. It can be the can be the time stamp (for clock time) or the sequence number (for event time) #' @param CF name of contextual factor that will determine the colors #' @param shape shape code for the markers on the threadmap #' @return plotly object #' @export threadMap <- function(or, TN, timescale, CF, shape){ # print('in threadMap') # print(head(or)) # setting color palettes # first find the number of distinct colors nColors = length(unique(or[,CF])) pal <- diverge_hcl(nColors) if (timescale == 'seqNum') { xaxis = 'Event Time' } else if (timescale == 'tStamp') { xaxis = 'Actual Time' } else if (timescale == 'relativeTime') { xaxis = 'Relative time' } return( plot_ly(or, x = ~as.integer(or[[timescale]]), y = ~or[[TN]], color= ~as.character(or[,CF]), colors=pal, name = 'threads', type = 'scatter', mode='markers', marker=list(size=10, opacity=1), # fill='tonextx', text = ~or$label, hoverinfo = "text+x+y", symbol= "line-ew", symbols=shape, showlegend=FALSE) %>% plotly::layout( xaxis = list(title = xaxis), yaxis = list(title = knitr::combine_words(get_THREAD_CF(), sep = ", ")) ) ) } ################################################ #' @title Create an ngram bar chart #' @description Shows the n-grams within a set of threads (but not splitting across threads). This provides a visual indication of how repetitive the threads are. #' @name ng_bar_chart #' @param o a dataframe of occurrences or events #' @param TN the column that contains the threadNum #' @param CF the contextual factor within which to count the n-grams #' @param n the length of the ngram #' @param mincount the minimum count to display #' @return plotly object #' @export ng_bar_chart <- function(o,TN, CF, n, mincount){ # get the ngrams ngdf = count_ngrams(o,TN, CF, n) # print("ngdf") # print(ngdf) # put them in descending order -- tricky (http://stackoverflow.com/questions/40224892/r-plotly-barplot-sort-by-value) ngdf$ngrams = factor(ngdf$ngrams, levels =unique(ngdf$ngrams)[order(ngdf$freq, decreasing = TRUE)]) # make a list so we can return the data and the plot ng=new("list") # only include if they occur more than the threshold ngBars = ngdf[ngdf$freq>=mincount,] ngp <- plot_ly( ngBars, x = ~ngrams, y = ~freq, type = "bar",showlegend=FALSE) %>% plotly::layout(xaxis= list(showticklabels = FALSE, title=paste0(n,"-grams of ",CF, " that occur > ",mincount," times"))) return(ngp) } # this version we pass in the ngram data frame already sorted ng_bar_chart_freq <- function(ngdf){ # put them in descending order -- tricky (http://stackoverflow.com/questions/40224892/r-plotly-barplot-sort-by-value) ngdf$ngrams = factor(ngdf$ngrams, levels =unique(ngdf$ngrams)[order(ngdf$freq, decreasing = FALSE)]) ngp <- plot_ly( ngdf, y = ~ngrams, x = ~freq, type = "bar",showlegend=FALSE) %>% plotly::layout(xaxis= list(showticklabels = TRUE, title='Frequency')) %>% plotly::layout(yaxis= list(showticklabels = FALSE, title='')) return(ngp) } ############################################################################# # @title Circular network layout for event network (USES visnetwork) # # Should be replaced with a more expressive layout in plotly # # @name eventNetwork # @param et dataframe with the threads to be graphed # @param TN the column with the threadNumber # @param CF is the contetual factors (column) # @param timesplit time measure # @return plotly object # @export # eventNetwork <- function(et, TN, CF, timesplit){ # # n <- threads_to_network(et, TN, CF, timesplit) # # # title_phrase = paste("Estimated complexity index =",estimate_network_complexity(n)) # # edge_shapes <- list() # for(i in 1:length(n$edgeDF$from)) { # E <- n$edgeDF[i,] # # edge_shape = list( # type = "line", # line = list(color = "#030303", width = 0), # x0 = E[['from_x']], # x1 = E[['to_x']], # y0 = E[['from_y']], # y1 = E[['to_y']], # xref = "x", # yref = "y" # ) # # edge_shapes[[i]] <- edge_shape # } # # x <- list( # title = 'Average Time' # ) # # y <- list( # title = 'Frequency' # ) # color_pal = colorRampPalette(brewer.pal(11,'Spectral')) # size_pal = (n$nodeDF$y_pos-min(n$nodeDF$y_pos))/(max(n$nodeDF$y_pos)-min(n$nodeDF$y_pos))*15+10 # network <- plot_ly(x = ~n$nodeDF$x_pos, y = ~n$nodeDF$y_pos, # width = 0, # mode = "markers", # marker = list(size= size_pal, # color=color_pal(100)[as.numeric(cut(n$nodeDF$x_pos, breaks=100))] # # ), # text = n$nodeDF$label, key = n$nodeDF$label, hoverinfo = "text", source = 'A') # # p <- plotly::layout( # network, # title = title_phrase, # shapes = edge_shapes, # xaxis = x, # yaxis = y # ) # return(p) # # } ################################################################ ## Here is the networkD3 version of the same thing. # it has a bunch of extra code because of the groups... # needs to be re-written to separate computation of the network from the layout... #' @title forceNetworkD3 is an Interactive layout for event network #' @description This produces a force layout network using networkD3 #' @name forceNetworkD3 #' @param n = list with data frames for nodes and edges #' @return networkD3 object #' @export forceNetworkD3 <- function(n){ # zero indexing n$nodeDF['id'] = n$nodeDF['id']-1 n$edgeDF['from'] = n$edgeDF['from']-1 n$edgeDF['to'] = n$edgeDF['to']-1 return( forceNetwork(Links = n$edgeDF, Nodes = n$nodeDF, Source = "from", Target = "to", Value = "Value", NodeID = "label", Group = "Group", opacity = 1, zoom = T,arrows=TRUE, bounded = FALSE, clickAction = 'Shiny.onInputChange("Group", d.name)')) } ###################################################################################### #' @title Comparison plots #' @description Produce a set set of comparison sub-plots in an array. Ideally, we should be able to use any of the plots. So far it is only bar charts. #' This is a prototype that could use rather extensive redesign... #' @name Comparison_Plots #' @param e dataframe with threads to be plotted #' @param o dataframe with the original data #' @param CF contextul factors #' @param CF_levels list of levels from whicheve contextual factor was chosen for comprisons (e.g., location =1, 2, 3) #' @param nTimePeriods how many time periods to divide the data? #' @param plot_type a type of plotly plot with a function written #' @param role_map_cfs context factors for the role map plot #' @return plotly object, including subplots #' @export Comparison_Plots <- function(e, o, CF, CF_levels, nTimePeriods=1, plot_type,role_map_cfs){ # get the first event of each thread, so we can order them consistently by time et = e[e$seqNum==1,] et = et[order(et$tStamp),] # count the size of everything -- nTimePeriods is giving type error... nThreads = nrow(et) nLevels = max(1,length(CF_levels)) nTimeBuckets = as.numeric(max(1,nTimePeriods)) total_buckets = nLevels * nTimeBuckets # Set up the N x M data stuctures to hold the parameters and the plots plot_buckets = matrix(rep(list(), total_buckets),nrow = nTimeBuckets , ncol =nLevels) # Get the subsets, first by time and then by category. This will just return thread numbers. time_buckets = make_subsets(et$threadNum,nTimeBuckets) plot_list = list() for (tb in 1:nTimeBuckets){ for (f in 1:nLevels){ plotName = paste0("Time-",tb,"-","CF-",f) plot_bucket = et[(is.element(et$threadNum,unlist(time_buckets[tb])) & et[CF]==CF_levels[f]),"threadNum"] # then make the subplots # this gets all of the events in all of the threads that match the criteria dfp= e[is.element(e$threadNum,unlist(plot_bucket)),] # print("dfp[,1:7]") # print(dfp[,1:7]) # ideally make sure at least one thread is long enough to do an ngram... if (nrow(dfp)>2){ if (plot_type=='Ngrams') {plot_list[[plotName]] = ng_bar_chart(dfp,"threadNum", 1, 2, 2)} else if (plot_type=='Role Maps') {plot_list[[plotName]] = role_map( dfp, o, role_map_cfs ) } else if (plot_type=='Thread Trajectories') {plot_list[[plotName]] = threadTrajectory( dfp ) } else if (plot_type=='Threads (event time)') {plot_list[[plotName]] = threadMap(dfp, "threadNum", "seqNum", 1, 15 ) } else {plot_list[[plotName]] = plotly_empty(type='scatter',mode='marker')} } }} # create two versions: one that uses ngrams (1-2-3) and one that shows numbers. return(subplot(plot_list,nrows=nLevels)) } # # This one is not currently used. # threadLengthBarchart <- function(o, TN){ # # # sizes = threadSizeTable(o,TN) # # tgbc <- plot_ly( sizes, x = ~Var1, y = ~Freq, type = "bar", showlegend=FALSE) %>% # layout(xaxis= list(showticklabels = TRUE, title=paste0("Distribution of thread length"))) # # return(tgbc) # } # Basic Network layout # accepts the data stucture with nodeDF and edgeDF created by threads_to_network and normalNetwork #' @title circleVisNetwork #' @description Produces a circle network layout using visNetwork #' @name circleVisNetwork #' @param n list with nodeDF and edgeDF dataframes #' @param directed type of network = directed or not #' @param showTitle - show the title or not #' @return visnetwork object #' @export circleVisNetwork <- function( n,directed='directed', showTitle=FALSE ){ title_phrase ='' # if (showTitle==TRUE) # title_phrase = paste("Estimated complexity index =",round(estimate_network_complexity(n),2)) # else # title_phrase ='' # print("nodes") # print(n$nodeDF) # # print("edges") # print(n$edgeDF) if (directed =='directed') { return(visNetwork(n$nodeDF, n$edgeDF, width = "100%", main=title_phrase) %>% visEdges(arrows ="to", color = list(color = "black", highlight = "red")) %>% visLayout(randomSeed = 12 ) %>% # to have always the same network visIgraphLayout(layout = "layout_in_circle") %>% # visIgraphLayout(layout = "layout_as_tree") %>% visNodes(size = 10) %>% visOptions(highlightNearest = list(enabled = T, hover = T), nodesIdSelection = T)) } else {return(visNetwork(n$nodeDF, n$edgeDF, width = "100%", main=title_phrase) %>% visEdges(color = list(color = "black", highlight = "red")) %>% visLayout(randomSeed = 12 ) %>% # to have always the same network visIgraphLayout(layout = "layout_in_circle") %>% # visIgraphLayout(layout = "layout_as_tree") %>% visNodes(size = 10) %>% visOptions(highlightNearest = list(enabled = T, hover = T), nodesIdSelection = T))} } # e is any set of events # vcf is the context factor to graph as network for that set of events # l is the set of labels = factor levels of original data for that VCF #' @title normalNetwork #' @description Produced a network of co-occurrences for any given CF and displays it in a visNetwork circle layout #' @name normalNetwork #' @param e event data frame #' @param o occurrence data frame #' @param cf context factor for the graph #' @return visnetwork object #' @export normalNetwork <- function(e, o, cf){ # First get the node names & remove the spaces just in case node_label = levels(o[[cf]]) node_label=str_replace_all(node_label," ","_") # print("node_label") # print(node_label) # set up the data frames we need to draw the network nodes = data.frame( id = 1:length(node_label), label = node_label, title=node_label) # get the column name for the vector... vcf=paste0('V_',cf) # add up the indicators of co-presence in this set of events vcf_sum = colSums( matrix( unlist(e[[vcf]]), nrow = length(e[[vcf]]), byrow = TRUE) ) # compute outer product to get adjacency matrix,remove diagonal (self-ties) and then standardize to 0-1 a=sqrt(vcf_sum %o% vcf_sum) diag(a) = 0 a=a/max(a) # print(a) g=graph_from_adjacency_matrix(a, mode='undirected', weighted=TRUE) #E = get.edgelist(g, attr='weight') edges=cbind( get.edgelist(g) , round( E(g)$weight, 3 )) colnames(edges)=c('from','to','label') return(list(nodeDF = nodes, edgeDF = as.data.frame(edges) )) } #' @title filter_network_edges #' @description Filters out network edges with weight below the threshold #' @name filter_network_edges #' @param n network list of nodeDF and edgeDF #' @param threshold numeric threshold for filtering edges. #' @return n network list of nodeDF and edgeDF #' @export filter_network_edges <- function(n, threshold){ # print(head(n$edgeDF)) # print(paste('threshold=',threshold)) n$edgeDF = n$edgeDF %>% filter(label>threshold) # print(head(n$edgeDF)) return(n) } #' @title role_map #' @description A role map (like a heat map) that will show "who does what" for any set of events #' @name role_map #' @param e event data frame #' @param o occurrence data frame #' @param cfs context factors for the graph #' @return plotly heat map #' @export role_map <- function(e, o, cfs){ if (!length(cfs)==2) return(plot_ly(type='scatter')) # Get the context factors vcf_1 = paste0('V_',cfs[1]) vcf_2 = paste0('V_',cfs[2]) # add up the indicators of co-presence in this set of events vcf_1_sum = colSums( matrix( unlist(e[[vcf_1]]), nrow = length(e[[vcf_1]]), byrow = TRUE) ) vcf_2_sum = colSums( matrix( unlist(e[[vcf_2]]), nrow = length(e[[vcf_2]]), byrow = TRUE) ) # compute outer product to get adjacency matrix who_does_what= round(vcf_1_sum %o% vcf_2_sum,0) return( plot_ly( x=levels(o[[cfs[2]]]), y=levels(o[[cfs[1]]]), z=who_does_what, type='heatmap', colors= 'Reds') ) } #' @title threadTrajectory #' @description Create a plotly diagram showing relative time versus sequential time. #' Inspired by Gergen and Danner-Schroeder #' @name threadTrajectory #' @param or event data frame #' @return plotly scatter plot #' @export threadTrajectory <- function(or){ # setting color palettes # first find the number of distinct colors nColors = length(unique(or$threadNum)) pal <- rainbow_hcl(nColors) return( plot_ly(or, x = ~or$relativeTime, y = ~or$seqNum, color= as.character(or$threadNum), colors=pal, name = 'threads', type = 'scatter', mode='lines', text = ~paste(or$threadNum,or$label,sep=':'), hoverinfo = "text", showlegend=FALSE) %>% plotly::layout( xaxis = list(title='Relative time'), yaxis = list(title='Sequence') )) } #' @title movingWindowCorrelation #' @description Creates plotly diagram showing correlation of moving windows across time #' In this version, the moving window can overlap with itself as it slides #' @name movingWindowCorrelation #' @param trace list of (x,y) coordinates #' @return plotly scatter plot #' @export movingWindowCorrelation <- function( trace ){ return( plot_ly(trace, x = ~window, y = ~correlation, name = 'Window', type = 'scatter', mode='lines+markers', text = paste('Thread:',trace$thread), marker=list(size=8, opacity=1), hoverinfo = "text", symbol= "line-ew", symbols=15, showlegend=FALSE ) %>% plotly::layout( xaxis = list(title='Window number'), yaxis = list(title='Correlation', range = c(0, 1), autotick = FALSE, ticks = "outside", tick0 = 0, dtick = 0.1, ticklen = 5, tickwidth = 2, showticklabels = TRUE)) ) } #' @title dualmovingWindowCorrelation #' @description Creates plotly diagram showing correlation of moving windows across time #' This version computes the correlation of TWO adjacent windows that never overlap #' @name dualmovingWindowCorrelation #' @param trace list of (x,y) coordinates #' @return plotly scatter plot #' @export dualmovingWindowCorrelation <- function( trace ){ return( plot_ly(trace, x = ~thread, y = ~correlation, name = 'Window', type = 'scatter', mode='lines+markers', # text = ~thread, marker=list(size=8, opacity=1), # hoverinfo = "text", symbol= "line-ew", symbols=15, showlegend=FALSE #,height = 200 ) %>% plotly::layout( xaxis = list(title='Window number'), yaxis = list(title='Correlation', range = c(0, 1), autotick = FALSE, ticks = "outside", tick0 = 0, dtick = 0.1, ticklen = 5, tickwidth = 2, showticklabels = TRUE)) ) }