##########################################################################################################
# THREADNET Misc 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!
##########################################################################################################

# Read in, check, and clean up the data
# need to see "tStamp" in the first column
#' read_occurrences
#'
#' @family ThreadNet_Misc
#'
#' @param inFile
#'
#' @return dataframe with occurrences
#' @export
#'
#' @examples
read_occurrences <- function(inFile){

  # if it's null return null, otherwise do the whole thing...
  if (is.null(inFile))
    return(NULL)

  # read in the table of occurrences
  o=read.csv(inFile$datapath)


  # check the file format.  Put in humorous example if the format is bad
  if (check_file_format(o)=="badformat")
  {o=make_example_DF() }
  else if (check_file_format(o)=="sequence")
  {o=add_relative_timestamps(o,"sequence", 1) }

  # clean up the data -- remove blanks, etc.
  o = cleanOcc(o,cfnames(o))

  return(o)}

# This could be improved but is an important logical checkpoint
# just checks that a required field is in the first column
check_file_format = function(o){

  if ((colnames(o)[1] == "tStamp"))
    {return("tStamp")}
  else if ((colnames(o)[1] == "sequence"))
  {return("sequence")}

  else
  {return("badformat")}
}

#' Add relative timestamps
#'
#' This function uses the sequence numbers to add a column with time stamp to the data, so that it can be used throughout the rest
#' of the app, which expects to see a time stamp.  Start time for all threads is the same: "2017-01-01 00:00:00"  Happy New Year!
#'
#' @param o   data frame of occurrences
#' @param SN column containing the sequence numbers
#' @param tstep time step for events within each thread.  Default is one minute.
#'
#' @return  data frame of occurrences
#' @export
#'
#' @examples
add_relative_timestamps <- function(o, SN, tstep=1){

  startTime <- as.POSIXct("2017-01-01 00:00:00")

  # add the column at the beginning
  o <- cbind(startTime + 60*as.numeric(as.character(o[[SN]])), o)

  # set the column name
  colnames(o)[1] <- "tStamp"

  return(o)

}

##  Make an example data frame for display...
make_example_DF = function(){
  correct_occ = read.table(text="tStamp actor action object location
                            '2017-4-7 17:52:04' jimmy tosses ball playground
                            '2017-4-7 17:52:12' rover fetches ball playground
                            '2017-5-18 9:05:52' jimmy tosses ball forest
                            '2017-5-18 9:06:24' rover fetches stick forest
                            '2017-5-18 9:10:48' jimmy searches ball forest ", header=TRUE)
}

# this function will clean up the raw occurrence data
#' Clean up occurrences
#'
#' Clean up removes blanks from the data. Blanks cause problems because the n-gram algorithm interprets blanks as seperate tokens.
#'
#' @family ThreadNet_Misc
#' @param o  data frame with occurrences
#' @param cfnames names of contextual factors (columns) to clean up.
#'
#' @return data frame with blanks removed.
#' @export
#'
#' @examples
cleanOcc = function(o, cfnames){

  ## clean up the spaces here and make it back into a factor
  for (cf in cfnames){
    o[cf] = as.factor(unlist(sapply(o[,cf],fixBlanks)))
  }

  # force tStamp into a "YMD_HMS" format
  o$tStamp = as.character(o$tStamp)
  o$tStamp = parse_date_time(o$tStamp, c("dmy HMS", "dmY HMS", "ymd HMS"))

  ## Add the category ">other<" for all of the factors to facilitate recoding later
  # This may not be needed anymore... commented out Dec 3 2017
  # o <- as.data.frame(lapply(o, addOther))

  # add weekday and month
  o$weekday = as.factor(weekdays(as.Date(o$tStamp)))
  o$month = as.factor(months(as.Date(o$tStamp)))

  return(o)
}

## Use this function to remove blanks from the CF data
fixBlanks = function(s){

  # take out blanks
  s=str_replace_all(s," ","_")

  if (is.na(s)){
    s="blank"
  }
  return(s)
}

# NO LONGER NEEDED  12/2017 add the >other< categeory
# addOther <- function(x){
#   if(is.factor(x))
#     return(factor(x, levels=c(levels(x), ">other<")))
#   return(x) }

#' numThreads counts how many threads in the data set
#'
#' Threads must have unique thred numbers for this function to work
#'
#' @family ThreadNet_Misc
#' @param o data frame with occurrences or events
#' @param TN column with thread number
#'
#' @return number of threads
#' @export
numThreads = function(o,TN) {length(unique(o[[TN]]))}

# Time range for the data set (not really needed but nice)
timeRange= function(o){
  # get the min/max time in the whole set of occurrences
  start = min(as.POSIXlt.date(o$tStamp))
  finish = max(as.POSIXlt.date(o$tStamp))

  # take the difference
  difftime(finish,start)}

# Put it into a nice phrase
timeRangePhrase = function(tr){
  rangeunits = attr(tr,"units")
  paste(floor(as.numeric(tr)),rangeunits,"from start to finish.")}


# this function is used to split up the threads into n ~equal buckets
make_subsets <- function(d,n){
  return(split(d, ceiling(seq_along(d)/(length(d)/n))))
}

# This function takes a slider value and returns a valid column name for zooming
# if the argument is null, then use ZM_1
zoomColumn <- function(z){
  # print(paste("In zoomColumn z=",z))

  if (is.null(z))
  {r="ZM_1"}
  else
  {r=paste0("ZM_",z)}

  # print(paste("In zoomColumn r=",r))

  return(r)
}

######### Functions that return column names #######

# names of the columns for contextual factors
# grab all of the columns except the first, which has the time stamp
# tStamp in the first column
#' cfnames provides names of all the contextual factors (except the time stamp)
#' @family ThreadNet_Misc
#' @param o data frame with threads
#'
#' @return list of column names
#' @export
#'
cfnames <- function(o){
  colnames(o)[2:length(colnames(o))]}

## this is used to populate the UI for comparison of categories within a CF
#' get_CF_levels returns the levels of a contextual factor
#' @family ThreadNet_Misc
#' @param o data frame with threads
#' @param cf  a contextual factors (column)
#'
#' @return list of unique factor levels
#' @export
get_CF_levels <- function(o,cf){

  return(levels(o[,cf]))
}

##########################################################################################################
# this function adds a new column to the occurrenes table based on a combination of context factors CF)
#' Creates a new column that combines some set of other columns
#'
#' For example, actor+action
#'
#' @family ThreadNet_Misc
#' @param o data frame with threads
#' @param CF contextual factors to be combined.
#' @param newCol  name of the new combined conextual factor
#'
#' @return data frame with the new column
#' @export
#'
#' @examples
combineContextFactors <- function(o,CF,newCol){


  # Use the old column if there is one
  if (!(newCol %in% names(o))) {

    # Need to get the CF parameters into the right format for tidyr::unite function
    cfn= sapply(CF, as.character)
    newCol = as.character(newCol)

    #  unite the columns, but keep the old ones
    o= unite_(o, newCol, cfn, sep="+", remove=FALSE)

  }

  # Coerce the new column into a factor
  # o[newCol] = as.factor(o[,newCol])

  return(o)
}

# just keep this simple
newColName <- function(CF_list){
  return(paste0(CF_list,collapse="_")) }


# These were used on the occ-to-event tab to configure the slider
threshold_slider_min <- function(o){
  return(floor(min(o$timeGap)))
}

threshold_slider_max <- function(o){
  return(ceiling(max(o$timeGap)))
}

threshold_slider_selected <- function(o){
  return(min(o$timeGap))
}




#### count the handoffs, but reverse coded -- zero = all different
diff_handoffs <- function(o){

  # initialize the previous row
  previous_row <<- o[1,]

  return(apply(o,1, row_diff_handoff))

}
row_diff_handoff <- function(this_row){

  # just add up the differences.
  d <-sum(this_row==previous_row)

  # store the previous row
  previous_row <<-this_row

  # return the number ofdifferences
  return(d)
}


#### Time gaps -- just pass in the column of time stamps
diff_tStamp <- function(ts){

  # initialize the first row
  previous_row <<- ts[1]

  return(sapply(ts, row_diff_tStamp))

}
row_diff_tStamp <- function(this_row){

  # print(paste("this_row",this_row))
  # print(paste("previous_row",previous_row))


  # just add up the differences.
  d <-max(0,difftime(this_row, previous_row, units="secs"))

  # store the previous row
  previous_row <<-this_row

  # return the time difference
  return(d)
}




#' threadSizeTable provides a distribution of the length of threads
#'
#' This function should work on either ocurrences or events.
#' it returns length and duration of each thread.It requires tStamp field to compute duration.
#'
#' @family ThreadNet_Misc
#'
#' @param o data frame with threads
#' @param TN column comtaining the threadNumber
#'
#' @return data frame with table of thread lengths
#' @export
threadSizeTable <- function(o,TN){


  # get the number of threads
  nThreads = nrow(unique(o[TN]))

  id=integer(nThreads)
  num=integer(nThreads)
  dur=numeric(nThreads)
  sizes = data.frame(id,
                     num,
                     dur)

  for (i in 1:nThreads){
    sizes$id = i
    sizes$num[i] = sum(o[TN]==i)
  }

  s = as.data.frame(table(sizes$num))

  return(s)
}




#########################################################
#' convert_TN_to_TramineR
#'
#' converts the csv format used in ThreadNet to the format used by TraMiner.  Should provide a way to save this, as well.
#'
#' @family ThreadNet_Misc
#' @param df  threads (occurrences or events)
#' @param TN Column with threadNumber
#' @param CF Contextual factor that will be used to define the state sequences in TraMineR
#'
#' @return Dataframe in TraMineR format (state sequeces in horizontal rows)
#' @export
#'
#' @examples
convert_TN_to_TramineR <- function(df, TN, CF){
  # dataframe must be sorted by time or sequence within each threadNumber
  # TN is the threadnumber
  # CF is some attribute we will use in TramineR

  # first find the threads
  threads = unique(df[,TN])
  nThreads = length(threads)

  # Initialize list of empty lists
  s = rep( list(list()), nThreads )

  for ( th in 1:nThreads){

    #subset of df that contains the sequence
    s[[th]] = as.character(df[df[[TN]]==threads[th],CF])
  }

  # add NA to make all the lists the same length
  s = lapply(s, `length<-`, max(lengths(s)))

  # convert to data frame
  df <- data.frame(matrix(unlist(s), nrow=nThreads, byrow=T))

  # add a column for the threadnumber
  # df[TN] = threads

  return(df)

}

# these functions support the moving window
#' get_threadList returns a list of all thread numbers
#'
#' @family ThreadNet_Misc
#'
#' @param e  data frame with threaded events
#' @param TN Column with threadNumber
#' @param SN Column with sequence numbers
#'
#' @return list of thread numbers
#' @export
get_threadList <- function(e,TN,SN){

  # for the current data structure for events, you just pick all of the threads where seqNum == 1
 # return(e[e[[SN]]==1,TN])
  return(unique(e[[TN]]))
}

#' get_moving_window returns a set of threads for a moving window
#'
#' @family ThreadNet_Misc
#'
#' @param e data frame with threads (needs to have threadNum and seqNum)
#' @param s size of window
#' @param l location of window
#'
#' @return data from with just the threads in the window
#' @export
#'
get_moving_window <- function(e, s, l ){

  # get the list of threads
  w=get_threadList(e,"threadNum","seqNum")

  # get get the appropriate subset of threads for the window
  w=w[l:(l+s-1),]

  # and now subset the rows for those threads

  return(e[e$threadNum %in% w,])

}

# e is the data
# w = window size
# s = step (how far to move the window in each step)
# n is the ngram size
window_correlation  <- function(e,w,s=1,n=2){

  # make data frame
  vt=data.frame( ngrams=character(), freq=integer(), wid=integer() )

  # use the finest  granularity
  zcf = zoom_upper_limit(e)

  # now many threads?
  nThreads = numThreads(e,'threadNum')

  wcount=0
  # scan through the data
  for (wloc in seq( 1, nThreads, s)){
    wcount= wcount +1
    # print(paste('wloc =',wloc))

    # get text vector for the whole data set - just keep the first two colomns
    ngdf = count_ngrams(get_moving_window(e, w, wloc), 'threadNum', zcf, n)[1:2]
    # print(paste('nrow ngdf =',nrow(ngdf)))

    # add a the row number
    ngdf$wid = wcount

    # append the columns to the end
    vt=rbind(vt,ngdf)
  }

  # convert to factor so that we can compute distances using the factor levels
  vt$ngrams = factor(vt$ngrams)

  nWindows = length(unique(vt$wid))

  # get the set of unique ngrams for the whole data set
  vt_unique = data.frame(ngrams=unique(vt$ngrams))

  # put the results here
  windowFreqMatrix = matrix(0,nrow=nWindows, ncol=nrow(vt_unique))

  for (i in 1:nWindows){

    # get the merged list
    vtmerge = merge(x=vt_unique, y=vt[vt$wid==i,], by='ngrams', all.x = TRUE)

  # use the wid.y to get the whole vector, but replace the NA with zeros
   b=vtmerge[vtmerge$wid==i,'freq']
   b[is.na(b)] <- 0

   windowFreqMatrix[i,]=b
  }


 # old way: correlate one row with the next and stick it in a dataframe
  df =data.frame(window=1:(nWindows-1),
                 thread = seq( 1, nThreads-s, s),
                 correlation= unlist(lapply(1:(nWindows-1),
                                              function(i){abs( cor(windowFreqMatrix[i,],windowFreqMatrix[i+1,])) })))

  # add the last row explicitly
  df = rbind( df, data.frame(window=nWindows, thread=nThreads, correlation=0))

  # return( df )

  # get the ngram data and labels
  b_df=as.data.frame(windowFreqMatrix)
  colnames(b_df)=vt_unique$ngrams

  # stick the ngram frequencies on the end for good measure
 return(cbind(df,b_df))

}

# e is the data
# w = window size
# s = step (how far to move the window in each step)
# n is the ngram size
# similar as above, except one window on each side of a focal thread.
dual_window_correlation  <- function(e,w,s=1,n=2){

  # make data frame
  vt=data.frame( ngrams=character(), freq=integer(), id=integer() )

  # use the finest  granularity
  zcf = zoom_upper_limit(e)

  # now many threads?
  nThreads = numThreads(e,'threadNum')


  # scan through the threads - treat each thread as a window of one
  # can probably do with the split and apply much faster
  for (t in 1:nThreads){

    # print(paste('wloc =',wloc))

    # get text vector for the whole data set - just keep the first two colomns
    ngdf = count_ngrams(get_moving_window(e, 1, t), 'threadNum', zcf, n)[1:2]
    # print(paste('nrow ngdf =',nrow(ngdf)))

    # add a the row number
    ngdf$id = t

    # append the columns to the end
    vt=rbind(vt,ngdf)
  }

  # convert to factor
  vt$ngrams = factor(vt$ngrams)

  # compute number of windows.
  nWindows = floor(nThreads/w)

  # get the set of unique ngrams for the whole data set
  vt_unique = data.frame(ngrams=unique(vt$ngrams))

  # put the results here
  ngramFreqMatrix = matrix(0,nrow=nThreads, ncol=nrow(vt_unique))

  for (i in 1:nThreads){

    # get the merged list
    vtmerge = merge(x=vt_unique, y=vt[vt$id==i,], by='ngrams', all.x = TRUE)

    # use the wid.y to get the whole vector, but replace the NA with zeros
    b=vtmerge[vtmerge$id==i,'freq']
    b[is.na(b)] <- 0

    ngramFreqMatrix[i,]=b
  }

  # return(ngramFreqMatrix)

  # old way: correlate one row with the next and stick it in a dataframe
  df =data.frame( thread = seq(w,nThreads-(w+1),s),
                  correlation= unlist(lapply(seq(w,nThreads-(w+1),s),
                                            function(i){abs( cor(colSums( ngramFreqMatrix[(i-w):i, ] ),
                                                                colSums( ngramFreqMatrix[(i+1):(i+w+1), ] )))  })))

  # # add the last row explicitly
  # df = rbind( df, data.frame( thread=nThreads, correlation=0))

   return( df )

  # # get the ngram data and labels
  # b_df=as.data.frame(ngramFreqMatrix)
  # colnames(b_df)=vt_unique$ngrams
  #
  # # stick the ngram frequencies on the end for good measure
  # return(cbind(df,b_df))

}
#####################################################
# GlobalEventMappings is a global variable
get_event_mapping_name_list <- function(){

  # print(paste('length of gem:',length(GlobalEventMappings)))

  n= unlist(lapply(1:length(GlobalEventMappings),function(i){
    unlist(GlobalEventMappings[[i]][["name"]]) }))

  # print(n)

  return(n)
  }


store_event_mapping <- function(EventMapName, e){

  # Add the mapping to the global list of mappings. Sort by threadNum and seqNum
  em = list(name = paste(EventMapName), threads = e[order(e[['threadNum']],e[['seqNum']]),])

  GlobalEventMappings <<- append(list(em), GlobalEventMappings )

  return(em)

}

get_event_mapping_threads <- function( mapname){

  # get the index for the mapname
  # print (paste0('mapname',mapname))

  idx=which(mapname==get_event_mapping_name_list() )

  # print(idx)
  if (idx==0) {
    print('mapname not found for threads')
    return(NULL)
  }
  else
  return(GlobalEventMappings[[idx]][["threads"]])
}

delete_event_mapping <- function( mapname){

  # get the index for the mapname
  idx=which(mapname==get_event_mapping_name_list() )

  GlobalEventMappings[[idx]] <<-NULL
  # GlobalEventMappings[[idx]][["threads"]] <-NULL
  # GlobalEventMappings[[idx]][["cluster"]] <-NULL

  print(paste('deleting', mapname, idx))
  save(GlobalEventMappings, file="eventMappings_after_delete.RData")


}

export_event_mapping <- function(mapname){

  nicename = paste0("EventMap_",mapname)

  assign(nicename, get_event_mapping_threads(mapname))

  save(list=nicename, file = paste0(nicename,".Rdata"))

  print(paste(" EventMapping saved in file: ", paste0(nicename,".Rdata")))

}

export_event_mapping_csv <- function( mapname){

  output = as.data.frame(get_event_mapping_threads(mapname))

  output[grep('V_',colnames(output))]<-NULL

  write.csv(output, file=file.choose(), quote = TRUE, row.names = FALSE)

  print(" EventMapping saved as .csv file")

}


# Make a nice dataframe to display
# Issue is that DT::renderdatatable cannot display lists correctly.
make_nice_event_DT <- function(e){

  # Add new column for the occurrences as a character string for display
  # tibble::add_column(e, paste(e$occurrences,sep=","), .after=1)

  e$OccurrenceList = paste(e$occurrences,sep=",")

  # move occurences directly after tstamp
  col_occ = which(colnames(e)=="OccurrenceList")
  e = e[, c(1, col_occ, (2:ncol(e))[-col_occ])]

  # Now remove the columns that have lists
  e$occurrences = NULL
  e$OccurrenceList.1 = NULL
  e[grep("V_",colnames(e))]=NULL

  return(e)
}




# find the biggest column with ZM_, and then get the number that goes with that.
# It will not be the same as the column number.
zoom_upper_limit <- function(e){
  upper_limit = as.integer(str_replace(colnames(e[max(grep("ZM_",colnames(e)))]),"ZM_",""))
  return(upper_limit)
}

# sliderInput("ThreadMapZoomID",
#             "Zoom in and out by event similarity:",
#             1,100,5, step = 1, ticks=FALSE)



######################################################
# Just putting this code here to play with for now.
# this function finds the common events in two subsets of thread data
common_events <- function(ss1, ss2, TN, CF, n){

  # get the list of ngrams for each subset of threads
  e1 = count_ngrams(ss1, TN, CF, n)[1]
  e2 = count_ngrams(ss2, TN, CF, n)[1]

  # return the intersection
  return(intersect(as.matrix(e1), as.matrix(e2)))

}

rr_grams <- function(o,TN, CF, N, R) {
  # N - max length of ngram
  # R = threshold for repetition




}

# Ideas for regex work
# https://stackoverflow.com/questions/35704369/identify-repetitive-pattern-in-numeric-vector-in-r-with-fuzzy-search

# sapply(1:(length(x)/2), function(m) sum(rep(x[1:m], length = length(x)) != x))

# x <- rep(c(1, 4, 2), 10)
# for(k in seq_len(length(x)/2)) {
#   pat <- x[1:k]
#   if (identical(rep(pat, length = length(x)), x)) {
#     print(pat)
#     break
#   }
# }
## [1] 1 4 2