Skip to content

GitLab

Commit 84a33ce8 authored by twincacca's avatar twincacca
Browse files

change X

parent e3a07845
Hide whitespace changes
Inline Side-by-side
README.md
View file @ 84a33ce8
# sero-data-zero-cases
sero-data-zero-cases
byebye
antoine
app.R deleted 100644 → 0
View file @ e3a07845
library(shiny)
ui <- fluidPage(
titlePanel(""),
# img(src='./logo_confi.png', align = "right", height="25%", width="25%"), # togliere stemma confederazione
h1("Sero Data, Zero Cases"),
h4("Identify risk factors associated to serological Covid19 tests"),
HTML(paste("", "", sep="<br/>")),
HTML(paste("", "", sep="<br/>")),
h3("Please answer based on your previous month lifestyle"),
HTML(paste("", "", sep="<br/>")),
shinyjs::useShinyjs(),
tags$head(tags$style("#outputText{color: red;
font-size: 20px;
font-style: italic;
}"
)
),
fluidRow(
# serve solo a fare spazio
column(3,
h3(""),
helpText("")),
column(3,
# h3("Submit Form"),
# submitButton("Submit")
actionButton("submit", "Submit Form", icon("paper-plane"),
style="color: #fff; background-color: #337ab7; border-color: #2e6da4; font-size: 25px"),
# verbatimTextOutput("outputText")
textOutput("outputText")
)
# actionButton("do", "Click Me")
# p('Output text1'),
# textOutput( 'text1')
),
HTML(paste("", "", sep="<br/>")),
HTML(paste("", "", sep="<br/>")),
h3(strong("Diagnostic test used")),
fluidRow(
column(3,
radioButtons("SeroTestName",
h4("Test name"),
choices = list("Roche GlmB-22" = 1,
"LabOmics COVID-19 IgM/IgG Rapid Test" = 2,
"Other" = 3),
selected = NA)),
column(3,
textInput("SeroTestNameSpecified", h4("Specify name of other diagnostic test"),
value = ""))
),
HTML(paste("", "", sep="<br/>")),
HTML(paste("", "", sep="<br/>")),
fluidRow(
column(3,
radioButtons("SeroTestOutcome",
h4("Outcome of the serological test"),
choices = list("Positive to Covid-19" = 1,
"Negative to Covid-19" = 2),
selected = NA)),
column(3,
textInput("PreviouslyTestedPositive", h4("Previously tested Covid19-positive by other tests (e.g., swab)?"),
value = "If yes specify test"))
),
HTML(paste("", "", sep="<br/>")),
HTML(paste("", "", sep="<br/>")),
h3(strong("Generalities")),
fluidRow(
column(3,
radioButtons("gender",
h4("Gender"),
choices = list("Female" = 1,
"Male" = 2,
"Other" = 3),
selected = NA)),
column(3,
numericInput("age",
h4("Age"),
value = NA)),
column(3,
textInput("MedicalCondition", h4("Medical conditions"),value = "separated by comma"))
),
HTML(paste("", "", sep="<br/>")),
HTML(paste("", "", sep="<br/>")),
h3(strong("Demographics")),
fluidRow(
column(3,
radioButtons("LivingArea",
h4("Living area"),
choices = list("City" = 1,
"Residential" = 2,
"Countryside" = 3),
selected = NA)),
column(3,
textInput("ZIP", h4("ZIP code"),
value = "Enter ZIP code"))
),
h3(strong("Everyday practices")),
fluidRow(
column(3,
radioButtons("UseMask",
h4("Use of protection mask"),
choices = list("Frequent" = 1,
"Sometimes" = 2,
"Never" = 3),
selected = NA)),
column(3,
radioButtons("UseHandCleaner",
h4("Use of hand cleaner"),
choices = list("Frequent" = 1,
"Sometimes" = 2,
"Never" = 3),
selected = NA)),
column(3,
radioButtons("RespectingRules",
h4("Respecting health authorities advice"),
choices = list("Strong" = 1,
"Middle" = 2,
"Weak" = 3),
selected = NA))
),
HTML(paste("", "", sep="<br/>")),
HTML(paste("", "", sep="<br/>")),
h3(strong("Private life")),
fluidRow(
column(3,
numericInput("NumberFamilyContacts",
h4("Number of family contacts"),
value = NA)),
column(3,
numericInput("NumberNonFamilyContacts",
h4("Number of non-family contacts"),
value = NA)),
column(3,
numericInput("HoursAtHome",
h4("Hours per day at home"),
value = NA))
),
HTML(paste("", "", sep="<br/>")),
HTML(paste("", "", sep="<br/>")),
h3(strong("Work life")),
fluidRow(
column(3,
radioButtons("Mobility",
h4("Mobility"),
choices = list("Public transportation" = 1,
"Private car/motorbike" = 2,
"Bike" = 3),
selected = NA)),
column(3,
radioButtons("Homeworking",
h4("Homeworking"),
choices = list("Yes" = 1,
"No" = 2,
"Partially" = 3),
selected = NA))
),
fluidRow(
column(4,
h4("Further involvement"),
helpText("I wish to contribute further to the fight against Covid19 and I am available for further questionnaires/studies (you can opt out at any moment)")),
column(2,
radioButtons("FurtherInvolvement",
h4(HTML(paste("", "", sep="<br/>")),HTML(paste("", "", sep="<br/>"))),
choices = list("Yes" = 1,
"No" = 2),
selected = NA)),
column(2,
h4(HTML(paste("", "", sep="<br/>"))),
textInput("ContactDetails",
h4("Contact details"),
value = ""))
)
)
server <- function(input, output, session) {
#-------- save data in a csv row --------
observeEvent(input$submit, {
print("-----")
print(input$PreviouslyTestedPositive)
# define rules for each question (some can be left blank, others not)
if(is.null(input$SeroTestName)){
print ("Test name not filled")
data_SeroTestName<-NA}
else{
print ("Test name OK")
data_SeroTestName<-input$SeroTestName}
if(input$SeroTestNameSpecified==""){
print ("Test name not specified, OK")
data_SeroTestNameSpecified<-"AllowedEmptyField"}
else{
print ("Test name OK")
data_SeroTestNameSpecified<-input$SeroTestNameSpecified}
if(is.null(input$SeroTestOutcome)){
print ("SeroTestOutcome not filled")
data_SeroTestOutcome<-NA}
else{
print ("SeroTestOutcome OK")
data_SeroTestOutcome<-input$SeroTestOutcome}
if(input$PreviouslyTestedPositive=="If yes specify test"){
print ("Previously Tested Positive not specified, OK")
data_PreviouslyTestedPositive<-"AllowedEmptyField"}
else{
print ("Specify Tested Positive OK")
data_PreviouslyTestedPositive<-input$PreviouslyTestedPositive}
if(is.null(input$gender)){
print ("Gender not filled")
data_gender<-NA}
else{
print ("Gender OK")
data_gender<-input$gender}
if(is.na(input$age)){
print ("Age not filled")
data_age<-NA}
else{
print ("Age OK")
data_age<-input$age}
if(input$MedicalCondition=="separated by comma"){
print ("Medical condition not specified, OK")
data_MedicalCondition<-"AllowedEmptyField"}
else{
print ("Medical condition OK")
data_MedicalCondition<-input$MedicalCondition}
if(is.null(input$LivingArea)){
print ("LivingArea not filled")
data_LivingArea<-NA}
else{
print ("Living Area OK")
data_LivingArea<-input$LivingArea}
if(input$ZIP=="Enter ZIP code"){
print ("ZIP not filled")
data_ZIP<-NA}
else{
print ("ZIP OK")
data_ZIP<-input$ZIP}
if(is.null(input$UseMask)){
print ("UseMask not filled")
data_UseMask<-NA}
else{
print ("UseMask OK")
data_UseMask<-input$UseMask}
if(is.null(input$UseHandCleaner)){
print ("UseHandCleaner not filled")
data_UseHandCleaner<-NA}
else{
print ("UseHandCleaner OK")
data_UseHandCleaner<-input$UseHandCleaner}
if(is.null(input$RespectingRules)){
print ("RespectingRules not filled")
data_RespectingRules<-NA}
else{
print ("RespectingRules OK")
data_RespectingRules<-input$RespectingRules}
if(is.na(input$NumberFamilyContacts)){
print ("NumberFamilyContacts not filled")
data_NumberFamilyContacts<-NA}
else{
print ("NumberFamilyContacts OK")
data_NumberFamilyContacts<-input$NumberFamilyContacts}
if(is.na(input$NumberNonFamilyContacts)){
print ("NumberNonFamilyContacts not filled")
data_NumberNonFamilyContacts<-NA}
else{
print ("NumberNonFamilyContacts OK")
data_NumberNonFamilyContacts<-input$NumberNonFamilyContacts}
if(is.na(input$HoursAtHome)){
print ("HoursAtHome not filled")
data_HoursAtHome<-NA}
else{
print ("HoursAtHome OK")
data_HoursAtHome<-input$HoursAtHome}
if(is.null(input$Mobility)){
print ("Mobility not filled")
data_Mobility<-NA}
else{
print ("Mobility OK")
data_Mobility<-input$Mobility}
if(is.null(input$Homeworking)){
print ("Homeworking not filled")
data_Homeworking<-NA}
else{
print ("Homeworking OK")
data_Homeworking<-input$Homeworking}
if(is.null(input$FurtherInvolvement)){
print ("FurtherInvolvement not filled")
data_FurtherInvolvement<-NA}
else{
print ("FurtherInvolvement OK")
data_FurtherInvolvement<-input$FurtherInvolvement}
if(input$ContactDetails==""){
print ("ContactDetails not specified, OK")
data_ContactDetails<-"AllowedEmptyField"}
else{
print ("ContactDetails OK")
data_ContactDetails<-input$ContactDetails}
data <- c(data_SeroTestName, data_SeroTestNameSpecified, data_SeroTestOutcome, data_PreviouslyTestedPositive,
data_gender, data_age, data_MedicalCondition, data_LivingArea, data_ZIP,
data_UseMask, data_UseHandCleaner, data_RespectingRules,
data_NumberFamilyContacts, data_NumberNonFamilyContacts, data_HoursAtHome,
data_Mobility, data_Homeworking, data_FurtherInvolvement, data_ContactDetails)
print(t(data))
# print(anyNA(data))
# function for random string plus time stamp
generate_random_tag <- function(n = 1) {
a <- do.call(paste0, replicate(5, sample(LETTERS, n, TRUE), FALSE))
paste0(a, sprintf("%04d", sample(9999, n, TRUE)), sample(LETTERS, n, TRUE),"-",format(Sys.time(), "%Y%m%d%H%M%S"))
}
# check if all questions have been answered
# number_of_questions <- 6 # <------------------- set this
# && length(data)==number_of_questions
if( anyNA(data) == FALSE){
print("Form submitted")
shinyjs::disable("submit") # disable submit button if all went well, so user does not create multiple copies
# output$outputText <- renderText("Form submitted, thank you.")
output$outputText <- renderText("Form submitted, thank you.")
data_file_name<-paste0("./data/data-",generate_random_tag(),".csv")
write.table(t(data), file = data_file_name,row.names=FALSE, col.names=FALSE, sep=",")
# print(t(data))
}else{
print("Form not completed.")
# output$outputText <- renderText("Form not completed")
output$outputText <- renderText("Form not completed. ")
}
#-------- save data in a csv row --------END
})
}
shinyApp(ui, server)
\ No newline at end of file
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