##########################################################################################################

# 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

###### Pie charts for context factors ####

# It would be nice to display some other helpful information, perhaps (like the % of possible combinations that occur)

#' Creates pie charts for one or more contextual factors

#'

#' 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

#'

#' @family ThreadNet_Graphics

#'

#' @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){

# avoid unpleasant error messages

if (length(CF)==0) {return(plotly_empty())}

# 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

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],"<br>N=",CFlevels,"<br>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 %>%

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

#' Shows threads in a horizontal layout

#'

#' Creates a plotly chart of threads in either clock time or event time, depending on the timescale parameter.

#'

#' @family ThreadNet_Graphics

#'

#' @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

#' @shape shape of plotted points

#'

#' @return plotly object

#' @export

#'

threadMap <- function(or,TN, timescale, CF, shape){

# setting color palettes

# first find the number of distinct colors

nColors = length(unique(or[,CF]))

pal <- diverge_hcl(nColors)

return( plot_ly(or, x = ~or[[timescale]], y = ~or[[TN]], color= ~or[,CF],

colors=pal,

name = 'threads', type = 'scatter', mode='markers', marker=list(size=10, opacity=1), # fill='tonextx',

symbol= "line-ew", symbols=shape, showlegend=FALSE)

)

}

################################################

#' Create an ngram bar chart

#'

#' 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.

#'

#' @family ThreadNet_Graphics

#'

#' @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

#'

#' @examples

ng_bar_chart <- function(o,TN, CF, n, mincount){

library(ngram)

library(plotly)

# 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) %>%

layout(xaxis= list(showticklabels = FALSE, title=paste0(n,"-grams of ",CF, " that occur > ",mincount," times")))

return(ngp)

}

#############################################################################

#' Circular network layout for event network (USES visnetwork)

#'

#' Should be replaced with a more expressive layout in plotly

#'

#' @family ThreadNet_Graphics

#'

#' @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 visnetwork 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.1),

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,

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 <- 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 use the network function

#' NetworkD3 force layout for event network

#'

#' Should be replaced with a more expressive layout in plotly

#'

#' @family ThreadNet_Graphics

#'

#' @param et dataframe with the threads to be graphed

#' @param TN the column with the threadNumber

#' @param grp used to color some of the nodes

#' @param zoom_level this is just the contextual factor (column) to be graphed

#'

#' @return networkD3 object

#' @export

#'

eventNetworkD3 <- function(et,TN, grp, zoom_level){

# et is a dataframe of event threads

# TN is the column that holds the threadNumber

# grp is one of the comparison columns

# zoom_level is the column with the event code (node ID)

# First get the node names & remove the spaces

node_label = unique(et[[zoom_level]])

node_label=str_replace_all(node_label," ","_")

nNodes = length(node_label)

node_group=character()

for (n in 1:nNodes){

node_group = c(node_group, as.character(unlist( et[which(et[[zoom_level]]==node_label[n]),grp][1]) ) )

}

# print("node_label")

# print(node_label)

# set up the data frames we need to draw the network

# needs to have name, group, size

nodes = data.frame(

id = 1:length(node_label),

label = node_label,

Group = node_group,

Title=node_label)

# zero indexing

nodes$id = nodes$id-1

# print("nodes")

# print(nodes)

# Only count in threads where length is adequate

text_vector = vector(mode="character")

j=0

for (i in unique(et[[TN]])){

txt =et[et[[TN]]==i,zoom_level]

# length needs to be longer than n

if (length(txt)>2){

j=j+1

text_vector[j] = concatenate(txt,collapse = "|", rm.space = TRUE)

}

}

# print("text_vector")

# print(text_vector)

# try using ngram to get edges since it is so fast

ngdf = get.phrasetable(ngram(text_vector,2,sep = "|"))

# need to split 2-grams into from and to

from_to_str = str_split(str_trim(ngdf$ngrams), " ", n=2)

# need to find a better way to do this...

nEdges = length(from_to_str)

from_labels=matrix(data="", nrow=nEdges,ncol=1)

to_labels =matrix(data="", nrow=nEdges,ncol=1)

from=integer(nEdges)

to=integer(nEdges)

for (i in 1:length(from_to_str)){

# Get from and to by spliting the 2-gram

from_labels[i] = str_split(from_to_str[[i]]," ")[1]

to_labels[i] = str_split(from_to_str[[i]]," ")[2]

# use match to lookup the nodeID from the label...

from[i] = match(from_labels[i], nodes$label)

to[i] = match(to_labels[i], nodes$label)

}

# zero indexing for D3

from=from-1

to=to-1

# ideally need to have source, target, value

edges = data.frame(

from,

to,

Value = paste(ngdf$freq)

)

# print("edges")

# print(edges)

return( forceNetwork(Links = edges, Nodes = nodes, Source = "from",

Target = "to", Value = "Value", NodeID = "id",

Group = "Group", opacity = 1, zoom = T, bounded = T))

}

######################################################################################

#' Comparison plots

#'

#' 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...

#'

#' @family ThreadNet_Graphics

#'

#' @param e dataframe with threads to be plotted

#' @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 ng_size size of ngram

#' @param zoom_level choose the zoom level, if applicable

#'

#' @return plotly object, including subplots

#' @export

#'

#' @examples

Comparison_Plots <- function(e, CF, CF_levels, nTimePeriods=1, ng_size , zoom_level){

# 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)

# print("time_buckets")

# print(time_buckets)

# further divide each by context factor

# plotList <- function(nplots) {

# lapply(seq_len(nplots), function(x) plot_ly())

plot_list = list()

for (tb in 1:nTimeBuckets){

for (f in 1:nLevels){

plotName = paste0("Time-",tb,"-","CF-",f)

# print("plotName")

# print(plotName)

# print("CF")

# print(CF)

plot_bucket = et[(is.element(et$threadNum,unlist(time_buckets[tb])) & et[CF]==CF_levels[f]),"threadNum"]

# print("plot_bucket")

# print(plot_bucket)

# 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)>ng_size){

plot_list[[plotName]] = ng_bar_chart(dfp,"threadNum", zoom_level, ng_size, 1)

# plot_list[[plotName]] = eventNetworkD3(dfp,"threadNum", get_COMPARISON_CF(), zoom_level)

} else

{plot_list[[plotName]] = plotly_empty()}

}

}

# create two versions: one that uses ngrams (1-2-3) and one that shows numbers.

return(subplot(plot_list,nrows=nLevels))

}

###################################################################

#' Use TraMiner plotting function to produce threadmap

#'

#' Would like to re-implement in plotly for mouse-over and for better interactivity and speed

#'

#' @family ThreadNet_Graphics

#'

#' @param df

#' @param TN

#' @param CF

#'

#' @return standard R plot

#' @export

traminer_threadMap <- function(df,TN, CF){

# setting color palettes

# first find the number of distinct colors

nColors = length(unique(df[,CF]))

pal <- diverge_hcl(nColors)

# reformat the data for traminerR

df = convert_TN_to_TramineR(df, TN, CF)

#plot sequence - also try seqfplot?

# add grouping variable?

return(seqiplot( seqdef(df, cpal=pal) , withlegend = T, main = "ThreadMap", border = NA,idxs=1:nrow(df)) )

# return(seqfplot( seqdef(df, cpal=pal) , withlegend = T, main = "ThreadMap", border = NA,idxs=1:nrow(df)) )

}

# 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)

}