now api router ready

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: covidseirPrism
 Title: Peer Models Network PRISM Bridge for the covidseir
-Version: 0.0.2
+Version: 0.0.3
 Authors@R: c(
     person("Amin", "Adibi", email = "[email protected]", role = c("aut", "cph")),
     person("Mohsen", "Sadatsafavi", email = "[email protected]", role = c("aut", "cre")))

NAMESPACE

@@ -1,12 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 export(gateway)
-export(model_run.long)
-export(prism_check_run_progress)
-export(prism_get_output_structure)
 export(prism_model_run)
-export(prism_set_run_progress)
-export(test)
 import(covidseir)
 import(jsonlite)
 import(magrittr)

R/bridge_prism.R

@@ -29,8 +29,6 @@ model_run<-function(model_input = NULL)
     samp_frac_fixed = model_input$samp_frac_fixed
   )
 
-
-
   projection <- project_seir(model,
                      forecast_days = model_input$forecast_days,
                      f_fixed_start = model_input$f_fixed_start,
@@ -40,7 +38,6 @@ model_run<-function(model_input = NULL)
 
   obs_dat <- data.frame(day = seq_along(model_input$daily_cases), value = model_input$daily_cases)
 
-  tidy_seir(projection)
 
   plot <- tidy_seir(projection) %>% plot_projection(obs_dat = obs_dat)
 

R/example.R

@@ -0,0 +1,64 @@
+library(prism)
+library(stringr)
+library(dplyr)
+library(tidyr)
+library(readr)
+library(ggplot2)
+library(lubridate)
+library(ggthemes)
+library(scales)
+library(RColorBrewer)
+library(ggrepel)
+library(patchwork)
+library(gghighlight)
+
+
+url <- "https://docs.google.com/spreadsheets/d/1ad7-09_Jn6AxsdkVPE33T-iLfGpPRmd3piXQqFiVeas/export?&format=csv"
+
+CanadaCases <- read_csv(url)
+CanadaCases <- read_csv(url)
+
+covidCases <-  CanadaCases %>% rename (name = "prname")  %>% rename (Cases = "numconf")  %>% mutate(date=dmy(date)) %>%
+  mutate(name = replace(name, name == "British Columbia", "BC")) %>%
+  mutate(name = replace(name, name == "Ontario", "ON")) %>%
+  mutate(name = replace(name, name == "Alberta", "AB")) %>%
+  mutate(name = replace(name, name == "Saskatchewan", "SK")) %>%
+  mutate(name = replace(name, name == "Manitoba", "MB")) %>%
+  mutate(name = replace(name, name == "Quebec", "QC")) %>%
+  mutate(name = replace(name, name == "Nova Scotia", "NS")) %>%
+  mutate(name = replace(name, name == "New Brunswick", "NB")) %>%
+  mutate(name = replace(name, name == "Newfoundland and Labrador", "NL"))%>%
+  mutate(name = replace(name, name == "Prince Edward Island", "PE")) %>%
+  mutate(name = replace(name, name == "Yukon", "YT")) %>%
+  mutate(name = replace(name, name == "Northwest Territories", "NT")) %>%
+  mutate(name = replace(name, name == "Nunavut", "NU")) %>%
+  filter (name!="Canada") %>% filter (date!=today())
+
+bcCases <- covidCases %>% filter (name == "BC")
+
+#connect_to_model("covidseirPrism", api_key = "123456", address = "localhost:5656")
+connect_to_model("covidseirPrism", api_key = "123456", address = "covidseir.cp.prism-ubc.linaralabs.com")
+
+input <- get_default_input()
+first <- length(bcCases$numtoday)-42+1
+last <- length(bcCases$numtoday)
+input$daily_cases <- bcCases$numtoday[first:last]
+
+# Example assumed sampling fractions of positive cases:
+s1 <- c(rep(0.1, 13), rep(0.2, length(input$daily_cases) - 13))
+
+samp_frac_seg <- c(rep(1, 13), rep(2, length(input$daily_cases) - 13))
+s2 <- rep(0.07, length(input$daily_cases)) # Assuming 7\% of positive individuals are hospitalized
+
+input$samp_frac_fixed <- rep(0.1, length(input$daily_cases))
+
+
+input$fit_iter <- 100
+input$chains <- 1
+
+input$f_fixed <- rep(0.1, 90)
+#input$forecast_iter <- 1:25
+results <- model_run(input)
+draw_plots()
+
+

R/prism_server.R

@@ -1,17 +1,13 @@
-## v0.2.0 2019-09-09
+## v0.3.0 2019-05-27
 
 get_my_name<-function()
 {
   x<-getPackageName()
   return(x)
 }
 
-thisSession<-new.env()
-
-thisSession$redis_connection_status<-0
 
-thisSession$REDIS_ADDRESS="prism.resp.core.ubc.ca"
-thisSession$REDIS_PORT <- 3001
+thisSession<-new.env()
 
 thisSession$MODE_REQUIRE_API_KEY=TRUE;
 thisSession$MODE_REQUIRE_SESSION=FALSE;
@@ -24,21 +20,6 @@ thisSession$LONG_RUN_STATUS_ERROR<- -1
 thisSession$MODEL_DESCRIPTION<-paste0("This is ",get_my_name()," - PRISM enabled!")
 thisSession$MODEL_VERSION<-paste(packageVersion(get_my_name()))
 
-connect_redis_prism <- function (){
-  if(thisSession$redis_connection_status==0)
-  {
-    rredis::redisConnect(host = thisSession$REDIS_ADDRESS, port = thisSession$REDIS_PORT, password = "H1Uf5o6326n6C2276m727cU82O")
-    thisSession$redis_connection_status<-1
-  }
-}
-
-
-#' @export
-test<-function(...)
-{
-  return(get_my_name())
-}
-
 
 #FOR ONE SHOT JSON CALL!
 #Can authenticate the user either by API key or by a session_id.
@@ -49,28 +30,15 @@ gateway<-function(...)
   func<-arguments$func
 
   session_id<-arguments$session_id
-  api_key<-arguments$api_key
 
   if(is.null(session_id)) session_id=""
-  if(is.null(api_key)) api_key=""
-
-  if(func!="test") check_access(api_key,session_id,func)
-
-  #try(
-  #{
-  set_redis_var(paste("RT:LastModelCall:",api_key,sep=""),get_my_name())
-  set_redis_var(paste("RT:LastCallTime:",api_key,sep=""),Sys.time())
-  rredis::redisIncr(paste("RT:CallCount:",api_key,sep=""))
-  rredis::redisRPush(paste("RT:CallTimes:",api_key,sep=""),Sys.time())
-  #})
 
   session_id<<-session_id
 
   arguments$func<-NULL
   arguments$api_key<-NULL
   arguments$session_id<-NULL
 
-  if(!is.null(session_id)) restore_session(session_id)
 
   if(length(arguments)==0) {
     out<-eval(parse(text=paste(func,"()")))
@@ -79,47 +47,14 @@ gateway<-function(...)
     out<-do.call(func, args = arguments)
   }
 
-  if(!is.null(session_id)) save_session(session_id)
-
   return(jsonlite::toJSON(out))
 }
 
 
 #' @export
-prism_model_run<-function(...)
-{
-  return(model_run(...))
-}
-
-
-save_session<-function(session_id)
-{
-  if(!thisSession$MODE_REQUIRE_SESSION_DATA) return()
-  connect_redis_prism()
-  e<-new.env()
-  for(nm in names(globalenv()))
-  {
-    if(typeof(globalenv()[[nm]])!='closure')
-    {
-      e[[nm]]<-globalenv()[[nm]]
-    }
-  }
-  rredis::redisSet(paste(session_id,"env",sep=":"),e)
-}
-
-
-restore_session<-function(session_id)
+prism_model_run<-function(model_input=NULL)
 {
-  if(!thisSession$MODE_REQUIRE_SESSION_DATA) return()
-  connect_redis_prism()
-  e<-rredis::redisGet(paste(session_id,"env",sep=":"))
-  for(nm in names(e))
-  {
-    if(typeof(e[[nm]])!='closure')
-    {
-      .GlobalEnv[[nm]]<-e[[nm]]
-    }
-  }
+  return(model_run(model_input))
 }
 
 
@@ -129,21 +64,10 @@ connect_to_model<-function(api_key="")
   model_name<-environmentName(environment(connect_to_model))
   out<-list(error_code=0,session_id="",version="",description="")
 
-  if(thisSession$MODE_REQUIRE_API_KEY)
-  {
-    if(is.null(api_key))
-    {
-      out$error_code<--1
-      out$version<-"1234"
-      out$description<-"Error: access to the model requires a valid API key."
-      return(out)
-    }
-  }
 
   if(thisSession$MODE_REQUIRE_SESSION)
   {
     session_id<-generate_session_id()
-    set_redis_var(session_id,value = model_name)
     out$session_id<-session_id
   }
 
@@ -152,45 +76,6 @@ connect_to_model<-function(api_key="")
   return(out)
 }
 
-disconnect_from_model<-function()
-{
-  if(!is.null(session_id) && session_id!="")
-  {
-    connect_redis_prism()
-    keys<-rredis::redisKeys(pattern = paste(session_id,"*",sep=""))
-    rredis::redisDelete(keys)
-    #To prevent recording of this session environment by the calling gateway.
-    thisSession$MODE_REQUIRE_SESSION_DATA<-FALSE
-    return(TRUE)
-  }
-  else
-  {
-    warning("This was not a sessioned connection. Nothing to disconnet.")
-    return(FALSE)
-  }
-}
-
-
-#Checks if the submitted api_key has the privilge to access the model.
-#Currently only authenticates based on api_key
-check_access<-function(api_key="", session_id="", func=NULL)
-{
-  if(thisSession$MODE_REQUIRE_API_KEY==FALSE) return(TRUE)
-  if(api_key=="") stop("ERROR: API key is required.")
-
-  #try({
-  #set_redis_var(paste("MODEL_ACCESS/",get_my_name(),":",api_key,sep=""),"kooni")
-  x<-get_redis_var(paste("MT:Access:",get_my_name(),":",api_key,sep=""))
-  if(is.null(x)) stop("ERROR: Unauthorized access.")
-  if(is.numeric(x))
-  {
-    if(x>0) return(TRUE)
-    stop(paste("Access denied - code:",x))
-  }
-  stop(paste("Access denied:",x))
-  #})
-}
-
 
 generate_session_id<-function()
 {
@@ -199,90 +84,16 @@ generate_session_id<-function()
 }
 
 
-#' @export
-model_run.long<-function(input)
-{
-  if(is.null(session_id) || session_id=="")
-    stop("Error: long run is not available as this is a session-less connection")
-
-  key<-paste(session_id,"status",sep=":")
-
-  if(get_redis_var(key))
-  {
-    #There is already a job for this session in the que!
-    return(FALSE)
-  }
-  else
-    set_redis_var(key,0)
-
-  return(TRUE)
-}
-
-
-#' @export
-prism_check_run_progress<-function()
-{
-  if(is.null(session_id) || session_id=="")
-    stop("Error: long run is not available as this is a session-less connection")
-
-  key<-paste(session_id,"status",sep=":")
-
-  val<-get_redis_var(key)
-
-  if(val)
-  {
-    return(val)
-  }
-  else
-    return(FALSE)
-}
-
-
-#This function is called by model code in a different R process. sesssion_infor should be passed from one process to another.
-#' @export
-prism_set_run_progress<-function(value)
-{
-  if(is.null(session_id) || session_id=="")
-    stop("Error: long run is not available as this is a session-less connection")
-
-  key<-paste(session_id,"status",sep=":")
 
-  set_redis_var(key,value)
-}
+#' #' @export
+#' prism_get_output_structure<-function()
+#' {
+#'   out<-list(
+#'     n_agents=prism_output(source="$n_agents", type = "numeric/scalar", group = "", title = "Number of simulated individuals", description = ""),
+#'   )
+#'   return(out)
+#' }
 
-#' @export
-prism_get_output_structure<-function()
-{
-  out<-list(
-    n_agents=prism_output(source="$n_agents", type = "numeric/scalar", group = "", title = "Number of simulated individuals", description = ""),
-  )
-  return(out)
-}
-
-####################Redis example
-
-set_redis_var<-function(variable,value)
-{
-  #TODO: connect should not be in these functions as it will cause multiple connection attempts!
-  connect_redis_prism()
-  rredis::redisSet(variable,value)
-  return(TRUE)
-}
-
-
-get_redis_var<-function(variable)
-{
-  connect_redis_prism()
-  x<-rredis::redisGet(variable)
-  return(x)
-}
-
-
-delete_redis_var<-function(variable)
-{
-  connect_redis_prism()
-  rredis::redisDelete(variable)
-}
 
 set_var<-function(variable,value)
 {