Añadido curvas de superviviencia
This commit is contained in:
+109
-5
@@ -8,6 +8,8 @@ library(ggbeeswarm)
|
|||||||
library(gtools)
|
library(gtools)
|
||||||
library(gridExtra)
|
library(gridExtra)
|
||||||
source("../../funcions.R")
|
source("../../funcions.R")
|
||||||
|
library(survminer)
|
||||||
|
library(survival)
|
||||||
|
|
||||||
# Define UI for application
|
# Define UI for application
|
||||||
ui <- fluidPage(
|
ui <- fluidPage(
|
||||||
@@ -34,6 +36,7 @@ ui <- fluidPage(
|
|||||||
sidebarPanel(
|
sidebarPanel(
|
||||||
fileInput(inputId = "file_analy", label = "Hoja de análisis", multiple = F),
|
fileInput(inputId = "file_analy", label = "Hoja de análisis", multiple = F),
|
||||||
selectInput(inputId = "vacc", "Experimento de Vacunación", selected = "No", choices = c("Sí","No")),
|
selectInput(inputId = "vacc", "Experimento de Vacunación", selected = "No", choices = c("Sí","No")),
|
||||||
|
sliderInput("cutoff", "Cutoff para Survival", min=100, max=1500, step=50, value=750),
|
||||||
checkboxInput("filter_stats","Filtrar Estadística")
|
checkboxInput("filter_stats","Filtrar Estadística")
|
||||||
),
|
),
|
||||||
mainPanel(
|
mainPanel(
|
||||||
@@ -42,6 +45,7 @@ ui <- fluidPage(
|
|||||||
h3('Cinéticas'),
|
h3('Cinéticas'),
|
||||||
plotOutput('cin_group'),
|
plotOutput('cin_group'),
|
||||||
plotOutput('cin_indiv'),
|
plotOutput('cin_indiv'),
|
||||||
|
plotOutput('survival', height="800px"),
|
||||||
h3('Estadística'),
|
h3('Estadística'),
|
||||||
verbatimTextOutput('stats'),
|
verbatimTextOutput('stats'),
|
||||||
tableOutput('tab_stats')
|
tableOutput('tab_stats')
|
||||||
@@ -248,7 +252,6 @@ server <- function(input, output) {
|
|||||||
if ("ID.tumor" %in% colnames(table)){table<-rename(table, "ID tumor"=`ID.tumor`)}
|
if ("ID.tumor" %in% colnames(table)){table<-rename(table, "ID tumor"=`ID.tumor`)}
|
||||||
# table[table$ID.tumor == "R","0"]<-NA
|
# table[table$ID.tumor == "R","0"]<-NA
|
||||||
col_nodays<-c("ID", "Cage","Group", "ID.animal","ID animal", "ID.tumor", "ID tumor", "TS","DPV", "Absorbance")
|
col_nodays<-c("ID", "Cage","Group", "ID.animal","ID animal", "ID.tumor", "ID tumor", "TS","DPV", "Absorbance")
|
||||||
print(grep(0, colnames(table)[!colnames(table) %in% col_nodays]))
|
|
||||||
if (length(grep(0, colnames(table)[!colnames(table) %in% col_nodays])) == 0){
|
if (length(grep(0, colnames(table)[!colnames(table) %in% col_nodays])) == 0){
|
||||||
table["0"]<-0
|
table["0"]<-0
|
||||||
}
|
}
|
||||||
@@ -327,6 +330,54 @@ server <- function(input, output) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
})
|
})
|
||||||
|
|
||||||
|
output$survival<-renderPlot({
|
||||||
|
if (!is.null(input$file_analy) & !is.null(analysis$taula_def)){
|
||||||
|
observeEvent(analysis$taula_def, {})
|
||||||
|
table<-analysis$taula_def
|
||||||
|
if (input$vacc == "Sí"){
|
||||||
|
g<-list()
|
||||||
|
for (side in c("L","R")){
|
||||||
|
tableR<-filter(table, `ID tumor` == side) %>% filter(!is.na(Volume))
|
||||||
|
endtime<-dcast(tableR %>% filter(Volume < cutoff), Cage+`ID animal`+`ID tumor`+Group~., value.var = "Timepoint", fun.aggregate = function(x){max(as.numeric(as.character(x)))}) %>% rename("end"=".")
|
||||||
|
endtime["Dead"]<-dcast(tableR, Cage+`ID animal`+`ID tumor`+Group~., value.var = "Volume", fun.aggregate = function(x){max(as.numeric(as.character(x)))}) %>% pull(".") > input$cutoff
|
||||||
|
table_tumor<<-endtime
|
||||||
|
|
||||||
|
g[side]<-ggsurvplot(survfit(Surv(table_tumor$end, table_tumor$Dead) ~ table_tumor$Group, data=table_tumor),
|
||||||
|
pval = T, pval.method = T,
|
||||||
|
title = side,
|
||||||
|
# legend.labs = paste(c("< median", ">= median"), "MICA"),
|
||||||
|
ggtheme=theme_classic(base_size=15)
|
||||||
|
# conf.int = TRUE,
|
||||||
|
# Add risk table
|
||||||
|
# risk.table = TRUE,
|
||||||
|
# tables.height = 0.2,
|
||||||
|
# tables.theme = theme_cleantable(),
|
||||||
|
|
||||||
|
# Color palettes. Use custom color: c("#E7B800", "#2E9FDF"),
|
||||||
|
# or brewer color (e.g.: "Dark2"), or ggsci color (e.g.: "jco")
|
||||||
|
# palette = c("#E7B800", "#2E9FDF")
|
||||||
|
)
|
||||||
|
}
|
||||||
|
do.call(grid.arrange, g)
|
||||||
|
|
||||||
|
}else{
|
||||||
|
tableR<-table %>% filter(!is.na(Volume))
|
||||||
|
endtime<-dcast(tableR %>% filter(Volume < cutoff), `ID animal`+Group~., value.var = "Timepoint", fun.aggregate = function(x){max(as.numeric(as.character(x)))}) %>% rename("end"=".")
|
||||||
|
endtime["Dead"]<-dcast(tableR, `ID animal`+Group~., value.var = "Volume", fun.aggregate = function(x){max(as.numeric(as.character(x)))}) %>% pull(".") > input$cutoff
|
||||||
|
table_tumor<<-endtime
|
||||||
|
|
||||||
|
g<-ggsurvplot(survfit(Surv(table_tumor$end, table_tumor$Dead) ~ table_tumor$Group, data=table_tumor),
|
||||||
|
pval = T, pval.method = T,
|
||||||
|
# legend.labs = paste(c("< median", ">= median"), "MICA"),
|
||||||
|
ggtheme=theme_classic(base_size=15)
|
||||||
|
# palette = c("#E7B800", "#2E9FDF")
|
||||||
|
)
|
||||||
|
g
|
||||||
|
}
|
||||||
|
}
|
||||||
|
})
|
||||||
|
|
||||||
output$stats<-renderPrint({
|
output$stats<-renderPrint({
|
||||||
stattest<-"dunn"
|
stattest<-"dunn"
|
||||||
oneside<-""
|
oneside<-""
|
||||||
@@ -409,8 +460,7 @@ server <- function(input, output) {
|
|||||||
if (!is.null(input$file_analy) & !is.null(analysis$taula_def)){
|
if (!is.null(input$file_analy) & !is.null(analysis$taula_def)){
|
||||||
table<-analysis$taula_def
|
table<-analysis$taula_def
|
||||||
|
|
||||||
print(head(table))
|
if (input$fig_id %in% c("Cinética Grupo", "Cinética Individual")){
|
||||||
|
|
||||||
if (input$fig_id == "Cinética Grupo"){
|
if (input$fig_id == "Cinética Grupo"){
|
||||||
if (input$vacc == "Sí"){
|
if (input$vacc == "Sí"){
|
||||||
g<-ggplot(table, aes(as.numeric(as.character(Timepoint)), Volume, color=Group, group=Group))+
|
g<-ggplot(table, aes(as.numeric(as.character(Timepoint)), Volume, color=Group, group=Group))+
|
||||||
@@ -459,9 +509,58 @@ server <- function(input, output) {
|
|||||||
g<-g+scale_color_manual(values=v_col)+
|
g<-g+scale_color_manual(values=v_col)+
|
||||||
scale_fill_manual(values=v_col)
|
scale_fill_manual(values=v_col)
|
||||||
}
|
}
|
||||||
|
}else{
|
||||||
|
gg_color_hue <- function(n, l=65) {
|
||||||
|
hues <- seq(15, 375, length=n+1)
|
||||||
|
hcl(h=hues, l=l, c=100)[1:n]
|
||||||
|
}
|
||||||
|
if (input$vacc == "Sí"){
|
||||||
|
g<-list()
|
||||||
|
count<-1
|
||||||
|
for (side in c("L","R")){
|
||||||
|
tableR<-filter(table, `ID tumor` == side) %>% filter(!is.na(Volume))
|
||||||
|
endtime<-dcast(tableR %>% filter(Volume < cutoff), Cage+`ID animal`+`ID tumor`+Group~., value.var = "Timepoint", fun.aggregate = function(x){max(as.numeric(as.character(x)))}) %>% rename("end"=".")
|
||||||
|
endtime["Dead"]<-dcast(tableR, Cage+`ID animal`+`ID tumor`+Group~., value.var = "Volume", fun.aggregate = function(x){max(as.numeric(as.character(x)))}) %>% pull(".") > input$cutoff
|
||||||
|
table_tumor<<-endtime
|
||||||
|
if (input$colors != ""){
|
||||||
|
col<-input$colors
|
||||||
|
}else{
|
||||||
|
col<-gg_color_hue(length(unique(endtime$Group)))
|
||||||
|
}
|
||||||
|
g[[count]]<-ggsurvplot(survfit(Surv(table_tumor$end, table_tumor$Dead) ~ table_tumor$Group, data=table_tumor),
|
||||||
|
pval = T, pval.method = T,
|
||||||
|
title = side,
|
||||||
|
# legend.labs = paste(c("< median", ">= median"), "MICA"),
|
||||||
|
ggtheme=theme_classic(base_size=input$`font-size`),
|
||||||
|
palette = col
|
||||||
|
)
|
||||||
|
count<-count+1
|
||||||
|
}
|
||||||
|
g_surv_vacc<-g
|
||||||
|
|
||||||
|
}else{
|
||||||
|
if (input$colors != ""){
|
||||||
|
col<-input$colors
|
||||||
|
}else{
|
||||||
|
col<-gg_color_hue(length(unique(table_tumor$Group)))
|
||||||
|
}
|
||||||
|
g<-ggsurvplot(survfit(Surv(table_tumor$end, table_tumor$Dead) ~ table_tumor$Group, data=table_tumor),
|
||||||
|
pval = T, pval.method = T,
|
||||||
|
# legend.labs = paste(c("< median", ">= median"), "MICA"),
|
||||||
|
ggtheme=theme_classic(base_size=input$`font-size`),
|
||||||
|
palette = col
|
||||||
|
)
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
if (input$vacc == "Sí" & input$fig_id == "Survival"){
|
||||||
|
dades$plot<<-g_surv_vacc
|
||||||
|
arrange_ggsurvplots(g, nrow=2, ncol=1)
|
||||||
|
}else{
|
||||||
dades$plot<<-g
|
dades$plot<<-g
|
||||||
g
|
g
|
||||||
}
|
}
|
||||||
|
}
|
||||||
}, res=72)
|
}, res=72)
|
||||||
|
|
||||||
output$downloadPicture <- downloadHandler(
|
output$downloadPicture <- downloadHandler(
|
||||||
@@ -469,11 +568,16 @@ server <- function(input, output) {
|
|||||||
paste("Figura", ".png", sep="")
|
paste("Figura", ".png", sep="")
|
||||||
},
|
},
|
||||||
content = function(file){
|
content = function(file){
|
||||||
print(file)
|
|
||||||
# tempReport <- file.path(tempdir(), "elispots.Rmd")
|
# tempReport <- file.path(tempdir(), "elispots.Rmd")
|
||||||
# file.copy("elispots.Rmd", tempReport, overwrite = TRUE)
|
# file.copy("elispots.Rmd", tempReport, overwrite = TRUE)
|
||||||
png(file, width = input$width, height=input$height, units = "px", res=720)
|
png(file, width = input$width, height=input$height, units = "px", res=720)
|
||||||
plot(dades$plot)
|
if (input$fig_id == "Survival"){
|
||||||
|
if (input$vacc == "Sí"){
|
||||||
|
arrange_ggsurvplots(dades$plot, nrow=2, ncol=1)
|
||||||
|
}else{
|
||||||
|
arrange_ggsurvplots(list(dades$plot), ncol=1)
|
||||||
|
}
|
||||||
|
}else{plot(dades$plot)}
|
||||||
dev.off()
|
dev.off()
|
||||||
|
|
||||||
})
|
})
|
||||||
|
|||||||
Reference in New Issue
Block a user