Merge pull request #2 from CityofEdmonton/add_sentiment_filter

feat: add a sentiment filter
CityofEdmonton · Sep 28, 2022 · fc74e41 · fc74e41
2 parents c52460a + d5065ff
commit fc74e41
Show file tree

Hide file tree

Showing 3 changed files with 63 additions and 6 deletions.
diff --git a/dashboard_utils.R b/dashboard_utils.R
@@ -127,16 +127,32 @@ search_body <- function(query,
                         min_score = 0,
                         min_date = "2000-01-01",
                         max_date = Sys.Date(),
+                        min_sentiment = -1,
+                        max_sentiment = 1,
                         use_embedding_search = FALSE) {
   fields_str = paste0('"', search_fields, '"', collapse = ", ")
 
   filter_str = glue::glue('
-  "range": {
-    "date": {
-      "gte": "<{min_date}>",
-      "lte": "<{max_date}>"
+    "bool": {
+      "must": [
+        {
+          "range": {
+            "date": {
+              "gte": "<{min_date}>",
+              "lte": "<{max_date}>"
+            }
+          }
+        },
+        {
+          "range": {
+            "sentiment_polarity": {
+              "gte": "<{min_sentiment}>",
+              "lte": "<{max_sentiment}>"
+            }
+          }
+        }
+      ]
     }
-  }
   ', .open = "<{", .close = "}>")
 
   if (use_embedding_search) {
@@ -295,13 +311,17 @@ query_text_depot <- function(query_info = NULL,
   min_score = query_info$min_score
   min_date = query_info$min_date
   max_date = query_info$max_date
+  min_sentiment = query_info$min_sentiment
+  max_sentiment = query_info$max_sentiment
   use_embeddings = query_info$use_embeddings
   query_search <- search_body(
     query = query_str,
     search_fields = search_fields,
     min_score = min_score,
     min_date = min_date,
     max_date = max_date,
+    min_sentiment = min_sentiment,
+    max_sentiment = max_sentiment,
     use_embedding_search = use_embeddings
   )
 

diff --git a/search_bar_module.R b/search_bar_module.R
@@ -27,6 +27,7 @@ searchBarUI <- function(id){
                                                  checkIcon = list(yes = icon("ok", lib = "glyphicon"),
                                                                   no = icon("remove", lib = "glyphicon"))),
               uiOutput(ns("date_range_ui"), style = "padding-left: 10px"),
+              uiOutput(ns("sentiment_range_ui")),
               uiOutput(ns("data_source_ui")),
 
               # Only turn on AI search if we've specified an API Host:
@@ -117,7 +118,7 @@ searchBar <- function(input, output, session,
     return(range)
   })
 
-  output$date_range_ui <- renderUI({
+  output$date_range_ui <- renderUI({  
     min = as.Date(date_stats()$min)
     max = as.Date(date_stats()$max)
     dateRangeInput(
@@ -127,6 +128,37 @@ searchBar <- function(input, output, session,
       end = max)
   })
 
+
+  sentiment_stats <- reactive({
+    stats_for_field(es_connection, data_set_info()$alias_name, "sentiment_polarity",numeric = TRUE)
+  })
+
+  selected_sentiment_range <- reactive({
+    range = c(sentiment_stats()$min, sentiment_stats()$max)
+
+    # Check that UI element exists and that valid sentiment are there:
+    if (!is.null(input$sentiment_range)) {
+      if ((!is.na(input$sentiment_range[1])) &
+          (!is.na(input$sentiment_range[2]))) {
+        range = input$sentiment_range
+      }
+    }
+
+    return(range)
+  })
+
+  output$sentiment_range_ui <- renderUI({
+    min_val = sentiment_stats()$min
+    max_val = sentiment_stats()$max
+    sliderInput(
+      inputId = session$ns("sentiment_range"),
+      label = "Sentiment Range",
+      min = min_val,
+      max = max_val,
+      value = c(min_val,max_val),step=0.05)
+  })
+
+
   selected_data_sources <- reactive({
     data_sets <- data_set_info()$alias_name
     # On page load, input$data_sources is null because it's buried in the dropdown options
@@ -166,6 +198,8 @@ searchBar <- function(input, output, session,
                                                       min_score = 0,
                                                       min_date = selected_date_range()[1],
                                                       max_date = selected_date_range()[2],
+                                                      min_sentiment = selected_sentiment_range()[1],
+                                                      max_sentiment = selected_sentiment_range()[2],
                                                       use_embeddings = use_embeddings_setting()),
                                     aggregates_json = statsPerIndexQuery())
 
@@ -191,6 +225,8 @@ searchBar <- function(input, output, session,
          min_score = 0,
          min_date = selected_date_range()[1],
          max_date = selected_date_range()[2],
+         min_sentiment = selected_sentiment_range()[1],
+         max_sentiment = selected_sentiment_range()[2],
          num_hits = sum(aggregations()$counts_by_index$doc_count),
          use_embeddings = use_embeddings_setting())
   })

diff --git a/server.R b/server.R
@@ -20,6 +20,7 @@ function(input, output, session) {
       mutate(display_name = tools::toTitleCase(gsub("_", " ", alias_name, fixed = TRUE))) %>%
       mutate(db_size = purrr::map_dbl(alias_name, function(index) {
         query_count(es_connection, index = index)
+
       }))
 
     dataset_info <- dataset_info %>%