Migration of apps from ENIGMAtrial_R rep

This commit is contained in:
AG Damsbo 2022-08-19 10:30:10 +02:00
parent 2e1f38c26e
commit 0419959343
13 changed files with 532 additions and 0 deletions

BIN
apps/.DS_Store vendored Normal file

Binary file not shown.

View File

@ -0,0 +1,37 @@
## -----------------------------------------------------------------------------
## Cognitive Index app
## -----------------------------------------------------------------------------
##
## This app is created to demonstrate the index-lookup of a certain cognitive test.
## The results a provided with no responsibility of validity.
## Do not upload sensitive data when using the app.
##
## /AG Damsbo
##
## -- START WITH THIS -- ##
old_wd<-getwd()
setwd(paste0(old_wd,"/apps/Index app"))
shiny::runApp()
source(paste0(old_wd,"/apps/app_deploy.R"))
setwd(old_wd)
## Poor mans changelog
## 18aug2022 Its alive!!
## https://cognitiveindex.shinyapps.io/index_app/
## 19aug2022
## Now live with a choice between single entry or file upload, and download option for results in both cases.
## Wishlist:
## - Still missing is a better labelling, however this works for now.
##
## Sources:
## - How about uploading dataset? https://shiny.rstudio.com/articles/upload.html
## - And then download: https://shiny.rstudio.com/articles/download.html
##
## Now moved to my PhysicalActivityandStrokeOutcome-repository.

22
apps/HWE Calc test app.R Normal file
View File

@ -0,0 +1,22 @@
## -----------------------------------------------------------------------------
## HWE Calc test app deployment
## -----------------------------------------------------------------------------
##
## This app was written as proof of concept for my Research year program,
## as no online calculators were found to calculate the
## Hardy-Weinberg-equilibrium of allele distributions.
##
## Source: https://raw.githubusercontent.com/agdamsbo/daDoctoR/master/R/hwe_geno.R
##
## /AG Damsbo
##
old_wd<-getwd()
setwd(paste0(old_wd,"/apps/HWE Calc"))
shiny::runApp()
source(paste0(old_wd,"/apps/app_deploy.R"))
setwd(old_wd)

View File

@ -0,0 +1,11 @@
name: hwe_calc
title:
username:
account: cognitiveindex
server: shinyapps.io
hostUrl: https://api.shinyapps.io/v1
appId: 6803322
bundleId: 6213208
url: https://cognitiveindex.shinyapps.io/hwe_calc/
when: 1660807491.6397
lastSyncTime: 1660807491.63971

69
apps/HWE Calc/server.R Normal file
View File

@ -0,0 +1,69 @@
server <- function(input, output, session) {
cale <- reactive({
as.numeric(input$ale)
})
dat<-reactive({
df<-data.frame(lbls=c("MM","MN","NN","MO","NO","OO"),
value=rbind(input$mm,input$mn,input$nn,input$mo,input$no,input$oo),
stringsAsFactors = FALSE)
print(df)
df
})
cmm <- reactive({
as.numeric(input$mm)
})
cmn <- reactive({
as.numeric(input$mn)
})
cnn <- reactive({
as.numeric(input$nn)
})
cmo <- reactive({
as.numeric(input$mo)
})
cno <- reactive({
as.numeric(input$no)
})
coo <- reactive({
as.numeric(input$oo)
})
hwe_p <- function() ({ hwe_geno(cmm(),cmn(),cnn(),cmo(),cno(),coo(),alleles=cale()) })
output$allele.tbl <- renderTable({ hwe_p()$allele.dist })
output$obs.tbl <- renderTable({ hwe_p()$observed.dist })
output$exp.tbl <- renderTable({ hwe_p()$expected.dist })
output$chi.val <- renderTable({ hwe_p()$chi.value })
output$p.val <- renderTable({ hwe_p()$p.value })
output$allele.dist <- renderText({"Allele distribution"})
output$obs.dist <- renderText({"Observed distribution"})
output$exp.dist <- renderText({"Expected distribution"})
output$chi <- renderText({"Chi square value"})
output$p <- renderText({"P value"})
output$geno.pie.plt<- renderPlot({
ggplot(dat(), aes(x="", y=value, fill=lbls))+
geom_bar(width = 1, stat = "identity")+
coord_polar("y", start=0)+
scale_fill_brewer(palette="Dark2")
})
output$geno.pie.ttl <- renderText({"Genotype distribution"})
}

85
apps/HWE Calc/ui.R Normal file
View File

@ -0,0 +1,85 @@
source("https://raw.githubusercontent.com/agdamsbo/daDoctoR/master/R/hwe_geno.R")
library(shiny)
library(ggplot2)
ui <- fluidPage(
# Application title
titlePanel("Chi square test of HWE for bi- or triallelic systems"),
sidebarLayout(
sidebarPanel(
# Input: Numeric entry for number of alleles ----
radioButtons(inputId = "ale",
label = "Number of alleles:",
inline = FALSE,
choiceNames=c("Two alleles (M, N)",
"Three alleles (M, N, O)"),
choiceValues=c(2,3)),
h4("Observed genotype distribution"),
numericInput(inputId = "mm",
label = "MM:",
value=NA),
numericInput(inputId = "mn",
label = "MN:",
value=NA),
numericInput(inputId = "nn",
label = "NN:",
value=NA),
conditionalPanel(condition = "input.ale==3",
numericInput(inputId = "mo",
label = "MO:",
value=NA),
numericInput(inputId = "no",
label = "NO:",
value=NA),
numericInput(inputId = "oo",
label = "OO:",
value=NA))
),
mainPanel(
tabsetPanel(
tabPanel("Summary",
h3(textOutput("obs.dist", container = span)),
htmlOutput("obs.tbl", container = span),
h3(textOutput("exp.dist", container = span)),
htmlOutput("exp.tbl", container = span),
h3(textOutput("allele.dist", container = span)),
htmlOutput("allele.tbl", container = span),
value=1),
tabPanel("Calculations",
h3(textOutput("chi", container = span)),
htmlOutput("chi.val", container = span),
h3(textOutput("p", container = span)),
htmlOutput("p.val", container = span),
value=2),
tabPanel("Plots",
h3(textOutput("geno.pie.ttl", container = span)),
plotOutput("geno.pie.plt"),
value=3),
selected= 2, type = "tabs")
)
)
)

View File

@ -0,0 +1,11 @@
name: index_app
title:
username:
account: cognitiveindex
server: shinyapps.io
hostUrl: https://api.shinyapps.io/v1
appId: 6803928
bundleId: 6217041
url: https://cognitiveindex.shinyapps.io/index_app/
when: 1660896651.6136
lastSyncTime: 1660896651.61362

View File

@ -0,0 +1,22 @@
# Samlpe data from data base
source("https://raw.githubusercontent.com/agdamsbo/ENIGMAtrial_R/main/src/redcap_api_export_short.R")
df<-redcap_api_export_short(id= c(40:45),
instruments= "rbans",
event= "3_months_arm_1") %>%
select(c("record_id",ends_with(c("_version","_age","_rs")))) %>%
na.omit()|>
rbind(redcap_api_export_short(id= c(10:15),
instruments= "rbans",
event= "12_months_arm_1") %>%
select(c("record_id",ends_with(c("_version","_age","_rs")))) %>%
na.omit())
colnames(df)<-c("record_id","ab","age","imm","vis","ver","att","del")
df$record_id<-1:nrow(df)
df$age<-sample(-2:2,nrow(df),TRUE)+df$age
write.csv(df, "sample.csv", row.names = FALSE)

13
apps/Index app/sample.csv Normal file
View File

@ -0,0 +1,13 @@
"record_id","ab","age","imm","vis","ver","att","del"
1,1,67,26,31,24,42,38
2,1,69,34,31,27,40,34
3,1,63,43,35,29,46,38
4,1,66,45,37,30,54,40
5,1,66,44,34,33,54,44
6,1,83,39,34,23,37,31
7,2,71,49,37,24,52,42
8,2,81,33,30,39,47,42
9,2,61,50,38,36,52,56
10,2,88,32,20,26,13,30
11,2,73,36,28,22,34,33
12,2,89,22,30,21,29,30
1 record_id ab age imm vis ver att del
2 1 1 67 26 31 24 42 38
3 2 1 69 34 31 27 40 34
4 3 1 63 43 35 29 46 38
5 4 1 66 45 37 30 54 40
6 5 1 66 44 34 33 54 44
7 6 1 83 39 34 23 37 31
8 7 2 71 49 37 24 52 42
9 8 2 81 33 30 39 47 42
10 9 2 61 50 38 36 52 56
11 10 2 88 32 20 26 13 30
12 11 2 73 36 28 22 34 33
13 12 2 89 22 30 21 29 30

82
apps/Index app/server.R Normal file
View File

@ -0,0 +1,82 @@
server <- function(input, output, session) {
library(dplyr)
library(ggplot2)
library(tidyr)
source("https://raw.githubusercontent.com/agdamsbo/ENIGMAtrial_R/main/src/plot_index.R")
source("https://raw.githubusercontent.com/agdamsbo/ENIGMAtrial_R/main/src/index_from_raw.R")
dat<-reactive({
df<-data.frame(record_id="1",
ab=input$version,
age=input$age,
imm=input$rs1,
vis=input$rs2,
ver=input$rs3,
att=input$rs4,
del=input$rs5,
stringsAsFactors = FALSE)
return(df)
})
dat_u<-reactive({
# input$file1 will be NULL initially. After the user selects
# and uploads a file, head of that data file by default,
# or all rows if selected, will be shown.
req(input$file1)
df <- read.csv(input$file1$datapath,
header = input$header,
sep = input$sep,
quote = input$quote)
return(df)
})
dat_f<-reactive({
if (input$type==1){
return(dat())}
if (input$type==2){
return(head(dat_u(),10))}
})
index_p <- reactive({ index_from_raw(ds=dat_f(),
indx=read.csv("https://raw.githubusercontent.com/agdamsbo/ENIGMAtrial_R/main/data/index.csv"),
version = dat_f()$ab,
age = dat_f()$age,
raw_columns=c("imm","vis","ver","att","del")) })
output$ndx.tbl <- renderTable({
index_p()|>
select("id",contains("_is"))
})
output$per.tbl <- renderTable({
index_p()|>
select("id",contains("_per"))
})
output$ndx.plt<-renderPlot({
plot_index(index_p(),sub_plot = "_is")
})
output$per.plt<-renderPlot({
plot_index(index_p(),sub_plot = "_per")
})
# Downloadable csv of selected dataset ----
output$downloadData <- downloadHandler(
filename = "index_lookup.csv",
content = function(file) {
write.csv(index_p(), file, row.names = FALSE)
}
)
}

View File

@ -0,0 +1,18 @@
df<-data.frame(record_id="1",
imm=35,
vis=35,
ver=35,
att=35,
del=35,
stringsAsFactors = FALSE)
source("https://raw.githubusercontent.com/agdamsbo/ENIGMAtrial_R/main/src/index_from_raw.R")
df_c<-index_from_raw(ds=df,
indx=read.csv("https://raw.githubusercontent.com/agdamsbo/ENIGMAtrial_R/main/data/index.csv"),
version = "1",
age = 60,
raw_columns=c("imm","vis","ver","att","del"),
mani=TRUE)
plot_index(ds=df_c,id="id",sub_plot = "_is")

152
apps/Index app/ui.R Normal file
View File

@ -0,0 +1,152 @@
library(shiny)
library(ggplot2)
ui <- fluidPage(
## -----------------------------------------------------------------------------
## Application title
## -----------------------------------------------------------------------------
titlePanel("Calculating cognitive index scores in multidimensional testing.",
windowTitle = "Cognitive test index calculator"),
h5("Please note this calculator is only meant as a proof of concept for educational purposes,
and the author will take no responsibility for the results of the calculator.
Uploaded data is not kept, but please, do not upload any sensitive data."),
## -----------------------------------------------------------------------------
## Side panel
## -----------------------------------------------------------------------------
sidebarPanel(
h4("Test resultsData format"),
radioButtons(inputId = "type",
label = "Data type",
inline = FALSE,
choiceNames=c("Single entry",
"File upload (10 records)"),
choiceValues=c(1,2)),
# Horizontal line ----
tags$hr(),
## -----------------------------------------------------------------------------
## Single entry
## -----------------------------------------------------------------------------
conditionalPanel(condition = "input.type==1",
numericInput(inputId = "age",
label = "Age",
value=60),
radioButtons(inputId = "version",
label = "Test version (A/B)",
inline = FALSE,
choiceNames=c("A",
"B"),
choiceValues=c(1,2)),
numericInput(inputId = "rs1",
label = "Immediate memory",
value=35),
numericInput(inputId = "rs2",
label = "Visuospatial functions",
value=35),
numericInput(inputId = "rs3",
label = "Verbal functions",
value=30),
numericInput(inputId = "rs4",
label = "Attention",
value=35),
numericInput(inputId = "rs5",
label = "Delayed memory",
value=40)
),
## -----------------------------------------------------------------------------
## File upload
## -----------------------------------------------------------------------------
conditionalPanel(condition = "input.type==2",
# Input: Select a file ----
fileInput("file1", "Choose CSV File",
multiple = FALSE,
accept = c("text/csv",
"text/comma-separated-values,text/plain",
".csv")),
h6("Columns: record_id, ab, age, imm, vis, ver, att, del."),
# Horizontal line ----
tags$hr(),
# Input: Checkbox if file has header ----
checkboxInput("header", "Header", TRUE),
# Input: Select separator ----
radioButtons("sep", "Separator",
choices = c(Comma = ",",
Semicolon = ";",
Tab = "\t"),
selected = ","),
# Input: Select quotes ----
radioButtons("quote", "Quote",
choices = c(None = "",
"Double Quote" = '"',
"Single Quote" = "'"),
selected = '"'),
),
## -----------------------------------------------------------------------------
## Download output
## -----------------------------------------------------------------------------
# Horizontal line ----
tags$hr(),
h4("Download results"),
# Button
downloadButton("downloadData", "Download")
),
mainPanel(
tabsetPanel(
## -----------------------------------------------------------------------------
## Summary tab
## -----------------------------------------------------------------------------
tabPanel("Summary",
h3("Index Scores"),
htmlOutput("ndx.tbl", container = span),
h3("Percentiles"),
htmlOutput("per.tbl", container = span)
),
## -----------------------------------------------------------------------------
## Plots tab
## -----------------------------------------------------------------------------
tabPanel("Plots",
h3("Index Scores"),
plotOutput("ndx.plt"),
h3("Percentiles"),
plotOutput("per.plt")
)
)
)
)

10
apps/app_deploy.R Normal file
View File

@ -0,0 +1,10 @@
## Cognitive Index app deployment
require(rsconnect)
keys<-suppressWarnings(read.csv("/Users/au301842/shinyapp_token.csv",colClasses = "character"))
rsconnect::setAccountInfo(name='cognitiveindex',
token=keys$key[1], secret=keys$key[2])
deployApp()