Incorporado el equilibrio entre sexos.
This commit is contained in:
+38
-16
@@ -88,6 +88,7 @@ server <- function(input, output) {
|
|||||||
dades<-reactiveValues()
|
dades<-reactiveValues()
|
||||||
dades$taula<-NULL
|
dades$taula<-NULL
|
||||||
dades$groups<-NULL
|
dades$groups<-NULL
|
||||||
|
dades$sex<-NULL
|
||||||
dades$db<-NULL
|
dades$db<-NULL
|
||||||
observe({
|
observe({
|
||||||
if (!is.null(input$file_sizes)){
|
if (!is.null(input$file_sizes)){
|
||||||
@@ -103,6 +104,7 @@ server <- function(input, output) {
|
|||||||
}
|
}
|
||||||
dades$taula<-taula
|
dades$taula<-taula
|
||||||
dades$groups<-read.xlsx(input$file_sizes$datapath, sheet = 2)[,1]
|
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({
|
output$firstPlot <- renderPlot({
|
||||||
@@ -148,13 +150,18 @@ server <- function(input, output) {
|
|||||||
low_cuttof<-input$lowcut
|
low_cuttof<-input$lowcut
|
||||||
print(up_cuttof)
|
print(up_cuttof)
|
||||||
df<-df[df$Volume < up_cuttof & df$Volume >= low_cuttof,]
|
df<-df[df$Volume < up_cuttof & df$Volume >= low_cuttof,]
|
||||||
|
df<-merge(df, dades$sex)
|
||||||
|
|
||||||
# df["Mouse"]<-gsub("[a-zA-Z]", "", df$MouseID)
|
# df["Mouse"]<-gsub("[a-zA-Z]", "", df$MouseID)
|
||||||
print(df$Volume)
|
print(df$Volume)
|
||||||
s<-shapiro.test(df$Volume)[[2]]
|
s<-shapiro.test(df$Volume)[[2]]
|
||||||
|
|
||||||
ngroup<-length(dades$groups)
|
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()
|
ind.list<-list()
|
||||||
pval.list<-list()
|
pval.list<-list()
|
||||||
lvn.list<-list()
|
lvn.list<-list()
|
||||||
@@ -162,42 +169,57 @@ server <- function(input, output) {
|
|||||||
for (data in 1:input$iterations){
|
for (data in 1:input$iterations){
|
||||||
interr=T
|
interr=T
|
||||||
while(interr == T){
|
while(interr == T){
|
||||||
ind<-sample(rep(dades$groups, each=ceiling(length(unique(df$`ID animal`))/ngroup)), length(unique(df$`ID animal`)))
|
ind<-sample(rep(dades$groups, each=ceiling(length(unique(df_sex$`ID animal`))/ngroup)), length(unique(df_sex$`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))
|
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_temp)/ngroup) %% 2 == 0){
|
if ((nrow(df_sex)/ngroup) %% 2 == 0){
|
||||||
interr<-any(table(df_temp$group) < floor(nrow(df_temp)/ngroup) | table(df_temp$group) > ceiling(nrow(df_temp)/ngroup))
|
interr<-any(table(df_sex$group) < floor(nrow(df_sex)/ngroup) | table(df_sex$group) > ceiling(nrow(df_sex)/ngroup))
|
||||||
}else{
|
}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
|
interr<-diff(range(table(ind))) > 1
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
ind.list[[data]]<-df_temp[,c("ID animal", "ID tumor","group","Volume")]
|
ind.list[[data]]<-df_sex[,c("ID animal","ID tumor","group","Volume")]
|
||||||
lvn.list[data]<-leveneTest(Volume ~ group, data = df_temp[,3:4])[[2]][1]
|
lvn.list[data]<-leveneTest(Volume ~ group, data = df_sex[,3:4])[[2]][1]
|
||||||
if (s < 0.05){
|
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]
|
test.list[data]<-k[[1]][1]
|
||||||
pval.list[data]<-k[[3]][1]
|
pval.list[data]<-k[[3]][1]
|
||||||
}else{
|
}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]
|
pval.list[data]<-summary(res.aov)[[1]][[5]][1]
|
||||||
test.list[data]<-summary(res.aov)[[1]][[4]][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])]))
|
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)){
|
if ("Group" %in% colnames(df_def)){
|
||||||
df_def<-df_def %>% select(-"Group")
|
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
|
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
|
dades$db<-df_def
|
||||||
|
|
||||||
|
ggarrange(
|
||||||
ggplot(df_def, aes(group, Volume))+
|
ggplot(df_def, aes(group, Volume))+
|
||||||
geom_boxplot(outlier.alpha = F)+
|
geom_boxplot(outlier.alpha = F)+
|
||||||
geom_jitter(width=0.25)+
|
geom_jitter(width=0.25, aes(color=sex))+
|
||||||
geom_point(stat="summary", color="blue", size=3)
|
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))
|
# 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({
|
output$distPlot <- renderPlot({
|
||||||
observeEvent(dades$taula, {})
|
observeEvent(dades$taula, {})
|
||||||
@@ -295,7 +317,7 @@ server <- function(input, output) {
|
|||||||
analysis$taula_vol<-NULL
|
analysis$taula_vol<-NULL
|
||||||
observe({
|
observe({
|
||||||
if (!is.null(input$file_analy)){
|
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({
|
output$cutoffUI<-renderUI({
|
||||||
|
|||||||
Reference in New Issue
Block a user