server <- shinyServer(function(input, output, session) {

observe({

hide(selector = "#navbar li a[data-value=choosePOV]")

hide(selector = "#navbar li a[data-value=visualize]")

hide(selector = "#navbar li a[data-value=subsets]")

hide(selector = "#navbar li a[data-value=comparisons]")

hide(selector = "#navbar li a[data-value=movingWindow]")

hide(selector = "#navbar li a[data-value=parameterSettings]")

})

options(warn=-1)

options(shiny.maxRequestSize=30*1024^2)

# create reactive value to force execution of function that gets map names for menus

rv <-reactiveValues(newmap=0)

# get_CF returns the choice of contextual factors from the Data tab.

get_CF <<- reactive({ return( input$CFcolumnsID ) })

# get_POV returns the choice of POV from the POV tab

get_THREAD_CF <<- reactive({ return(input$THREAD_CF_ID) })

get_EVENT_CF <<- reactive({ return(input$EVENT_CF_ID) })

get_COMPARISON_CF <<- reactive({ return(setdiff(get_CF(), union(get_THREAD_CF(),get_EVENT_CF() ))) })

# time scale for use throughout the app

get_timeScale <<- reactive({ return(input$timeScaleID) })

# These sliders controls the zoom level for zooming in-out

# they are grouoped here because hopefully they can be replaced by a single function... except that reactive functions don't take parameters

get_Zoom_VIZ <<- reactive({ return( ifelse (zoom_upper_limit(get_POV(input$VisualizeEventMapInputID))==1 ,

"ZM_1", paste0("ZM_",input$VisualizeTabZoomID))) })

get_Zoom_COMP_A <<- reactive({

req(input$CompareMapInputID_A, input$CompareZoomID_A)

return( ifelse (zoom_upper_limit(get_POV(input$CompareMapInputID_A))==1 ,

"ZM_1", paste0("ZM_",input$CompareZoomID_A)))

})

get_Zoom_COMP_B <<- reactive({

req(input$CompareMapInputID_B, input$CompareZoomID_B)

return( ifelse (zoom_upper_limit(get_POV(input$CompareMapInputID_B))==1 ,

"ZM_1", paste0("ZM_",input$CompareZoomID_B)))

})

get_Zoom_DIA_COMP <<- reactive({

req(input$DiaCompareMapInputID, input$DiaCompareZoomID)

return( ifelse (zoom_upper_limit(get_POV(input$DiaCompareMapInputID))==1 ,

"ZM_1", paste0("ZM_",input$DiaCompareZoomID)))

})

get_Zoom_MOVE <<- reactive({

req(input$MovingWindowMapInputID, input$MovingWindowZoomID)

return( ifelse (zoom_upper_limit(get_POV(input$MovingWindowMapInputID))==1 ,

"ZM_1", paste0("ZM_",input$MovingWindowZoomID)))

})

get_Zoom_REGEX <<- reactive({

req(input$RegExInputMapID, input$regexZoomID)

return( ifelse (zoom_upper_limit(get_POV(input$RegExInputMapID))==1 ,

"ZM_1", paste0("ZM_",input$regexZoomID)))

})

get_Zoom_freqNgram <<- reactive({

req(input$freqNgramInputMapID, input$freqNgramZoomID)

return( ifelse (zoom_upper_limit(get_POV(input$freqNgramInputMapID))==1 ,

"ZM_1", paste0("ZM_",input$freqNgramZoomID)))

})

get_Zoom_CHUNK <<- reactive({

req(input$ChunkInputMapID, input$chunkZoomID)

return( ifelse (zoom_upper_limit(get_POV(input$ChunkInputMapID))==1 ,

"ZM_1", paste0("ZM_",input$chunkZoomID))) })

# add reactive value to force update

get_POV_names <- reactive({

rv$newmap

get_POV_name_list()

})

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

### read data functions ###

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

#dataframe for occurrences that are read in from file1

occ <<- eventReactive(input$inputFile,parseInputData(input$inputFile))

# selected columns from the raw data

selectOcc <<- reactive(occ()[c("tStamp", input$CFcolumnsID)] )

# select all rows using the nice DT input

# global for general use -- check what else calls this if anything

selectOccFilter <<- reactive(selectOcc()[input$dataFilter_rows_all,])

# The POV tabs reconstruct the data into threads by sorting by tStamp and

# adding columns for threadNum and seqNum for the selected POV in ThreadOccByPOV

threadedOcc <- reactive({

validate(need(input$THREAD_CF_ID != "", "You must select at least one context factor to define Threads"))

validate(need(input$EVENT_CF_ID != "", "You must select at least one context factor to define Events within Threads"))

ThreadOccByPOV( selectOccFilter(), input$THREAD_CF_ID, input$EVENT_CF_ID )

})

# Here we need a function to do the subset on the POV tab

threadedOccSubSet <- reactive(threadedOcc()[input$povDataThreads_rows_all,])

observeEvent(input$addPOVButton,

if (check_POV_name(input$POVMapName)){

POVName = input$POVMapName

showNotification(paste('POV Name', POVName , 'already exists, please select a different name'), type='message', duration=10)

} else {

rv$newmap <- rv$newmap+1 # trigger reactive value

isolate(

store_POV(input$POVMapName, threadedOccSubSet(),input$THREAD_CF_ID,input$EVENT_CF_ID ) # this is the name; need to get object to add

)

shinyjs::show(selector = "#navbar li a[data-value=visualize]")

shinyjs::show(selector = "#navbar li a[data-value=subsets]")

shinyjs::show(selector = "#navbar li a[data-value=comparisons]")

shinyjs::show(selector = "#navbar li a[data-value=movingWindow]")

shinyjs::show(selector = "#navbar li a[data-value=parameterSettings]")

showNotification(paste('New POV named', input$POVMapName ,'has been created'), type='message', duration=10 )

}, ignoreInit = TRUE)

# get the data that will be the input for this tab

chunkInputEvents <- reactive({

rv$newmap

req(input$ChunkInputMapID)

get_POV(input$ChunkInputMapID)

})

# this function runs when you push the button to create a new mapping based on chunks

observeEvent( input$EventButton2,

if (check_POV_name(input$EventMapName2)){

mapName2 = input$EventMapName2

showNotification(paste('POV Name', mapName2 , 'already exists, please select a different name'), type='message', duration=10 )

} else {

rv$newmap <- rv$newmap+1 # trigger reactive value

thread_CF = get_POV_THREAD_CF(input$ChunkInputMapID)

event_CF = get_POV_EVENT_CF(input$ChunkInputMapID)

compare_CF = get_POV_COMPARISON_CF(input$ChunkInputMapID, get_CF())

isolate(

OccToEvents_By_Chunk(

chunkInputEvents(),

input$Chunks_method_Button, # which method?

input$EventMapName2,

input$fixed_chunk_size,

input$chunk_time_gap_threshold,

get_timeScale(),

input$chunk_CFs,

thread_CF,

event_CF,

compare_CF )

)

showNotification(paste('New POV named', input$EventMapName2 ,'has been created'), type='message', duration=10 )

}, ignoreInit = TRUE )

# get the data that will be the input for this tab

regexInputEvents <- reactive({

req(input$RegExInputMapID)

get_POV(input$RegExInputMapID)

})

# get the input values and return data frame with regex & label

regexInput <- reactive({

req(input$numRegexInputRows)

data.frame(

pattern <- unlist(lapply(1:input$numRegexInputRows,function(i){input[[paste0('regex', i)]]})),

label <- unlist(lapply(1:input$numRegexInputRows,function(i){input[[paste0('regexLabel', i)]]})),

stringsAsFactors = FALSE

)

})

# this function runs when you push the button to create a new mapping

observeEvent(input$EventButton3,

if (check_POV_name(input$EventMapName3)){

mapName3 = input$EventMapName3

showNotification(paste('POV Name', mapName3 , 'already exists, please select a different name'), type='message', duration=10 )

} else {

rv$newmap <- rv$newmap+1 # trigger reactive value

thread_cf = get_POV_THREAD_CF(input$RegExInputMapID)

event_cf = get_POV_EVENT_CF(input$RegExInputMapID)

comp_cf = get_POV_COMPARISON_CF(input$RegExInputMapID, get_CF())

isolate(

OccToEvents3(

regexInputEvents(),

input$EventMapName3,

thread_cf,

event_cf,

comp_cf,

'threadNum',

get_Zoom_REGEX(),

regexInput(),

input$KeepIrregularEvents

)

)

showNotification(paste('New POV named', input$EventMapName3 ,'has been created'), type='message', duration=10 )

}, ignoreInit = TRUE )

# get the data that will be the input for this tab

freqNgramInputEvents <- reactive({

req(input$freqNgramInputMapID)

get_POV( input$freqNgramInputMapID)

})

fng_select <- reactive(

support_level(

thread_text_vector(

freqNgramInputEvents(),

'threadNum',

get_Zoom_freqNgram(),

' '

),

frequent_ngrams(

freqNgramInputEvents() ,

'threadNum',

get_Zoom_freqNgram(),

input$freqNgramRange[1],

input$freqNgramRange[2],

TRUE

)

)

)

# The bottom example shows a server-side table. Make sure you have included row names in the table (as the first column of the table).

# In the case of server-side processing, the row names of the selected rows are available in input$x3_rows_selected as a character vector.

selected_ngrams <- reactive({

req(input$freqnGramTable_rows_selected)

s <- as.integer(input$freqnGramTable_rows_selected)

data.frame(

pattern <- unlist(lapply(1:length(s),function(i){ str_replace_all(fng_select()[i,'ngrams'],' ',',') })),

label <- unlist(lapply(1:length(s),function(i){paste0("<",str_replace_all(fng_select()[i,'ngrams'],' ','_'),">")})),

stringsAsFactors=FALSE

)

})

# this function runs when you push the button to create a new mapping

observeEvent(input$EventButton4,

if (check_POV_name(input$EventMapName4)){

mapName4 = input$EventMapName4

showNotification(paste('POV Name', mapName4 , 'already exists, please select a different name'), type='message', duration=10 )

} else {

rv$newmap <- rv$newmap+1 # trigger reactive value

thread_cf = get_POV_THREAD_CF(input$freqNgramInputMapID)

event_cf = get_POV_EVENT_CF(input$freqNgramInputMapID)

comp_cf = get_POV_COMPARISON_CF(input$freqNgramInputMapID, get_CF())

isolate(

OccToEvents3(

freqNgramInputEvents(),

input$EventMapName4,

thread_cf,

event_cf,

comp_cf,

'threadNum',

get_Zoom_freqNgram(),

selected_ngrams(),

input$KeepIrregularEvents_2

)

)

showNotification(paste('New POV named', input$EventMapName4 ,'has been created'), type='message', duration=10 )

}, ignoreInit = TRUE)

# separate the cluster calculation from the dendrogram display

cluster_result <- eventReactive(input$EventButton6,{

validate(need(!(check_POV_name(input$EventMapName6)), paste0('Map Name ',input$EventMapName6,' already exists. Please select a different name.')))

rv$newmap <- rv$newmap+1 # trigger reactive value

# return a list with both the cluster_result and the new POV

# store the POV and return the cluster_result for display

thread_CF = get_POV_THREAD_CF(input$ClusterEventsInputID)

event_CF = get_POV_EVENT_CF(input$ClusterEventsInputID)

cluster_POV = clusterEvents(

get_POV(input$ClusterEventsInputID),

input$EventMapName6,

input$ClusterMethodID,

thread_CF,

event_CF,

'cluster')

e = cluster_POV[['POV']]

store_POV(input$EventMapName6,

e[order(e[['threadNum']],e[['seqNum']]),] ,

thread_CF,

event_CF )

showNotification(paste('New POV named', input$EventMapName6 ,'has been created'), type='message', duration=10 )

cluster_POV[['cluster_result']]

} )

# Get data for the Visualize tab.Need parallel functions for the other tabs.

subsetEventsViz <- reactive({

req(input$SelectSubsetMapInputID)

get_POV( input$SelectSubsetMapInputID )

})

# reactive functions for the export and delete buttons

observeEvent(input$DeleteMappingButton,{

rv$newmap <- rv$newmap+1 # trigger reactive value

delete_POV(input$ManageEventMapInputID)

showNotification(paste(input$ManageEventMapInputID, " deleted."), type='message', duration=10 )

}, ignoreInit = TRUE)

observeEvent(input$ExportMappingRData,{

export_POV(input$ManageEventMapInputID )

showNotification(paste(input$ManageEventMapInputID, " exported as .RData file"), type='message', duration=10)

})

observeEvent(input$ExportMappingCsv,{

export_POV_csv( input$ManageEventMapInputID )

showNotification(paste(input$ManageEventMapInputID, " exported as .csv file"), type='message', duration=10)

})

CurrentNetwork <- reactiveValues()

observe({

if(!is.null(viz_net()))

isolate(

CurrentNetwork <<- viz_net()

)

})

output$downloadNetwork <- downloadHandler(

filename = paste("CurrentNetwork_POV.Rdata"),

# content = function(file) { save( eval(assign('CurrentNetwork',viz_net())) , file = file) }

content = function(file) { save( CurrentNetwork , file = file) }

)

# This is on visualize tab, but logically it fits better here

observeEvent(input$save_edge_list_button,{

export_network(input$VisualizeEventMapInputID, viz_net() )

showNotification("Exported to CurrentNetwork_POV.Rdata", type='message', duration=10)

})

# Another opportunity to make subsets...

observeEvent(input$SelectSubsetButton,

if (check_POV_name(input$SelectSubsetMapName)){

SubsetMapName = input$SelectSubsetMapName

showNotification(paste('POV Name', SubsetMapName , 'already exists, please select a different name'), type='message', duration=10 )

} else {

rv$newmap <- rv$newmap+1 # trigger reactive value

store_POV( input$SelectSubsetMapName,

subsetEventsViz()[input$SelectSubsetDataTable_rows_all,],

get_POV_THREAD_CF(input$SelectSubsetMapInputID),

get_POV_EVENT_CF(input$SelectSubsetMapInputID))

showNotification(paste('New POV named', input$SelectSubsetMapName ,'has been created'), type='message', duration=10 )

}, ignoreInit = TRUE)

# Get data for the Visualize tab.Need parallel functions for the other tabs.

# Get data for the Visualize tab. Need parallel functions for the other tabs.

threadedEventsViz_ALL <- reactive({

req(input$VisualizeEventMapInputID)

get_POV( input$VisualizeEventMapInputID )

})

threadedEventsViz <- reactive({

req(input$VisualizeRangeID[1], input$VisualizeRangeID[2])

loc = input$VisualizeRangeID[1]

width=input$VisualizeRangeID[2] - input$VisualizeRangeID[1]+1

get_moving_window(threadedEventsViz_ALL(),width,loc) })

# Get data for the COMPARE tab mapping A

threadedEventsComp_A <- reactive({

req(input$CompareMapInputID_A)

get_POV(input$CompareMapInputID_A )

})

# Get data for the COMPARE tab mapping B.

threadedEventsComp_B <- reactive({

req(input$CompareMapInputID_B)

get_POV( input$CompareMapInputID_B )

})

# Get data for the Diachronic COMPARE tab.

threadedEventsDiaComp <- reactive({

req(input$DiaCompareMapInputID)

get_POV(input$DiaCompareMapInputID )

})

CF_levels <- reactive( get_CF_levels( threadedEventsDiaComp(),input$selectComparisonID) )

# Get data for the Moving Window tab.

threadedEventsMove <- reactive({

req(input$MovingWindowMapInputID)

get_POV(input$MovingWindowMapInputID )

})

threadedEventsMove_A <- reactive({

req(input$MovingWindowSizeID, input$WindowLocation_A_ID)

get_moving_window(

threadedEventsMove() ,

input$MovingWindowSizeID,

input$WindowLocation_A_ID

)

})

threadedEventsMove_B <- reactive({

req(input$MovingWindowSizeID, input$WindowLocation_B_ID)

get_moving_window(

threadedEventsMove(),

input$MovingWindowSizeID,

input$WindowLocation_B_ID

)

})

# Source tab-specific Server output functions

source(file.path("server", "readData.R"), local = TRUE)$value

source(file.path("server", "choosePOV.R"), local = TRUE)$value

source(file.path("server", "comparisons.R"), local = TRUE)$value

source(file.path("server", "visualize.R"), local = TRUE)$value

source(file.path("server", "subsets.R"), local = TRUE)$value

source(file.path("server", "movingWindow.R"), local = TRUE)$value

source(file.path("server", "parameterSettings.R"), local = TRUE)$value

})