export significance of interaction detector

R/geodetector.R

@@ -24,10 +24,10 @@
 #'
 factor_detector = \(y,x,confintv = FALSE,alpha = 0.95){
   x = gdverse::all2int(x)
   gdf = tibble::tibble(x = x, y = y) %>%
     dplyr::group_by(x) %>%
     dplyr::filter(dplyr::n() > 1) %>%
     dplyr::ungroup() %>%
     dplyr::mutate(x = factor(x))
   x = gdf$x
   y = gdf$y
@@ -75,6 +75,9 @@
 #' \item{\code{Variable2 Q-statistics}}{Q-statistics for variable2}
 #' \item{\code{Variable1 and Variable2 interact Q-statistics}}{Q-statistics for variable1 and variable2 interact}
 #' \item{\code{Interaction}}{the interact result type}
+#' \item{\code{Variable1 P-value}}{P-value of the Q-statistic for Variable1}
+#' \item{\code{Variable2 P-value}}{P-value of the Q-statistic for Variable2}
+#' \item{\code{Variable1 and Variable2 interact P-value}}{P-value of the Q-statistic for variable1 and variable2 interact}
 #' }
 #' @export
 #'
@@ -85,25 +88,30 @@
 #'
 interaction_detector = \(y,x1,x2){
   x12 = paste0(x1,x2,'_')
-  qv1 = gdverse::factor_detector(y,x1)[[1]]
-  qv2 = gdverse::factor_detector(y,x2)[[1]]
-  qv12 = gdverse::factor_detector(y,x12)[[1]]
+  g1 = gdverse::factor_detector(y,x1)
+  g2 = gdverse::factor_detector(y,x2)
+  g12 = gdverse::factor_detector(y,x12)
+
+  qv1 = g1[[1]]
+  qv2 = g2[[1]]
+  qv12 = g12[[1]]
 
   if (qv12 < min(qv1, qv2)) {
-    interaction = c("Weaken, nonlinear")
+    interaction = "Weaken, nonlinear"
   } else if (qv12 >= min(qv1, qv2) & qv12 <= max(qv1, qv2)) {
-    interaction = c("Weaken, uni-")
+    interaction = "Weaken, uni-"
   } else if (qv12 > max(qv1, qv2) & (qv12 < qv1 + qv2)) {
-    interaction = c("Enhance, bi-")
+    interaction = "Enhance, bi-"
   } else if (qv12 == qv1 + qv2) {
-    interaction = c("Independent")
+    interaction = "Independent"
   } else {
-    interaction = c("Enhance, nonlinear")
+    interaction = "Enhance, nonlinear"
   }
-  interd = list(qv1,qv2,qv12,interaction)
+  interd = list(qv1,qv2,qv12,interaction,g1[[2]],g2[[2]],g12[[2]])
   names(interd) = c("Variable1 Q-statistics","Variable2 Q-statistics",
                     "Variable1 and Variable2 interact Q-statistics",
-                    "Interaction")
+                    "Interaction", "Variable1 P-value","Variable2 P-value",
+                    "Variable1 and Variable2 interact P-value")
   return(interd)
 }
 
@@ -130,8 +138,8 @@
   x1 =  purrr::map_chr(seq_along(paradf), \(i) paradf[[i]][1])
   x2 =  purrr::map_chr(seq_along(paradf), \(i) paradf[[i]][2])
   paradf = tibble::tibble(zone1st = paste0('zone',x1),
                           zone2nd = paste0('zone',x2))
 
   twounit_risk_detector = \(n1,n2,cutoff = 0.95){
     y1 = dplyr::filter(gdf, x == n1) %>% dplyr::pull(y)
     y2 = dplyr::filter(gdf, x == n2) %>% dplyr::pull(y)
@@ -148,7 +156,7 @@
     risk = factor(risk,levels = c("Yes", "No"), labels = c("Yes", "No"))
     riskd = list(tt$statistic,tt$parameter,tt$p.value,risk)
     names(riskd) = c("T-statistic","Degree-freedom","P-value","Risk")
     return(riskd)
   }
 
   rd = purrr::map2_dfr(x1,x2,twounit_risk_detector,cutoff = alpha) %>%
@@ -248,21 +256,21 @@
   explanatory = data[, formulaname[[2]]]
 
   switch(type,
          "factor" = {
            res = purrr::map_dfr(names(explanatory),
                                 \(i) gdverse::factor_detector(response,
                                                      data[,i,drop = TRUE])) %>%
              dplyr::mutate(variable = names(explanatory)) %>%
              dplyr::select(variable,dplyr::everything()) %>%
              dplyr::arrange(dplyr::desc(`Q-statistic`))
            res = list("factor" = res)
            class(res) = "factor_detector"
          },
          "interaction" = {
            res = utils::combn(names(explanatory), 2, simplify = FALSE) %>%
              purrr::map_dfr(\(i) gdverse::interaction_detector(response,
                                                       data[,i[1],drop = TRUE],
                                                       data[,i[2],drop = TRUE]) %>%
                               tibble::as_tibble() %>%
                               dplyr::mutate(variable1 = i[1],
                                             variable2 = i[2]) %>%
@@ -272,22 +280,22 @@
            class(res) = "interaction_detector"
          },
          "risk" = {
            res = purrr::map_dfr(names(explanatory),
                                 \(i) gdverse::risk_detector(response,
                                                    data[,i,drop = TRUE],
                                                    alpha) %>%
                                   dplyr::mutate(variable = i) %>%
                                   dplyr::select(variable,zone1st,zone2nd,Risk,
                                                 dplyr::everything()))
            res = list("risk" = res)
            class(res) = "risk_detector"
          },
          "ecological" = {
            res = utils::combn(names(explanatory), 2, simplify = FALSE) %>%
              purrr::map_dfr(\(i) gdverse::ecological_detector(response,
                                                      data[,i[1],drop = TRUE],
                                                      data[,i[2],drop = TRUE],
                                                      alpha) %>%
                               tibble::as_tibble() %>%
                               dplyr::mutate(variable1 = i[1],
                                             variable2 = i[2]) %>%
@@ -328,10 +336,10 @@
 #' @return Formatted string output
 #' @export
 #'
 print.interaction_detector = \(x, ...) {
   cat("                Interaction Detector         ")
   IntersectionSymbol = rawToChar(as.raw(c(0x20, 0xE2, 0x88, 0xA9, 0x20)))
   x = x$interaction %>%
     dplyr::mutate(`Interactive variable` = paste0(variable1,
                                                   IntersectionSymbol,
                                                   variable2)) %>%
@@ -351,13 +359,13 @@
 #' @return Formatted string output
 #' @export
 #'
 print.risk_detector = \(x, ...) {
   cat("                Risk Detector            \n")
   x = dplyr::select(x$risk,variable,zone1st,zone2nd,Risk)
   xvar = x %>%
     dplyr::count(variable) %>%
     dplyr::pull(variable)
   rd2mat = \(x,zonevar){
     matt = x %>%
       dplyr::filter(variable == zonevar) %>%
       dplyr::select(-variable) %>%
@@ -387,12 +395,12 @@
 #'
 print.ecological_detector = \(x, ...) {
   cat("                Ecological Detector         ")
   x = dplyr::select(x$ecological,
                     dplyr::all_of(c('variable1','variable2','Ecological')))
   ed2mat = \(x){
     matt = x %>%
       tidyr::pivot_wider(names_from = "variable2",
                          values_from = "Ecological")
     matname = matt$variable1
     matt = matt %>%
       dplyr::select(-variable1) %>%
@@ -418,19 +426,19 @@
 #'
 #' @return A ggplot2 layer.
 #' @export
 #'
 plot.factor_detector = \(x, slicenum = 2, alpha = 0.95,
                          keep = TRUE, qlabelsize = 3.88, ...) {
   g = x$factor %>%
     dplyr::select(variable, qv = `Q-statistic`,pv = `P-value`) %>%
     dplyr::filter(!is.na(qv)) %>%
     dplyr::mutate(variable = forcats::fct_reorder(variable, qv, .desc = TRUE)) %>%
     dplyr::mutate(variable_col = c("first",rep("others",times = nrow(.)-1))) %>%
     dplyr::mutate(qv_text = paste0(sprintf("%4.2f", qv * 100), "%"))
 
   if (!keep) {
     g = g %>%
       dplyr::mutate(significance = dplyr::if_else(pv <= 1 - alpha,
                                                   'Significant',
                                                   'Not Significant',
                                                   NA)) %>%
@@ -469,15 +477,15 @@
 #' @param ... (optional) Other arguments passed to `ggplot2::theme()`.
 #'
 #' @return A ggplot2 layer
 #' @export
 #'
 plot.interaction_detector = \(x,alpha = 1,...){
   g = x$interaction %>%
     dplyr::select(interactv = `Variable1 and Variable2 interact Q-statistics`,
                   dplyr::everything())
   gv1 = dplyr::count(g,variable1)
   gv2 = dplyr::count(g,variable2)
   gv = gv1 %>%
     dplyr::left_join(gv2,by = 'n') %>%
     dplyr::arrange(dplyr::desc(n))
   g = g %>%
@@ -534,7 +542,7 @@
                      panel.grid = ggplot2::element_blank(), ...) +
       ggplot2::annotate("text", x = Inf, y = -Inf, label = gname,
                         vjust = -1.75, hjust = 1.25,
                         color = "#ff0000", family = "serif")
     return(fig_rd)
   }
   g = dplyr::select(x$risk,variable,zone1st,zone2nd,Risk) %>%
@@ -564,10 +572,10 @@
 #'
 plot.ecological_detector = \(x, ...) {
   g = dplyr::select(x$ecological,
                     dplyr::all_of(c('variable1','variable2','Ecological')))
   gv1 = dplyr::count(g,variable1)
   gv2 = dplyr::count(g,variable2)
   gv = gv1 %>%
     dplyr::left_join(gv2,by = 'n') %>%
     dplyr::arrange(dplyr::desc(n))
   g = g %>%

R/gozh.R

@@ -169,22 +169,22 @@
   }
   interact_type = \(qv1,qv2,qv12){
     if (qv12 < min(qv1, qv2)) {
-      interaction = c("Weaken, nonlinear")
+      interaction = "Weaken, nonlinear"
     } else if (qv12 >= min(qv1, qv2) & qv12 <= max(qv1, qv2)) {
-      interaction = c("Weaken, uni-")
+      interaction = "Weaken, uni-"
     } else if (qv12 > max(qv1, qv2) & (qv12 < qv1 + qv2)) {
-      interaction = c("Enhance, bi-")
+      interaction = "Enhance, bi-"
     } else if (qv12 == qv1 + qv2) {
-      interaction = c("Independent")
+      interaction = "Independent"
     } else {
-      interaction = c("Enhance, nonlinear")
+      interaction = "Enhance, nonlinear"
     }
     return(interaction)
   }
 
   suppressMessages({newdata = xname %>%
     purrr::map_dfc(calcul_rpartdisc)%>%
     purrr::set_names(xname) %>%
     dplyr::bind_cols(dplyr::select(dti,
                                    dplyr::all_of(yname)),
                      .)})
@@ -212,7 +212,7 @@
               "Variable1 and Variable2 interact Q-statistics" = qv12,
               "variable1" = variable1, "variable2" = variable2,
               "Interaction" = purrr::pmap_chr(list(qv1 = qv1,qv2 = qv2,qv12 = qv12),
                                               interact_type)) %>%
                                dplyr::select(variable1,variable2,Interaction,
                                              dplyr::everything())
             res = list("interaction" = res)