From 35a73598d3ae13e71e18c988e6a31d01ba145586 Mon Sep 17 00:00:00 2001 From: marcelcosta Date: Thu, 16 Feb 2023 12:42:42 +0100 Subject: [PATCH] =?UTF-8?q?Adaptado=20la=20normalizaci=C3=B3n=20a=20nuevo?= =?UTF-8?q?=20formato.=20Se=20puede=20indicar=20el=20d=C3=ADa=20a=20normal?= =?UTF-8?q?izar.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- invivos/app.R | 127 +++++++++++++++++++++++++------------------------- 1 file changed, 64 insertions(+), 63 deletions(-) diff --git a/invivos/app.R b/invivos/app.R index fb95038..d38bfaa 100755 --- a/invivos/app.R +++ b/invivos/app.R @@ -26,6 +26,7 @@ ui <- fluidPage( uiOutput('ncages'), uiOutput('ntumors'), # selectInput(inputId = "measure_sys", "Sistema de medida", selected = "L-W-D", choices = c("L-W-D","Min-Max","Absorbance")), + uiOutput('day_vol'), uiOutput('lowcut'), uiOutput('upcut'), uiOutput('goButton'), @@ -103,22 +104,29 @@ server <- function(input, output) { dades$db<-NULL observe({ if (!is.null(input$file_sizes)){ - taula<-read.xlsx(input$file_sizes$datapath, sheet = 1, sep.names = " ") - if ("DPV" %in% colnames(taula)){ - taula<-dcast(taula, Cage+`ID animal`+`ID tumor`+Group~DPV, value.var = "0") - # taula$Major<-taula$Major/1000 - # taula$Minor<-taula$Minor/1000 - # taula["Volume"]<-((taula$Major*taula$Minor*taula$Minor)*(pi/6))*1000 - taula$Major<-taula$Major - taula$Minor<-taula$Minor - taula["Volume"]<-((taula$Major*taula$Minor*taula$Minor)*(pi/6)) + table<-read.xlsx(input$file_sizes$datapath, sheet = 1, check.names = F, sep.names = " ", detectDates = T,cols=1:11) + if("ID.animal" %in% colnames(table)){ + table<-table %>% + rename(Animal=`ID.animal`, Side=`ID.tumor`) + table<-table %>% gather(DayPostInoc, Value, which(!is.na(as.numeric(colnames(table))))) %>% + relocate(DayPostInoc, .before = Group) %>% spread(DPV, Value) %>% + rename(Long=Major, Wide=Minor) %>% + add_column(Date="", .after = "Animal") %>% + add_column(Weight="", .after="Group") %>% + add_column(Volume="",Observations="") %>% + relocate(Side, .after = "Group") + table$DayPostInoc<-as.numeric(table$DayPostInoc) } - if ("TS" %in% colnames(taula)){ - taula<-dcast(taula, Cage+`ID animal`+`ID tumor`+Group~TS, value.var = "0") - taula["Volume"]<-taula$`TS-Deep`*taula$`TS-Length`*taula$`TS-Width`*pi/6 + table$Date<-format(table$Date, format="%d/%m/%Y") + if ("sex" %in% colnames(table)){table<-select(table, -sex)} + for (i in 1:nrow(table)){ + long<-as.numeric(gsub(",",".",strsplit(as.character(table[i,"Long"]),"+", fixed = T)[[1]])) + wide<-as.numeric(gsub(",",".",strsplit(as.character(table[i,"Wide"]),"+", fixed = T)[[1]])) + table[i,"Volume"]<-sum(sapply(1:length(long), function(x) (long[x]*wide[x]*wide[x])*(pi/6))) } - dades$taula<-taula - dades$groups<-read.xlsx(input$file_sizes$datapath, sheet = 2, colNames=F)[,1] + table$Volume<-as.numeric(table$Volume) + dades$taula<-table + dades$groups<-read.xlsx(input$file_sizes$datapath, sheet = "Groups", colNames=F)[,1] if (readxl::excel_sheets(input$file_sizes$datapath) %>% length > 2){ dades$sex<-read.xlsx(input$file_sizes$datapath, sheet = 3, sep.names = " ") } @@ -127,7 +135,15 @@ server <- function(input, output) { output$firstPlot <- renderPlot({ observeEvent(dades$taula, {}) if (!is.null(dades$taula)){ - ggplot(dades$taula, aes(x="1", y=Volume))+geom_hline(yintercept = c(input$lowcut, input$upcut), color="red")+geom_quasirandom(width=0.2) + ggplot(dades$taula %>% filter(DayPostInoc == input$day_vol), aes(x="1", y=Volume))+ + geom_hline(yintercept = c(input$lowcut, input$upcut), color="red")+ + geom_quasirandom(width=0.2) + } + }) + + output$day_vol<-renderUI({ + if (!is.null(dades$taula)){ + selectInput("day_vol", "Día para volúmenes", choices = sort(unique(dades$taula$DayPostInoc))) } }) @@ -138,15 +154,17 @@ server <- function(input, output) { }) output$lowcut<-renderUI({ if (!is.null(dades$taula)){ - cut.max<-round(max(dades$taula$Volume, na.rm = T), 2) - step<-round(max(dades$taula$Volume, na.rm = T)/100, 2) + taula<-dades$taula %>% filter(DayPostInoc == input$day_vol) + cut.max<-round(max(taula$Volume, na.rm = T), 2) + step<-round(max(taula$Volume, na.rm = T)/100, 2) sliderInput("lowcut", "Corte inferior", min=0, max=cut.max, step=step, value=0) } }) output$upcut<-renderUI({ if (!is.null(dades$taula)){ - cut.max<-round(max(dades$taula$Volume, na.rm = T), 2)+0.01 - step<-round(max(dades$taula$Volume, na.rm = T)/20, 2) + taula<-dades$taula %>% filter(DayPostInoc == input$day_vol) + cut.max<-round(max(taula$Volume, na.rm = T), 2)+0.01 + step<-round(max(taula$Volume, na.rm = T)/20, 2) sliderInput("upcut", "Corte superior", min=0, max=cut.max, step=step, value=cut.max) } }) @@ -167,11 +185,12 @@ server <- function(input, output) { }) grafic<-eventReactive(input$goButton,{ - df<-dades$taula + df<-dades$taula %>% filter(DayPostInoc == input$day_vol) + print(df) df<-df[!is.na(df$Volume),] up_cuttof<-input$upcut low_cuttof<-input$lowcut - # print(up_cuttof) + df<-df[df$Volume < up_cuttof & df$Volume >= low_cuttof,] if (is.null(dades$sex)){ df<-add_column(df, sex="undefined") @@ -179,16 +198,14 @@ server <- function(input, output) { df<-merge(df, dades$sex) } - # df["Mouse"]<-gsub("[a-zA-Z]", "", df$MouseID) s<-shapiro.test(df$Volume)[[2]] ngroup<-length(dades$groups) df_def<-list() - # print(head(df)) + for (sex.var in unique(df$sex)){ - # print(sex.var) df_sex<-df %>% filter(`sex` == sex.var) ind.list<-list() pval.list<-list() @@ -197,8 +214,9 @@ server <- function(input, output) { for (data in 1:input$iterations){ interr=T while(interr == T){ - ind<-sample(rep(dades$groups, each=ceiling(length(unique(df_sex$`ID animal`))/ngroup)), length(unique(df_sex$`ID animal`))) - df_sex<-merge(df_sex[,c("ID animal", "ID tumor","Volume")], data.frame("ID animal"=unique(df_sex$`ID animal`), "group"=as.factor(ind),check.names=F)) + ind<-sample(rep(dades$groups, each=ceiling(length(unique(df_sex$Animal))/ngroup)), length(unique(df_sex$Animal))) + df_sex<-merge(df_sex[,c("Animal", "Side","Volume")], data.frame("Animal"=unique(df_sex$Animal), "group"=as.factor(ind),check.names=F)) + print(df_sex) if ((nrow(df_sex)/ngroup) %% 2 == 0){ interr<-any(table(df_sex$group) < floor(nrow(df_sex)/ngroup) | table(df_sex$group) > ceiling(nrow(df_sex)/ngroup)) }else{ @@ -206,7 +224,7 @@ server <- function(input, output) { interr<-diff(range(table(ind))) > 1 } } - ind.list[[data]]<-df_sex[,c("ID animal","ID tumor","group","Volume")] + ind.list[[data]]<-df_sex[,c("Animal","Side","group","Volume")] lvn.list[data]<-leveneTest(Volume ~ group, data = df_sex[,3:4])[[2]][1] if (s < 0.05){ k<-kruskal.test(df_sex$Volume,df_sex$group) @@ -229,23 +247,25 @@ server <- function(input, output) { df_def<-df_def %>% select(-"Group") } df_def<-merge( - if(!is.null(dades$sex)){merge(dades$taula, dades$sex)}else{dades$taula %>% add_column(sex="undefined")} %>% select(-Group), - df_def[,c("ID animal", "group")] %>% unique, all=T, by="ID animal") - if("DPV" %in% colnames(df_def)){df_def<-select(df_def, c(`ID animal`, `sex`,`ID tumor`, Volume, Cage, Major, Minor, group))} - if("TS-Deep" %in% colnames(df_def)){df_def<-select(df_def, c(`ID animal`, `sex`,`ID tumor`, Volume, Cage, `TS-Deep`,`TS-Length`,`TS-Width`, group))} + if(!is.null(dades$sex)){merge(dades$taula %>% filter(DayPostInoc == input$day_vol), dades$sex)}else{ + dades$taula %>% filter(DayPostInoc == input$day_vol) %>% add_column(sex="undefined")} %>% select(-Group), + df_def[,c("Animal", "group")] %>% unique, all=T, by="Animal") %>% rename(Group=group) + df_def<-select(df_def, Cage, Animal, Date, DayPostInoc, Group, Side, Weight, Long, Wide, Volume, Observations) + # if("DPV" %in% colnames(df_def)){df_def<-select(df_def, c(`ID animal`, `sex`,`ID tumor`, Volume, Cage, Major, Minor, group))} + # if("TS-Deep" %in% colnames(df_def)){df_def<-select(df_def, c(`ID animal`, `sex`,`ID tumor`, Volume, Cage, `TS-Deep`,`TS-Length`,`TS-Width`, group))} - df_def[!paste0(df_def$`ID animal`, df_def$`ID tumor`) %in% paste0(df$`ID animal`, df$`ID tumor`),"group"]<-NA + df_def[!paste0(df_def$Animal, df_def$Side) %in% paste0(df$Animal, df$Side),"Group"]<-NA dades$db<-df_def if (is.null(dades$sex)){ - ggplot(df_def, aes(group, Volume))+ + ggplot(df_def, aes(Group, Volume))+ geom_boxplot(outlier.alpha = F)+ geom_jitter(width=0.25)+ geom_point(stat="summary", color="blue", size=3)+ theme(axis.text.x = element_text(angle=90, hjust=1, vjust=0.5)) }else{ ggarrange( - ggplot(df_def, aes(group, Volume))+ + ggplot(df_def, aes(Group, Volume))+ geom_boxplot(outlier.alpha = F)+ geom_jitter(width=0.25, aes(color=sex))+ geom_point(stat="summary", color="blue", size=3)+ @@ -255,7 +275,7 @@ server <- function(input, output) { ggplot(df_def, aes(sex, Volume))+ geom_boxplot(outlier.alpha = F)+ geom_quasirandom(width=0.3), - ggplot(df_def, aes(group, fill=sex))+ + ggplot(df_def, aes(Group, fill=sex))+ geom_bar(stat="count", color="black", position="dodge")+ guides(fill="none")+ theme(axis.text.x = element_text(angle=90, hjust=1, vjust=0.5)), ncol = 1, heights = c(0.35, 0.65)), @@ -275,8 +295,8 @@ server <- function(input, output) { observeEvent(dades$db, {}) if (!is.null(dades$db)){ df<-dades$db - df_sum<-dcast(df, group~., value.var = "Volume", fun.aggregate = mean, na.rm=T) %>% rename("Mean"=".") - df_sum["SEM"]<-dcast(df, group~., value.var = "Volume", fun.aggregate = std.error, na.rm=T) %>% pull(`.`) + df_sum<-dcast(df, Group~., value.var = "Volume", fun.aggregate = mean, na.rm=T) %>% rename("Mean"=".") + df_sum["SEM"]<-dcast(df, Group~., value.var = "Volume", fun.aggregate = std.error, na.rm=T) %>% pull(`.`) df_sum } }) @@ -284,7 +304,7 @@ server <- function(input, output) { observeEvent(dades$db, {}) if (!is.null(dades$db)){ df<-dades$db - df %>% arrange(group) + df %>% arrange(Group) } }) @@ -300,31 +320,12 @@ server <- function(input, output) { # timepoint<-c(7,10,13,16,19,22,25) if (!is.null(input$file_sizes)){ - # dtemplate<-dades$db %>% select(-Volume,-sex) - # dtemplate<-melt(dtemplate, id=c("Cage", "ID animal", "ID tumor", "group"), variable.name = "DPV", value.name = "0") %>% rename("Group"="group") - # dtemplate<-dtemplate[,c("Cage", "ID animal", "ID tumor", "Group", "DPV", "0")] %>% arrange(`ID animal`, `ID tumor`) - # template<-expand.grid(dades$db$MouseID, timepoint) - # colnames(template)<-c("MouseID", "Timepoint") - # template<-template[order(template$Timepoint, template$MouseID),] - # template<-merge(template, dades$db[c("MouseID", "group")]) - # if (input$measure_sys == "L-W-D"){ - # template<-rbind(template, template, template) - # template<-template[order(template$Timepoint, template$MouseID),] - # template["TS"]<-rep(c("TS-Length", "TS-Width", "TS-Deep"), nrow(template)/3) - # dtemplate<-dcast(template, MouseID+group+TS~Timepoint) - # dtemplate<-dtemplate[mixedorder(as.character(dtemplate$MouseID)),] - # } - # if (input$measure_sys == "Min-Max"){ - # template<-rbind(template, template) - # template<-template[order(template$Timepoint, template$MouseID),] - # template["DPV"]<-rep(c("Major", "Minor"), nrow(template)/2) - # dtemplate<-dcast(template, MouseID+group+DPV~Timepoint) - # dtemplate<-dtemplate[mixedorder(as.character(dtemplate$MouseID)),] - # } - # dtemplate<-dtemplate %>% add_column(.after="MouseID", "ID tumor"=dtemplate$MouseID)%>% rename(`ID animal`=MouseID) - # dtemplate["ID tumor"]<-gsub("[[:digit:]]","",dtemplate$`ID tumor`) - # dtemplate["ID animal"]<-gsub("[LR]","",dtemplate$`ID animal`) - # dtemplate[,5:ncol(dtemplate)]<-"" + template<-dades$db %>% filter(!is.na(Group)) %>% + select(Animal, Group) %>% unique() + dtemplate<-merge(dades$taula %>% select(-Group), template) %>% + arrange(DayPostInoc, Animal, Side) %>% + select(Cage, Animal, Date, DayPostInoc, Group, Side, + Weight, Long, Wide, Volume, Observations) }else{ template<-data.frame(