moving the site build to github with actions

Author: ischlo

.gitignore

@@ -7,3 +7,4 @@
 .DS_Store
 inst/doc
 
+docs

README.Rmd

@@ -97,7 +97,8 @@ Compared to the equivalent functions implemented in pure R, it runs about x10 fa
 
 ```{r performance,eval=TRUE,include=TRUE,echo = FALSE}
 
-bench <- rlist::list.load("benchmark_test.rds")
+bench <- system.file("extdata","benchmark_test.rds",package = "cppSim")
+  # rlist::list.load("benchmark_test.rds")
 
 print(bench)
 

README.md

@@ -110,9 +110,7 @@ Compared to the equivalent functions implemented in pure R, it runs
 about x10 faster for a $\sim 1000\times 1000$ OD matrix, the speed up is
 increasignly more significant as matrices get bigger.
 
-    #>      test replications elapsed relative user.self sys.self user.child sys.child
-    #> 2     cpp           10   3.257    1.000     3.046    0.184          0         0
-    #> 1 regular           10  34.201   10.501    31.887    1.970          0         0
+    #> [1] ""
 
 ## References
 

benchmark_test.rds inst/extdata/benchmark_test.rdsbenchmark_test.rds renamed to inst/extdata/benchmark_test.rds

@@ -11,7 +11,7 @@ vignette: >
 
 
 
-```{r setup, include=FALSE,eval=TRUE}
+```{r setup, echo=FALSE, include=TRUE, eval=TRUE}
 knitr::opts_chunk$set(echo = TRUE
                       ,eval = TRUE
                       ,cache = TRUE
@@ -23,11 +23,113 @@ library(rlist)
 library(data.table)
 library(foreach)
 
-source("gravity_model_functions.R")
+```
+
+```{r, echo=FALSE}
+
+# The good old original R code to run SIM that was used before cppSim
+
+### this file contains the functions used to run the gravity model
+
+cost_function <- function(d, beta, type = "exp") {
+
+  # d is the od distance matrix, taking the exponential
+  # means doing this operation for each individual element
+  #  with an exponent beta
+  # the type parameter allows to set it to either exp or pow.
+  #  pow means we use a power function as cost, rather than exponential
+
+  if (type == "exp") {
+    exp(-beta*d)
+  } else if (type == "pow") {
+    d^(-beta)
+  } else {
+    print("provide a type of functino to compute")
+  }
+}
+
+r_2 <- function(d, f) cor(d |> as.numeric()
+                          ,f |> as.numeric())^2
+
+r <- function(d, f) cor(d |> as.numeric()
+                        ,f |> as.numeric())
+
+rmse <- function(d,f) sum((d-f)^2)
+
+calibration <- function(cost_fun,O,D,delta = 0.05) {
+  B <- rep_len(1,nrow(cost_fun))
+  eps <- abs(sum(B))
+  e <- NULL
+  i <- 0
+  while((eps > delta) & (i<50)) {
+    A_new <- 1/(apply(cost_fun,function (x) sum(B*D*x),MARGIN = 1))
+    B_new <- 1/(apply(cost_fun,function (x) sum(A_new*O*x),MARGIN = 2))
+    eps <- abs(sum(B_new-B))
+    e <- append(e,eps)
+    A <- A_new
+    B <- B_new
+    i <- i+1
+  }
+  list(
+    "A"= A
+    ,"B" = B
+    ,"e" = e
+    )
+}
+
+run_model <- function(flows
+                      ,distance
+                      ,beta = 0.25
+                      ,type = "exp"
+                      #,cores = 3
+                      ) {
+
+  F_c <- cost_function(d = {{distance}},beta = {{beta}},type = type)
+  print("cost function computed")
+  O <- apply(flows,sum, MARGIN = 1) |> as.integer()
+  D <- apply(flows,sum, MARGIN = 2) |> as.integer()
+  A_B <- calibration(cost_fun = F_c
+                     ,O=O
+                     ,D=D
+                     ,delta = .001)
+  print("calibration: over")
+  A <- A_B$A
+  B <- A_B$B
+
+  flows_model <- foreach(j = c(1:nrow(F_c))
+                         ,.combine = rbind) %do% {
+                           round(A[j]*B*O[j]*D*F_c[j,])
+                         }
+
+  print("model run: over")
+  e_sor <- e_sorensen(flows,flows_model) |> as.numeric()
+  print(paste0("E_sor = ",e_sor))
+  r2 <- r_2(flows_model,flows) |> as.numeric()
+  print(paste0("r2 = ",r2))
+  RMSE <- rmse(flows_model,flows) |> as.numeric()
+  print(paste0("RMSE = ",RMSE))
+
+  list("values" = flows_model
+       ,"r2" = r2
+       ,"rmse" = RMSE
+       ,"calib" = A_B$e
+       ,"e_sor" = e_sor
+       )
+
+}
+
+### Validation
+
+e_sorensen <- function(data, fit) {
+  2*sum(apply(cbind(data |> c()
+                    ,fit |> c()), MARGIN = 1, FUN = min))/(sum(data) + sum(fit))
+}
+
 
 ```
 
 
+
 ```{r load_data}
 
 flows_matrix <- list.load("flows_matrix.rds")
@@ -59,9 +161,9 @@ with the derivation made from a recursive chain with initial values 1. Let's ref
 
 ```{r}
 # creating the O, D vectors. 
-O <- apply(flows_matrix,reduce, MARGIN = 2, sum) |> c()
+O <- apply(flows_matrix, sum, MARGIN = 2) |> c()
 
-D <- apply(flows_matrix,reduce, MARGIN = 1, sum) |> c()
+D <- apply(flows_matrix, sum, MARGIN = 1) |> c()
 ```