add R_igraph_power_law_fit_new with p-value

Author: Antonov548

R/fit.R

@@ -198,15 +198,15 @@ power.law.fit.old <- function(x, xmin = NULL, start = 2, ...) {
   alpha
 }
 
-power.law.fit.new <- function(data, xmin = -1, force.continuous = FALSE) {
+power.law.fit.new <- function(data, xmin = -1, force.continuous = FALSE, p.value = FALSE) {
   # Argument checks
   data <- as.numeric(data)
   xmin <- as.numeric(xmin)
   force.continuous <- as.logical(force.continuous)
 
   on.exit(.Call(R_igraph_finalizer))
   # Function call
-  res <- .Call(R_igraph_power_law_fit, data, xmin, force.continuous)
+  res <- .Call(R_igraph_power_law_fit_new, data, xmin, force.continuous, p.value)
 
   res
 }

src/cpp11.cpp

@@ -361,7 +361,7 @@ extern SEXP R_igraph_path_length_hist(SEXP, SEXP);
 extern SEXP R_igraph_permute_vertices(SEXP, SEXP);
 extern SEXP R_igraph_personalized_pagerank(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
 extern SEXP R_igraph_personalized_pagerank_vs(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
-extern SEXP R_igraph_power_law_fit(SEXP, SEXP, SEXP);
+extern SEXP R_igraph_power_law_fit_new(SEXP, SEXP, SEXP, SEXP);
 extern SEXP R_igraph_preference_game(SEXP, SEXP, SEXP, SEXP, SEXP, SEXP, SEXP);
 extern SEXP R_igraph_pseudo_diameter(SEXP, SEXP, SEXP, SEXP);
 extern SEXP R_igraph_pseudo_diameter_dijkstra(SEXP, SEXP, SEXP, SEXP, SEXP);
@@ -824,7 +824,7 @@ static const R_CallMethodDef CallEntries[] = {
     {"R_igraph_permute_vertices",                           (DL_FUNC) &R_igraph_permute_vertices,                            2},
     {"R_igraph_personalized_pagerank",                      (DL_FUNC) &R_igraph_personalized_pagerank,                       8},
     {"R_igraph_personalized_pagerank_vs",                   (DL_FUNC) &R_igraph_personalized_pagerank_vs,                    8},
-    {"R_igraph_power_law_fit",                              (DL_FUNC) &R_igraph_power_law_fit,                               3},
+    {"R_igraph_power_law_fit_new",                          (DL_FUNC) &R_igraph_power_law_fit_new,                           4},
     {"R_igraph_preference_game",                            (DL_FUNC) &R_igraph_preference_game,                             7},
     {"R_igraph_pseudo_diameter",                            (DL_FUNC) &R_igraph_pseudo_diameter,                             4},
     {"R_igraph_pseudo_diameter_dijkstra",                   (DL_FUNC) &R_igraph_pseudo_diameter_dijkstra,                    5},

src/rinterface_extra.c

@@ -8331,6 +8331,59 @@ SEXP R_igraph_incident_edges(SEXP pgraph, SEXP pe, SEXP pmode) {
   return result;
 }
 
+SEXP R_igraph_power_law_fit_new(SEXP data, SEXP xmin, SEXP force_continuous, SEXP pvalue)
+{
+  igraph_vector_t c_data;
+  igraph_plfit_result_t c_res;
+  igraph_real_t c_xmin;
+  igraph_bool_t c_force_continuous, c_compute_pvalue;
+  SEXP result, names;
+
+  SEXP r_result;
+
+  R_SEXP_to_vector(data, &c_data);
+  IGRAPH_R_CHECK_REAL(xmin);
+  c_xmin = REAL(xmin)[0];
+  IGRAPH_R_CHECK_BOOL(force_continuous);
+  c_force_continuous = LOGICAL(force_continuous)[0];
+  IGRAPH_R_CHECK_BOOL(pvalue);
+  c_compute_pvalue = LOGICAL(pvalue)[0];
+
+  IGRAPH_R_CHECK(igraph_power_law_fit(&c_data, &c_res, c_xmin, c_force_continuous));
+
+  if (c_compute_pvalue) {
+    igraph_real_t p;
+    igraph_plfit_result_calculate_p_value(&c_res, &p, 0.001);
+
+    PROTECT(result=NEW_LIST(6));
+    PROTECT(names=NEW_CHARACTER(6));
+
+    SET_VECTOR_ELT(result, 5, Rf_ScalarReal(p));
+    SET_STRING_ELT(names, 5, Rf_mkChar("KS.p"));
+  } else {
+    PROTECT(result=NEW_LIST(5));
+    PROTECT(names=NEW_CHARACTER(5));
+  }
+
+  SET_VECTOR_ELT(result, 0, Rf_ScalarLogical(c_res.continuous));
+  SET_VECTOR_ELT(result, 1, Rf_ScalarReal(c_res.alpha));
+  SET_VECTOR_ELT(result, 2, Rf_ScalarReal(c_res.xmin));
+  SET_VECTOR_ELT(result, 3, Rf_ScalarReal(c_res.L));
+  SET_VECTOR_ELT(result, 4, Rf_ScalarReal(c_res.D));
+
+  SET_STRING_ELT(names, 0, Rf_mkChar("continuous"));
+  SET_STRING_ELT(names, 1, Rf_mkChar("alpha"));
+  SET_STRING_ELT(names, 2, Rf_mkChar("xmin"));
+  SET_STRING_ELT(names, 3, Rf_mkChar("logLik"));
+  SET_STRING_ELT(names, 4, Rf_mkChar("KS.stat"));
+  SET_NAMES(result, names);
+
+  r_result = result;
+
+  UNPROTECT(2);
+  return(r_result);
+}
+
 /* +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++C */
 /*                                                               C */
 /*  Given a HIERARCHIC CLUSTERING, described as a sequence of    C */