marcelcosta/invivos
1
0
Fork 0
Code Issues 3 Pull Requests Projects Releases Wiki Activity

Incorporado el equilibrio entre sexos.

Browse Source
This commit is contained in:
Costa
2022-02-23 09:45:48 +01:00
parent f53d7b564c
commit a8f12acdfb
1 changed files with 54 additions and 32 deletions
Download Patch File Download Diff File Expand all files Collapse all files
invivos/app.R
+38 -16
View File
@@ -88,6 +88,7 @@ server <- function(input, output) {
dades<-reactiveValues()
dades$taula<-NULL
dades$groups<-NULL
dades$sex<-NULL
dades$db<-NULL
observe({
if (!is.null(input$file_sizes)){
@@ -103,6 +104,7 @@ server <- function(input, output) {
}
dades$taula<-taula
dades$groups<-read.xlsx(input$file_sizes$datapath, sheet = 2)[,1]
dades$sex<-read.xlsx(input$file_sizes$datapath, sheet = 3, sep.names = " ")
}
})
output$firstPlot <- renderPlot({
@@ -148,13 +150,18 @@ server <- function(input, output) {
low_cuttof<-input$lowcut
print(up_cuttof)
df<-df[df$Volume < up_cuttof & df$Volume >= low_cuttof,]
df<-merge(df, dades$sex)
# df["Mouse"]<-gsub("[a-zA-Z]", "", df$MouseID)
print(df$Volume)
s<-shapiro.test(df$Volume)[[2]]
ngroup<-length(dades$groups)
df_def<-list()
print(head(df))
for (sex.var in c("male","female")){
print(sex.var)
df_sex<-df %>% filter(`sex` == sex.var)
ind.list<-list()
pval.list<-list()
lvn.list<-list()
@@ -162,42 +169,57 @@ 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$`ID animal`))/ngroup)), length(unique(df$`ID animal`)))
df_temp<-merge(df[,c("ID animal", "ID tumor","Volume")], data.frame("ID animal"=unique(df$`ID animal`), "group"=as.factor(ind),check.names=F))
if ((nrow(df_temp)/ngroup) %% 2 == 0){
interr<-any(table(df_temp$group) < floor(nrow(df_temp)/ngroup) | table(df_temp$group) > ceiling(nrow(df_temp)/ngroup))
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))
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{
# interr<-any(table(df_temp$group) < (floor(nrow(df_temp)/ngroup)-1) | table(df_temp$group) > (ceiling(nrow(df_temp)/ngroup)+1))
# interr<-any(table(df_sex$group) < (floor(nrow(df_sex)/ngroup)-1) | table(df_sex$group) > (ceiling(nrow(df_sex)/ngroup)+1))
interr<-diff(range(table(ind))) > 1
}
}
ind.list[[data]]<-df_temp[,c("ID animal", "ID tumor","group","Volume")]
lvn.list[data]<-leveneTest(Volume ~ group, data = df_temp[,3:4])[[2]][1]
ind.list[[data]]<-df_sex[,c("ID animal","ID tumor","group","Volume")]
lvn.list[data]<-leveneTest(Volume ~ group, data = df_sex[,3:4])[[2]][1]
if (s < 0.05){
k<-kruskal.test(df_temp$Volume,df_temp$group)
k<-kruskal.test(df_sex$Volume,df_sex$group)
test.list[data]<-k[[1]][1]
pval.list[data]<-k[[3]][1]
}else{
res.aov<-aov(Volume~group, data=df_temp)
res.aov<-aov(Volume~group, data=df_sex)
pval.list[data]<-summary(res.aov)[[1]][[5]][1]
test.list[data]<-summary(res.aov)[[1]][[4]][1]
}
}
index<-which(unlist(lvn.list) == min(unlist(lvn.list)[which(unlist(pval.list) %in% sort(unlist(pval.list), decreasing = T)[1:20])]))
df_def<-merge(df, ind.list[[index]])
print(df_sex)
df_def[[sex.var]]<-merge(df_sex %>% select(-group), ind.list[[index]])
}
# df_def<-do.call(rbind, c(df_def, make.row.names=F))
# lapply(df_def, function(x) x %>% as_tibble %>% print(n=Inf))
df_def<-rbind(df_def[[1]], df_def[[2]], make.row.names=F)
if ("Group" %in% colnames(df_def)){
df_def<-df_def %>% select(-"Group")
}
df_def<-merge(dades$taula %>% select(-Group), df_def[,c("ID animal", "group")] %>% unique, all=T, by="ID animal") %>% select(c(`ID animal`, `ID tumor`, Volume, Cage, Major, Minor, group))
df_def<-merge(merge(dades$taula, dades$sex) %>% select(-Group), df_def[,c("ID animal", "group")] %>% unique, all=T, by="ID animal") %>% select(c(`ID animal`, `sex`,`ID tumor`, Volume, Cage, Major, Minor, group))
df_def[!paste0(df_def$`ID animal`, df_def$`ID tumor`) %in% paste0(df$`ID animal`, df$`ID tumor`),"group"]<-NA
dades$db<-df_def
ggarrange(
ggplot(df_def, aes(group, Volume))+
geom_boxplot(outlier.alpha = F)+
geom_jitter(width=0.25)+
geom_point(stat="summary", color="blue", size=3)
geom_jitter(width=0.25, aes(color=sex))+
geom_point(stat="summary", color="blue", size=3)+
theme(axis.text.x = element_text(angle=90, hjust=1, vjust=0.5)),
# lims(y=c(0,max(df_def$Volume)+10))
ggarrange(
ggplot(df_def, aes(sex, Volume))+
geom_boxplot(outlier.alpha = F)+
geom_quasirandom(width=0.3),
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)),
nrow = 1, aligh="h", widths = c(0.65, 0.35))
})
output$distPlot <- renderPlot({
observeEvent(dades$taula, {})
@@ -295,7 +317,7 @@ server <- function(input, output) {
analysis$taula_vol<-NULL
observe({
if (!is.null(input$file_analy)){
analysis$taula<-read.xlsx(input$file_analy$datapath, sheet = 1, check.names = F, sep.names = " ")
analysis$taula<-read.xlsx(input$file_analy$datapath, sheet = 1, check.names = F, sep.names = " ") %>% select(-sex)
}
})
output$cutoffUI<-renderUI({