Merge pull request #346 from sdcTools/fixes-lto

LTO-related Fixes

DESCRIPTION

@@ -101,6 +101,6 @@ Collate:
     'maG.R'
     'sdcApp.R'
     'show_sdcMicroObj.R'
-RoxygenNote: 7.3.0
+RoxygenNote: 7.3.1
 VignetteBuilder: knitr
 Encoding: UTF-8

R/LocalRecProg.R

@@ -146,7 +146,7 @@ LocalRecProgWORK <- function(data, categorical, numerical=NULL, ancestors=NULL,
 
   dataX <- as.matrix(data[, c(categorical, numerical, ancestors), drop=FALSE])
 
-  res <- .Call("LocalRecProg_cpp", dataX, k_level, FindLowestK, ancestor_settings, weight, range,
+  res <- "LocalRecProg_cpp"(dataX, k_level, FindLowestK, ancestor_settings, weight, range,
     FALSE, lowMemory, missingValue)
   colnames(res$Res) <- paste(c(categorical, numerical), "_lr", sep="")
   cbind(data[, c(categorical, numerical)], res$Res)

R/RcppExports.R

@@ -1,6 +1,30 @@
 # Generated by using Rcpp::compileAttributes() -> do not edit by hand
 # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
 
+LocalRecProg_cpp <- function(data, K_Level_R, FindLowestK_R, ancestor_R, weight_R, range_R, categoryCount_R, LowMemory_R, g_MissingValue_R) {
+    .Call(`_sdcMicro_LocalRecProg_cpp`, data, K_Level_R, FindLowestK_R, ancestor_R, weight_R, range_R, categoryCount_R, LowMemory_R, g_MissingValue_R)
+}
+
+Mdav <- function(data, data2, g_MissingValue_R, weights_R, g_K_R) {
+    .Call(`_sdcMicro_Mdav`, data, data2, g_MissingValue_R, weights_R, g_K_R)
+}
+
+measure_hierachical <- function(data) {
+    .Call(`_sdcMicro_measure_hierachical`, data)
+}
+
+measure_risk_cpp <- function(data, weighted_R, n_key_vars_R, l_recurs_c_R, ldiv_index_R, missing_value_R) {
+    .Call(`_sdcMicro_measure_risk_cpp`, data, weighted_R, n_key_vars_R, l_recurs_c_R, ldiv_index_R, missing_value_R)
+}
+
+measure_threshold <- function(data, global_risk_R) {
+    .Call(`_sdcMicro_measure_threshold`, data, global_risk_R)
+}
+
+Suda2 <- function(data, g_MissingValueALEX_R, MaxK_R, DisFraction_R, elliot_scores) {
+    .Call(`_sdcMicro_Suda2`, data, g_MissingValueALEX_R, MaxK_R, DisFraction_R, elliot_scores)
+}
+
 cpp_calcSuppInds <- function(inp, checkVals, params) {
     .Call(`_sdcMicro_cpp_calcSuppInds`, inp, checkVals, params)
 }

R/mdav.R

@@ -22,7 +22,7 @@ mdav <- function(data, variables = NULL, weights = NULL, K = 10, missing = -999)
   TF <- is.na(dataX)
   dataX[TF] <- missing
   data2[, ] <- NA
-  dat <- .Call("Mdav", dataX, data2, missing, weights, K)$Res
+  dat <- Mdav(dataX, data2, missing, weights, K)$Res
   try(dat[TF] <- NA)
   data[, variables] <- dat
   invisible(data)

R/measure_risk.R

@@ -245,7 +245,6 @@ measure_riskWORK <- function(data, keyVars, w=NULL, missing=-999, hid=NULL, max_
   ind <- do.call(order, data.frame(dataX))
   dataX <- dataX[ind, , drop=FALSE]
   ind <- order(c(1:nrow(dataX))[ind])
-  # res <- .Call('measure_risk_cpp',dataX,weighted,n_key_vars,2,-99,missing)#
   res <- list()
   res$Res <- Res
   colnames(res$Res) <- c("risk", "fk", "Fk")
@@ -257,7 +256,7 @@ measure_riskWORK <- function(data, keyVars, w=NULL, missing=-999, hid=NULL, max_
   if (max_global_risk >= 1 || max_global_risk <= 0) {
     stop("max_global_risk argument must be between 0 and 1!")
   }
-  resth <- .Call("measure_threshold", res$Res[ind, 1], max_global_risk)
+  resth <- measure_threshold(res$Res[ind, 1], max_global_risk)
   if (is.na(resth$global_threshold_unsafe) || is.na(resth$global_threshold_safe) || is.na(resth$global_threshold)) {
     res[["global_threshold"]] <- NA
   } else if (resth$global_threshold_unsafe == resth$global_threshold && resth$global_threshold_safe ==
@@ -290,7 +289,7 @@ measure_riskWORK <- function(data, keyVars, w=NULL, missing=-999, hid=NULL, max_
       res[["hier_risk"]] <- sum(res$Res[, 4], na.rm=TRUE)/nrow(res$Res)
       res[["hier_risk_pct"]] <- res[["hier_risk"]] * 100
     } else {
-      resh <- .Call("measure_hierachical", dataX)
+      resh <- measure_hierachical(dataX)
       resh$Res <- resh$Res[ind]
       res$Res <- cbind(res$Res, resh$Res)
       res[["hier_risk_ER"]] <- resh[["hier_risk_ER"]]
@@ -398,7 +397,7 @@ ldiversityWORK <- function(data, keyVars, ldiv_index, missing=-999, l_recurs_c=2
     ldiv_index=-99
   if (length(ldiv_index) > 5)
     stop("Maximal number of sensitivity variables is 5")
-  res <- .Call("measure_risk_cpp", dataX, 0, n_key_vars, l_recurs_c, ldiv_index, missing)
+  res <- measure_risk_cpp(dataX, 0, n_key_vars, l_recurs_c, ldiv_index, missing)
   res$Fk <- res$Res[, 3]
   res$Res <- res$Res[ind, ]
   if (all(ldiv_index != -99)) {

R/rankSwap.R

@@ -188,7 +188,7 @@ setMethod(
   if (is.null(P)) {
     P <- -1
   }
-  dat <- .Call("RankSwap",
+  dat <- RankSwap(
     dataX,
     data2,
     miss_val,

R/suda2.R

@@ -116,7 +116,7 @@ suda2WORK <- function(data, variables = NULL, missing = -999, DisFraction = 0.01
   }
   dataX <- as.matrix(dataX)
   dataX[is.na(dataX)] <- missing
-  dat <- .Call("Suda2", dataX, missing, ncol(dataX), DisFraction, original_scores)$Res
+  dat <- Suda2(dataX, missing, ncol(dataX), DisFraction, original_scores)$Res
   if (length(variables) == 2) {
     dat <- dat[, -3]
   } else if (length(variables) == 1) {

src/Framework.h

@@ -596,7 +596,6 @@ inline int SubMain(int argc, char *argv[])
 		int main(int argc, char *argv[])	{	g_MyMain = MyMain; return SubMain(argc - 1, argv + 1);	}
 #endif	// __PLUGIN
 
-#endif // __FRAMEWORK_H
 
 /**
  * Framework : contains basic multi-purpose functions & classes
@@ -1541,4 +1540,4 @@ int is_same_key_Risk2(double key1[], double key2[], int key_size) {
   }
   return rc;
 }
-
+#endif // __FRAMEWORK_H

src/LocalRecProg/kneibmatch.cpp

@@ -48,200 +48,3 @@ enum EMatch
   e_Match_Kneib
 };
 
-
-RcppExport SEXP LocalRecProg_cpp(SEXP data, SEXP K_Level_R, SEXP FindLowestK_R, SEXP ancestor_R, SEXP weight_R, SEXP range_R, SEXP categoryCount_R, SEXP LowMemory_R, SEXP g_MissingValue_R)
-{
-BEGIN_RCPP
-  int i, j;
-  int c2;
-  int K_Level;
-  //uint TimeStart = TimeGetMilliSecond(), TimeMid;
-  EMatch Match = e_Match_Complete;
-  BOOL FindLowestK = FALSE, LowMemory = FALSE;
-
-    //============= Init
-  Uninit_LocalRec();
-
-  g_Debug_LocalRec = FALSE;
-  g_Output = e_Output_Average;
-  g_Epsilon = es_Epsilon;
-
-  Rcpp::NumericMatrix Mat_LocalRec(data);  // creates Rcpp matrix from SEXP
-  g_NbRow_LocRec = Mat_LocalRec.rows();
-  int NbVar_LocRec = Mat_LocalRec.cols();
-  // NbVar_LocRec = NbTotalVar / 2;
-  //=============init Parameters
-  K_Level = Rcpp::as<int>(K_Level_R);
-  if(K_Level >= 1) Match = e_Match_Kneib;
-  if(Rcpp::as<bool>(range_R)) g_Output = e_Output_Range;
-  FindLowestK = Rcpp::as<bool>(FindLowestK_R);
-  LowMemory = Rcpp::as<bool>(LowMemory_R);
-  double g_MissingValue_LocalRec = Rcpp::as<double>(g_MissingValue_R);
-  if(g_MissingValue_LocalRec == 0) g_MissingValue_LocalRec = -1.0f;
-  // Ancestors
-  // 1. Column: Position of the variable with ancestor variables (0-based)
-  // 2. Column: number of ancestor variables
-  Rcpp::NumericMatrix ancestors(ancestor_R);
-  int ancestorLen = ancestors.rows();
-  int ancestorCol = ancestors.cols();
-  if(ancestorLen > 1 && ancestorCol>1)
-  {
-    for(j=0; j < ancestorLen; j++)
-    {
-      NbVar_LocRec -= ancestors(j,1);
-    }
-    // NbVar_LocRec = NbTotalVar / 2;
-    // NbVar_LocRec: position of the first ancestor variable
-    // ancestors: ancestor array
-    CData::InitAncestors(NbVar_LocRec, ancestors);
-  }
-  Rcpp::NumericMatrix res(g_NbRow_LocRec, NbVar_LocRec); // result matrix that is returned
-
-  // weight-vector:
-  // 1. Column: Value of the weight for the variable
-  // 2. Column: TRUE/FALSE if variable is of type categorial
-  Rcpp::NumericMatrix weight(weight_R);
-  if(NbVar_LocRec == weight.rows()) {
-    CData::Init(NbVar_LocRec, weight);
-  } else {
-    Uninit_LocalRec();
-    return Rcpp::wrap("Error: Not enough weights specified");
-  }
-
-  bool categoryCount = Rcpp::as<bool>(categoryCount_R);
-  if(categoryCount) {
-    CData::m_CategoryCountVar = TRUE;
-    --NbVar_LocRec;
-  }
-  if (g_NbRow_LocRec <= 0 || CData::m_NbVariable <= 0)
-  {
-    Uninit_LocalRec();
-    return Rcpp::wrap(-3);
-  }
-
-  if (Match == e_Match_Kneib
-    && (K_Level >= g_NbRow_LocRec || K_Level < 1))
-  {
-    Uninit_LocalRec();
-    return Rcpp::wrap(-4);
-  }
-    //============= Data Allocation & Loading
-  g_Data = new CData[g_NbRow_LocRec];
-
-  if (LoadData(g_NbRow_LocRec, g_MissingValue_LocalRec, g_Data, Mat_LocalRec) != g_NbRow_LocRec)
-  {
-    Uninit_LocalRec();
-    return Rcpp::wrap(-5);
-  }
-
-  if (!LowMemory && g_NbRow_LocRec > 1 && CData::m_NbVariable > 2)
-  {
-    TDist *pAllDist = new TDist[g_NbRow_LocRec * (g_NbRow_LocRec - 1) / 2];
-    int NbEntry = 0;
-
-    ForLoop (i, g_NbRow_LocRec)
-    {
-      g_Data[i].m_pDist = pAllDist + NbEntry;
-
-      int NbDist = g_NbRow_LocRec - i - 1;
-
-      ForLoop (j, NbDist)
-        g_Data[i].m_pDist[j] = dist(g_Data + i, g_Data + i + j + 1);
-
-      --g_Data[i].m_pDist;    //Optim: avoid to have to do it each time dist() is called
-      NbEntry += NbDist;
-    }
-
-    CData::m_pAllDist = pAllDist;
-
-  }
-  g_Vertex = MALLOC(vertex_type, (((long)g_NbRow_LocRec) * 3) / 2);
-  for (i = 0; i < g_NbRow_LocRec; ++i)
-    g_Vertex[i].item = (g_Data + i);
-  g_Match = MALLOC(int, g_NbRow_LocRec);
-    //============= Main Algo
-  int K0 = 1,
-    Km = 1;
-
-  while (1)
-  {
-    if (Match == e_Match_Kneib)
-    {
-      CleanDeleteT(g_AdjType);
-      g_AdjType = MALLOC(adj_type, 2 * ((long)g_NbRow_LocRec) * K_Level);
-    }
-
-    g_Diameter = diameter(g_Data, g_NbRow_LocRec);
-    if (Match == e_Match_Kneib)
-    {
-      make_adj(g_Vertex, g_NbRow_LocRec, K_Level, g_AdjType);
-    }
-    if (Match == e_Match_Kneib)
-      g_ShiftBound = SHIFT(UPPERBOUND);
-    else
-      g_ShiftBound = 0;
-    if (Match == e_Match_Kneib){
-      NSKneib::weighted(g_Vertex, g_NbRow_LocRec, g_Vertex + g_NbRow_LocRec);
-    }else{
-      NSComplete::weighted(g_Vertex, g_NbRow_LocRec, g_Vertex + g_NbRow_LocRec);
-    }
-    if (Match != e_Match_Kneib || !FindLowestK)
-      break;
-    j = 0;
-
-    ForLoop (i, g_NbRow_LocRec)
-    {
-      if (g_Vertex[i].partner == NULL)
-        ++j;
-    }
-
-    int PrevK = K_Level;
-
-    if (j > 1)
-    {
-      K0 = K_Level;
-
-      if (Km == 1)
-        K_Level *= 5;
-      else
-        K_Level = (Km + K_Level + 1) / 2;
-    }
-    else
-    {
-      if (Km > K_Level)
-        Km = K_Level;
-      K_Level = (K0 + K_Level + 1) / 2;
-    }
-    if (K_Level < K0 + 1
-      || K_Level == PrevK)
-    {
-      break;
-    }
-  }
-  BOOL Done = FALSE;
-
-  if (Match == e_Match_Kneib)
-  {
-    Done = NSKneib::match_check(g_Vertex, g_NbRow_LocRec) >= 0
-      && NSKneib::dual_check(g_Vertex, g_NbRow_LocRec, g_Vertex + g_NbRow_LocRec);
-  }
-  else
-  {
-    Done = NSComplete::match_check(g_Vertex, g_NbRow_LocRec) >= 0
-      && NSComplete::dual_check(g_Vertex, g_NbRow_LocRec, g_Vertex + g_NbRow_LocRec);
-  }
-  if (Done)
-  //if (1)
-  {
-    c2 = get_matching(g_Vertex, g_NbRow_LocRec, g_Match);
-    sum_matching(g_Vertex, g_Match, c2);
-    write_matching(g_Vertex, g_NbRow_LocRec, g_Match, c2, res);
-  }
-    //============= Uninit_LocalRec
-  Uninit_LocalRec();
-  return Rcpp::List::create(
-    Rcpp::Named( "Res" ) = res
-  ) ;
-
-  END_RCPP
-}