diff --git a/Inst/ThreadNet/server.R b/Inst/ThreadNet/server.R index 5df2925..2951e70 100644 --- a/Inst/ThreadNet/server.R +++ b/Inst/ThreadNet/server.R @@ -320,6 +320,26 @@ server <- shinyServer(function(input, output, session) { 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)){ diff --git a/Inst/ThreadNet/server/visualize.R b/Inst/ThreadNet/server/visualize.R index e11c0d7..0a012ed 100644 --- a/Inst/ThreadNet/server/visualize.R +++ b/Inst/ThreadNet/server/visualize.R @@ -3,6 +3,7 @@ #### Main Tab Output Functions #### # Controls for the whole set of tabs + output$Visualize_Tab_Controls_1 <- renderUI({ selectizeInput( "VisualizeEventMapInputID", @@ -81,6 +82,7 @@ output$WholeSequenceThreadMap_RelativeTime <- renderPlotly({ threadMap(threadedE # use this to select how to color the nodes in force layout output$Circle_Network_Tab_Controls <- renderUI({ tags$div( + downloadButton('downloadNetwork', 'Export this Network', class="dlButton"), sliderInput("circleEdgeTheshold","Display edges above", 0,1,0,step = 0.01,ticks = FALSE ), radioButtons( "Label_or_Zoom_1", @@ -88,24 +90,55 @@ output$Circle_Network_Tab_Controls <- renderUI({ choices = c('Labels','Zooming'), selected = 'Labels', inline = TRUE) + ) }) +output$Circle_Network_Path_Estimate <- renderText({ + paste0('Estimated paths = ', + round(estimate_network_complexity(viz_net()) ),1) +}) + +output$Network_Nodes_Edges <- renderText({ + paste0( print_network_nodes_edges(viz_net()) ) +}) -output$circleVisNetwork <- renderVisNetwork({ +# Create the network to be exported and also displayed +viz_net <<- reactive({ req(input$circleEdgeTheshold) - # first convert the threads to the network + # first convert the threads to the network if (input$Label_or_Zoom_1 == 'Labels') { n <- threads_to_network_original(threadedEventsViz(), "threadNum", 'label') } else { n <- threads_to_network_original(threadedEventsViz(), "threadNum", get_Zoom_VIZ()) } # filter out the edges if desired - n <- filter_network_edges(n,input$circleEdgeTheshold) - circleVisNetwork(n, 'directed', TRUE) + n <- filter_network_edges(n,input$circleEdgeTheshold) + n }) + +output$circleVisNetwork <- renderVisNetwork({ + req(input$circleEdgeTheshold) + + circleVisNetwork(viz_net(), 'directed', TRUE) +}) + +# output$circleVisNetwork <- renderVisNetwork({ +# req(input$circleEdgeTheshold) +# +# # first convert the threads to the network +# if (input$Label_or_Zoom_1 == 'Labels') +# { n <- threads_to_network_original(threadedEventsViz(), "threadNum", 'label') } +# else +# { n <- threads_to_network_original(threadedEventsViz(), "threadNum", get_Zoom_VIZ()) } +# +# # filter out the edges if desired +# n <- filter_network_edges(n,input$circleEdgeTheshold) +# circleVisNetwork(n, 'directed', TRUE) +# }) + #### Other Networks sub-tab #### # use this to select how to color the nodes in force layout diff --git a/Inst/ThreadNet/ui/visualize.R b/Inst/ThreadNet/ui/visualize.R index a2adf11..ad0c4e3 100644 --- a/Inst/ThreadNet/ui/visualize.R +++ b/Inst/ThreadNet/ui/visualize.R @@ -40,6 +40,8 @@ tabPanel(value = "visualize", tabPanel( "Event network (circle)", uiOutput("Circle_Network_Tab_Controls"), + textOutput("Circle_Network_Path_Estimate"), + textOutput("Network_Nodes_Edges"), visNetworkOutput("circleVisNetwork", width = "100%", height = "1200px") ), tabPanel( diff --git a/R/Event_Mappings.R b/R/Event_Mappings.R index 8b5e960..1a5b0f8 100644 --- a/R/Event_Mappings.R +++ b/R/Event_Mappings.R @@ -191,3 +191,27 @@ export_POV_csv <- function(mapname){ write.csv(output, file=file.choose(), quote = TRUE, row.names = FALSE) } + +#' @title export_network +#' @description Exports the edge list for the graph that is displayed +#' @name export_network +#' @param mapname name of POV map to use as name of the file +#' @param n +#' @return (saves network into file) +#' @export +export_network <- function(mapname, CurrentNetwork ){ + + # get the nice variable names + nicename = paste0("CurrentNetwork_from_",mapname) + nicename = "CurrentNetwork_POV" + + # get the edge list for the network + # edge_list <- n.edgeDF + + print('saving network: CurrentNetwork_POV.Rdata') + # save the data + save( CurrentNetwork , file = paste0(nicename,".Rdata")) + print(' network saved') + +} + diff --git a/R/ThreadNet_Core.R b/R/ThreadNet_Core.R index 55607df..6fc381e 100644 --- a/R/ThreadNet_Core.R +++ b/R/ThreadNet_Core.R @@ -75,14 +75,16 @@ threads_to_network_original <- function(et,TN,CF,grp='threadNum'){ to[i] = match(to_labels[i], nodes$label) } + # Stopped filtering out selfies July 20, 2019 for Kerstin Sailer bug report edges = data.frame( from, to, label = ngdf$freq, - Value =ngdf$freq) %>% filter(!from==to) + Value =ngdf$freq) # %>% filter(!from==to) # print(paste("T2N nodes:",nodes)) - # print(paste("T2N edges:",edges)) + # print(paste("ngdf = :",ngdf)) + # print(paste("edges= :",edges)) return(list(nodeDF = nodes, edgeDF = edges)) } @@ -163,10 +165,13 @@ count_ngrams <- function(o,TN,CF,n){ # Need a vector of strings, one for each thread, delimited by spaces # the function long_enough filters out the threads that are shorter than n # use space for the delimiter here - text_vector = long_enough( thread_text_vector(o,TN,CF,' '), n, ' ') + text_vector = long_enough( thread_text_vector(o,TN,CF,' '), n, ' ') + # text_vector = thread_text_vector(o,TN,CF,' ') + + + # print(paste0("thread=", o[1,TN] ,", text_vector")) + # print(text_vector) - # print("text_vector") - # print(text_vector) ng = get.phrasetable(ngram(text_vector,n)) diff --git a/R/ThreadNet_Metrics.R b/R/ThreadNet_Metrics.R index 5a92e6d..1f5b1c6 100644 --- a/R/ThreadNet_Metrics.R +++ b/R/ThreadNet_Metrics.R @@ -1,4 +1,4 @@ -########################################################################################################## + ########################################################################################################## # THREADNET: Metrics # This software may be used according to the terms provided in the @@ -17,6 +17,15 @@ #' @export estimate_network_complexity <- function(net){ return(estimate_task_complexity_index( nrow(net$nodeDF), nrow(net$edgeDF)) ) } +# returns a string with the number of nodes and edges in the network +#' @title returns a string with the number of nodes and edges in the network +#' @description returns a string with the number of nodes and edges +#' @name print_network_nodes_edges +#' @param net Object with dataframe for nodes and edges +#' @return string +#' @export +print_network_nodes_edges <- function(net){ return(paste0('Number of nodes = ', nrow(net$nodeDF),' Number of edges = ', nrow(net$edgeDF) ) ) } + #' @title Estimates the number of paths in a directed graph #' @description Same as estimate_network_complexity, but takes this version takes vertices and edges as parameters @@ -32,17 +41,17 @@ estimate_task_complexity_index <- function(v,e){ # v = number of vertices # tested for range of 10 < v < 100 # e = number of edges - print("edges") - print(e) - print("vertices") - print(v) + # print("edges") + # print(e) + # print("vertices") + # print(v) # # OUTPUT ARG: # cidx correlates with Log10(simple paths) with r>= 0.8 # from ORM paper analysis, constant is 0.12. # For boundary condition of 2 nodes and 1 edge, complexity index=0, constant = 0.08 - return( 0.08 + 0.08*e - 0.08*v ) + return( 10^( 0.08 + 0.08*e - 0.08*v) ) } @@ -84,7 +93,7 @@ compression_index <- function(df,CF){ return( length(paste0(as.character(df[[CF]]))) ) } -####################################################################### +#######################################################################es #compute entropy for a set of observations in a column from a data frame #' @title Compute the entropy of a contextual factor #' @description Each column in the raw data represents a contextual factor. This function computes the entropy of each factor that is selected for use in the