fix: app errors

inst/app-inferr/xpl-helpers.R

@@ -1282,7 +1282,6 @@ paired_comp <- function(x, y, confint, var_names) {
   corsig    <- cor_sig(corr, n)
 
   alpha     <- 1 - confint
-
   confint1  <- conf_int_t(b[[1, 1]], b[[1, 2]], n, alpha = alpha) %>% round(2)
   confint2  <- conf_int_t(b[[2, 1]], b[[2, 2]], n, alpha = alpha) %>% round(2)
   confint3  <- conf_int_t(b[[3, 1]], b[[3, 2]], n, alpha = alpha) %>% round(2)
@@ -1336,14 +1335,14 @@ cor_sig <- function(corr, n) {
 }
 
 conf_int_t <- function(u, s, n, alpha = 0.05) {
-  
+
   a     <- alpha / 2
   df    <- n - 1
   error <- round(stats::qt(a, df), 3) * -1
   lower <- u - (error * samp_err(s, n))
   upper <- u + (error * samp_err(s, n))
   c(lower, upper)
-  
+
 }
 
 samp_err <- function(sigma, n) {
@@ -1707,7 +1706,7 @@ tbl_stats <- function(data, y) {
 
   dat <- data[[y]]
   c(length(dat), mean(dat), sd(dat), (sd(dat) / sqrt(length(dat))))
-             
+
 }
 
 # binomial test

inst/app-rfm/logic/logic_rfm_score.R

@@ -126,15 +126,15 @@ observeEvent(input$submit_rfm_customer_score_2, {
 rfm_heatmap_generate <- reactiveValues(a = NULL)
 
 observeEvent(input$submit_rfm_transaction_score, {
-  rfm_heatmap_generate$a <- rfm_heatmap(rfm_final_score$a)
+  rfm_heatmap_generate$a <- rfm_plot_heatmap(rfm_final_score$a)
 })
 
 observeEvent(input$submit_rfm_customer_score, {
-  rfm_heatmap_generate$a <- rfm_heatmap(rfm_final_score$a)
+  rfm_heatmap_generate$a <- rfm_plot_heatmap(rfm_final_score$a)
 })
 
 observeEvent(input$submit_rfm_customer_score_2, {
-  rfm_heatmap_generate$a <- rfm_heatmap(rfm_final_score$a)
+  rfm_heatmap_generate$a <- rfm_plot_heatmap(rfm_final_score$a)
 })
 
 output$plot_heatmap <- renderPlot({
@@ -144,15 +144,15 @@ output$plot_heatmap <- renderPlot({
 rfm_barchart_generate <- reactiveValues(a = NULL)
 
 observeEvent(input$submit_rfm_transaction_score, {
-  rfm_barchart_generate$a <- rfm_bar_chart(rfm_final_score$a)
+  rfm_barchart_generate$a <- rfm_plot_bar_chart(rfm_final_score$a)
 })
 
 observeEvent(input$submit_rfm_customer_score, {
-  rfm_barchart_generate$a <- rfm_bar_chart(rfm_final_score$a)
+  rfm_barchart_generate$a <- rfm_plot_bar_chart(rfm_final_score$a)
 })
 
 observeEvent(input$submit_rfm_customer_score_2, {
-  rfm_barchart_generate$a <- rfm_bar_chart(rfm_final_score$a)
+  rfm_barchart_generate$a <- rfm_plot_bar_chart(rfm_final_score$a)
 })
 
 output$plot_barchart <- renderPlot({
@@ -162,73 +162,17 @@ output$plot_barchart <- renderPlot({
 rfm_histogram_generate <- reactiveValues(a = NULL)
 
 observeEvent(input$submit_rfm_transaction_score, {
-  rfm_histogram_generate$a <- rfm_histograms(rfm_final_score$a)
+  rfm_histogram_generate$a <- rfm_plot_histogram(rfm_final_score$a)
 })
 
 observeEvent(input$submit_rfm_customer_score, {
-  rfm_histogram_generate$a <- rfm_histograms(rfm_final_score$a)
+  rfm_histogram_generate$a <- rfm_plot_histogram(rfm_final_score$a)
 })
 
 observeEvent(input$submit_rfm_customer_score_2, {
-  rfm_histogram_generate$a <- rfm_histograms(rfm_final_score$a)
+  rfm_histogram_generate$a <- rfm_plot_histogram(rfm_final_score$a)
 })
 
 output$plot_histogram <- renderPlot({
   print(rfm_histogram_generate$a)
-})
-
-rfm_scatter_1_generate <- reactiveValues(a = NULL)
-
-observeEvent(input$submit_rfm_transaction_score, {
-  rfm_scatter_1_generate$a <- rfm_rm_plot(rfm_final_score$a)
-})
-
-observeEvent(input$submit_rfm_customer_score, {
-  rfm_scatter_1_generate$a <- rfm_rm_plot(rfm_final_score$a)
-})
-
-observeEvent(input$submit_rfm_customer_score_2, {
-  rfm_scatter_1_generate$a <- rfm_rm_plot(rfm_final_score$a)
-})
-
-output$plot_scatter_1 <- renderPlot({
-  print(rfm_scatter_1_generate$a)
-})
-
-rfm_scatter_2_generate <- reactiveValues(a = NULL)
-
-observeEvent(input$submit_rfm_transaction_score, {
-  rfm_scatter_2_generate$a <- rfm_fm_plot(rfm_final_score$a)
-})
-
-observeEvent(input$submit_rfm_customer_score, {
-  rfm_scatter_2_generate$a <- rfm_fm_plot(rfm_final_score$a)
-})
-
-observeEvent(input$submit_rfm_customer_score_2, {
-  rfm_scatter_2_generate$a <- rfm_fm_plot(rfm_final_score$a)
-})
-
-output$plot_scatter_2 <- renderPlot({
-  print(rfm_scatter_2_generate$a)
-})
-
-rfm_scatter_3_generate <- reactiveValues(a = NULL)
-
-observeEvent(input$submit_rfm_transaction_score, {
-  rfm_scatter_3_generate$a <- rfm_rf_plot(rfm_final_score$a)
-})
-
-observeEvent(input$submit_rfm_customer_score, {
-  rfm_scatter_3_generate$a <- rfm_rf_plot(rfm_final_score$a)
-})
-
-observeEvent(input$submit_rfm_customer_score_2, {
-  rfm_scatter_3_generate$a <- rfm_rf_plot(rfm_final_score$a)
-})
-
-output$plot_scatter_3 <- renderPlot({
-  print(rfm_scatter_3_generate$a)
-})
-
-
+})

inst/app-rfm/logic/logic_segments.R

@@ -131,9 +131,11 @@ prep_segment <- eventReactive(input$button_create_segments, {
 	  use_series(rfm)
 
 	for (i in seq_len(input$n_segments)) {
-		rfm_score_table$segment[((rfm_score_table$recency_score %>% between(recency_lower()[i], recency_upper()[i])) &
+		rfm_score_table$segment[(
+			(rfm_score_table$recency_score %>% between(recency_lower()[i], recency_upper()[i])) &
 		  (rfm_score_table$frequency_score %>% between(frequency_lower()[i], frequency_upper()[i])) &
-		  (rfm_score_table$monetary_score %>% between(monetary_lower()[i], monetary_upper()[i])))] <- segment_names()[i]
+		  (rfm_score_table$monetary_score %>% between(monetary_lower()[i], monetary_upper()[i])) &
+			!rfm_score_table$segment %in% segment_names)] <- segment_names()[i]
 	}
 
 	rfm_score_table$segment[is.na(rfm_score_table$segment)] <- "Others"

inst/app-rfm/ui/ui_rfm.R

@@ -9,8 +9,7 @@ tabPanel('RFM', value = 'tab_rfm', icon = icon('sitemap'),
         source('ui/ui_rfm_customer_2.R', local = TRUE)[[1]],
         source('ui/ui_rfm_heat_map.R', local = TRUE)[[1]],
         source('ui/ui_rfm_bar_chart.R', local = TRUE)[[1]],
-        source('ui/ui_rfm_histogram.R', local = TRUE)[[1]],
-        source('ui/ui_rfm_scatter_plot.R', local = TRUE)[[1]]
+        source('ui/ui_rfm_histogram.R', local = TRUE)[[1]]
 
     )
 )

inst/app-rfm/ui/ui_rfm_bar_chart.R

@@ -18,8 +18,7 @@ tabPanel('Bar Chart', value = 'tab_rfm_barchart',
 			br(),
 			column(2),
 			column(8, align = 'center', 
-				plotOutput('plot_barchart', height = '500px') %>% 
-				  withSpinner()
+				plotOutput('plot_barchart', height = '500px')
 			),
 			column(2)
 

inst/app-rfm/ui/ui_rfm_heat_map.R

@@ -20,8 +20,7 @@ tabPanel('Heat Map', value = 'tab_rfm_heatmap',
 			br(),
 			column(2),
 			column(8, align = 'center', 
-				plotOutput('plot_heatmap', height = '500px') %>% 
-					withSpinner()
+				plotOutput('plot_heatmap', height = '500px')
 			),
 			column(2)
 

inst/app-rfm/ui/ui_rfm_histogram.R

@@ -16,9 +16,8 @@ tabPanel('Histogram', value = 'tab_rfm_histogram',
 			br(),
 			br(),
 			column(2),
-			column(8, align = 'center', 
-				plotOutput('plot_histogram', height = '500px') %>% 
-				  withSpinner()
+			column(8, align = 'center',
+				plotOutput('plot_histogram', height = '500px')
 			),
 			column(2)
 

inst/app-rfm/ui/ui_rfm_scatter_plot.R

@@ -17,8 +17,7 @@ tabPanel('Scatter Plots', value = 'tab_rfm_scatter',
 			br(),
 			column(2),
 			column(8, align = 'center', 
-				plotOutput('plot_scatter_1', height = '500px') %>% 
-				  withSpinner()
+				plotOutput('plot_scatter_1', height = '500px')
 			),
 			column(2)
 
@@ -30,8 +29,7 @@ tabPanel('Scatter Plots', value = 'tab_rfm_scatter',
 			br(),
 			column(2),
 			column(8, align = 'center', 
-				plotOutput('plot_scatter_2', height = '500px') %>% 
-				  withSpinner()
+				plotOutput('plot_scatter_2', height = '500px')
 			),
 			column(2)
 
@@ -43,8 +41,7 @@ tabPanel('Scatter Plots', value = 'tab_rfm_scatter',
 			br(),
 			column(2),
 			column(8, align = 'center', 
-				plotOutput('plot_scatter_3', height = '500px') %>% 
-				  withSpinner()
+				plotOutput('plot_scatter_3', height = '500px')
 			),
 			column(2)
 		)

inst/app-rfm/ui/ui_rfm_score_transaction.R

@@ -130,8 +130,7 @@ tabPanel('Transaction Data', value = 'tab_rfm_transaction_score',
 
     fluidRow(
       br(),
-      dataTableOutput('rfm_transaction_score_out') %>% 
-          withSpinner()
+      dataTableOutput('rfm_transaction_score_out')
     )
 
 	)

inst/app-rfm/ui/ui_segment_size.R

@@ -16,8 +16,7 @@ tabPanel("Segment Size", value = "tab_segment_size",
 			br(),
 			br(),
 			column(12, align = 'center', 
-				verbatimTextOutput('segment_size_out') %>% 
-					withSpinner()
+				verbatimTextOutput('segment_size_out')
 			)
 
 		)

inst/app-rfm/ui/ui_segments.R

@@ -44,9 +44,7 @@ tabPanel("Segmentation", value = "tab_rfm_segments",
 
       column(12, align = 'center',
         br(),
-        actionButton(inputId="button_create_segments", label="Generate Segments", icon = icon('thumbs-up')),
-        bsTooltip("button_create_segments", "Click here to generate segments.",
-          "top", options = list(container = "body")),
+        actionButton(inputId = "button_create_segments", label = "Generate Segments", icon = icon('thumbs-up')),
         br(),
         br()
       )

inst/app-visualize/logic/logic_dataoptions.R

@@ -28,42 +28,6 @@ file_upload_options <- eventReactive(input$upload_files_yes, {
 						label = 'XLSX',
 						width = '120px'
 					)
-				),
-				column(3, align = 'center',
-					actionButton(
-						inputId = 'upload_json_file',
-						label = 'JSON',
-						width = '120px'
-					)
-				),
-				column(12, br()),
-				column(3, align = 'center',
-					actionButton(
-						inputId = 'upload_stata_file',
-						label = 'STATA',
-						width = '120px'
-					)
-				),
-				column(3, align = 'center',
-					actionButton(
-						inputId = 'upload_spss_file',
-						label = 'SPSS',
-						width = '120px'
-					)
-				),
-				column(3, align = 'center',
-					actionButton(
-						inputId = 'upload_sas_file',
-						label = 'SAS',
-						width = '120px'
-					)
-				),
-				column(3, align = 'center',
-					actionButton(
-						inputId = 'upload_rds_file',
-						label = 'RDS',
-						width = '120px'
-					)
 				)
 	)
 
@@ -90,33 +54,3 @@ observeEvent(input$upload_xlsx_file, {
   updateNavlistPanel(session, 'navlist_up', 'tab_uploadfile')
   updateTabsetPanel(session, 'tabset_upload', selected = 'tab_upload_excel')
 })
-
-observeEvent(input$upload_json_file, {
-	updateNavbarPage(session, 'mainpage', selected = 'tab_upload')
-  updateNavlistPanel(session, 'navlist_up', 'tab_uploadfile')
-  updateTabsetPanel(session, 'tabset_upload', selected = 'tab_upload_json')
-})
-
-observeEvent(input$upload_stata_file, {
-	updateNavbarPage(session, 'mainpage', selected = 'tab_upload')
-  updateNavlistPanel(session, 'navlist_up', 'tab_uploadfile')
-  updateTabsetPanel(session, 'tabset_upload', selected = 'tab_upload_stata')
-})
-
-observeEvent(input$upload_spss_file, {
-	updateNavbarPage(session, 'mainpage', selected = 'tab_upload')
-  updateNavlistPanel(session, 'navlist_up', 'tab_uploadfile')
-  updateTabsetPanel(session, 'tabset_upload', selected = 'tab_upload_spss')
-})
-
-observeEvent(input$upload_sas_file, {
-	updateNavbarPage(session, 'mainpage', selected = 'tab_upload')
-  updateNavlistPanel(session, 'navlist_up', 'tab_uploadfile')
-  updateTabsetPanel(session, 'tabset_upload', selected = 'tab_upload_sas')
-})
-
-observeEvent(input$upload_rds_file, {
-	updateNavbarPage(session, 'mainpage', selected = 'tab_upload')
-  updateNavlistPanel(session, 'navlist_up', 'tab_uploadfile')
-  updateTabsetPanel(session, 'tabset_upload', selected = 'tab_upload_rds')
-})

inst/app-visualize/logic/logic_upload.R

@@ -35,10 +35,10 @@ data2 <- reactive({
         ext <- tools::file_ext(inFile2()$name)
 
         file.rename(inFile2()$datapath,
-                    paste(inFile2()$datapath, ext, sep="."))
+                    paste(inFile2()$datapath, ext, sep = "."))
 
         readxl::read_excel(
-          path = paste(inFile2()$datapath, ext, sep="."),
+          path = paste(inFile2()$datapath, ext, sep = "."),
           sheet = input$sheet_n
         )
     }