Commit b0e5f31c authored by vbaudrot's avatar vbaudrot

add Immunity

parent a39ba6d8
......@@ -61,6 +61,64 @@ labelText = function(x,y,z){
return( ifelse(is.na(y), paste(x,z), paste(x,y,z)))
}
#############################################################################
################### ###################
################### IMMUNITY ###################
################### ###################
#############################################################################
# library(readr)
# immun_M3_k = list()
# for(i in 1:10){
# immun_M3_k[[i]] = as.numeric(readr::read_csv(paste0("~/Documents/coronavirus/immunity/immun_M3_k", i,".txt"), col_names = FALSE))
# }
# write_rds(immun_M3_k, "www/immun_M3_k.rds")
#
# library(sf)
# library(dplyr)
# mapFranceDepartement = sf::st_read("../immunity/departements-20140306-100m.shp",
# stringsAsFactors = FALSE,
# options = "ENCODING=WINDOWS-1252")
#
# mapFranceDepartement_Metropolitan = mapFranceDepartement %>%
# dplyr::filter(!(nom %in% c("Martinique", "Guadeloupe", "La Réunion", "Guyane", "Mayotte", "Corse-du-Sud", "Haute-Corse")))
#
# mapFranceDepartement_Corse = sf::st_union(dplyr::filter(mapFranceDepartement, nom == "Corse-du-Sud"),
# dplyr::filter(mapFranceDepartement, nom == "Haute-Corse"))
# write_rds(mapFranceDepartement, "www/mapFranceDepartement.rds")
mapFranceDepartement = readRDS("www/mapFranceDepartement.rds")
immun_M3_k = readRDS("www/immun_M3_k.rds")
# I = dataDEATHclean %>%
# dplyr::filter(`Country/Region` == "France" && is.na(`Province/State`) ) %>%
# dplyr::mutate(smoothDailyCount = zoo::rollmean(DailyCount, 10, fill = NA)) %>%
# dplyr::filter(!is.na(smoothDailyCount), smoothDailyCount > 0)
#
# Y = I$smoothDailyCount
# Time = I$Date
# plot(Time, Y)
# t0 = 1
# t = 10
# beta=1/10
# funReg = function(Y, t0, t, beta=1/10, R=2, s=2){
# Dt0 = Y[t0]
# Dt = Y[t]
# Dt0+(Dt-Dt0)*(exp(beta*(R-1)*(s-t0))-1)/(exp(beta*(R-1)*(t-t0))-1)
# }
# funReg(Y, t0= 1, t=100)
#
# Dt0 = Y[t0]
# Dt = Y[t]
# t
# t0
# beta
# Dt
# m <- nls(formula = Y[t] ~ Dt0+(Dt-Dt0)*(exp(beta*(R-1)*(s-t0))-1)/(exp(beta*(R-1)*(t-t0))-1), start = list(R=2,s=2))
#############################################################################
################### ###################
################### FORECAST ###################
......
......@@ -205,6 +205,7 @@ server <- function(input, output, session){
})
#############################################################################
################### ###################
################### FORECAST ###################
......@@ -284,5 +285,47 @@ server <- function(input, output, session){
}
})
})
#############################################################################
################### ###################
################### IMMUNITY ###################
################### ###################
#############################################################################
# Reactive expression for the data subsetted to what the user selected
dataImmunity <- reactive({
selection=rep(TRUE,95)
selection[20] = FALSE
mapFranceDepartement$Rt_immunity = immun_M3_k[[input$DateSelectImmunty]][selection]
mapFranceDepartement # return
})
pal <- colorNumeric(palette = "YlOrRd",
domain = unlist(immun_M3_k))
output$mapImmunity <- renderLeaflet({
leaflet(data = dataImmunity()) %>%
addTiles() %>%
fitBounds(~-5.142238, ~42.332755, ~8.231781, ~51.089842) %>%
addLegend(position = "bottomright",
title = "R(t)",
pal = pal,
values = ~unlist(immun_M3_k))
})
# Use a separate observer to recreate the legend as needed.
observe({
proxy <- leafletProxy("mapImmunity", data = dataImmunity())
proxy %>%
addPolygons( weight = 2,
color = ~pal(Rt_immunity),
fillOpacity = 0.5)
})
}
\ No newline at end of file
......@@ -16,6 +16,7 @@ ui <- tagList(
sidebarMenu(
# id = "Data",
menuItem("Forecast", tabName = "Forecast", icon = icon("chart-line")),
menuItem("Immunity", tabName = "Immunity", icon = icon("chart-line")),
menuItem("Map", tabName = "Map", icon = icon("globe")),
menuItem("Data", tabName = "Data", icon = icon("database")),
menuItem("Credits", tabName = "Credits", icon = icon("users-cog"))
......@@ -146,34 +147,31 @@ ui <- tagList(
probabilities and the forecast using only real-life predictors must be considered with caution and
a parametric predictor can be incorporated to the mixture (just tick the corresponding box)."))
)
# ),
# fluidRow(
# box(width = 12,
# title = "Raw mortality data",
# status = "info",
# solidHeader = TRUE,
# column(width = 12,
# selectInput(inputId = "forecastCountry",
# label = "Select Countries",
# choices = Country,
# selected = Country,
# multiple = TRUE)
# ),
# box(width = 6,
# status = "info",
# p("Not rescaled"),
# plotlyOutput("plotRaw_RescaleFALSE")
# ),
# box(width = 6,
# status = "info",
# p("Rescaled"),
# plotlyOutput("plotRaw_RescaleTRUE")
# )
# )
)
),
#############################################################################
################### ###################
################### IMMUNITY ###################
################### ###################
#############################################################################
tabItem(
tabName = "Immunity",
fluidRow(
box(width = 12,
# column(width = 4,
sliderInput("DateSelectImmunty", "Days",
1, length(immun_M3_k),
value = 1, step = 1
)
# )
)
),
fluidRow(
leafletOutput("mapImmunity", width = "100%", height = 500)
)
),
#############################################################################
################### ###################
################### CREDITS ###################
################### ###################
#############################################################################
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment