añadir randomizado 1
This commit is contained in:
+47
-8
@@ -5,6 +5,7 @@ library(openxlsx)
|
|||||||
library(dplyr)
|
library(dplyr)
|
||||||
library(car)
|
library(car)
|
||||||
library(ggbeeswarm)
|
library(ggbeeswarm)
|
||||||
|
library(gtools)
|
||||||
source("../../funcions.R")
|
source("../../funcions.R")
|
||||||
|
|
||||||
# Define UI for application
|
# Define UI for application
|
||||||
@@ -17,9 +18,12 @@ ui <- fluidPage(
|
|||||||
fileInput(inputId = "file_sizes", label = "Hoja de tamaños", multiple = F),
|
fileInput(inputId = "file_sizes", label = "Hoja de tamaños", multiple = F),
|
||||||
selectInput(inputId = "measure_sys", "Sistema de medida", selected = "L-W-D", choices = c("L-W-D","Min-Max","Absorbance")),
|
selectInput(inputId = "measure_sys", "Sistema de medida", selected = "L-W-D", choices = c("L-W-D","Min-Max","Absorbance")),
|
||||||
sliderInput("ncages", "Cajas", min=1, max=10, value=1),
|
sliderInput("ncages", "Cajas", min=1, max=10, value=1),
|
||||||
|
sliderInput("iterations", "Iteraciones", min=100, max=2000, step=100, value=100),
|
||||||
downloadButton("downloadData", "Descargar Excel")
|
downloadButton("downloadData", "Descargar Excel")
|
||||||
),
|
),
|
||||||
|
mainPanel(
|
||||||
plotOutput("distPlot")
|
plotOutput("distPlot")
|
||||||
|
)
|
||||||
),
|
),
|
||||||
tabPanel("Análisis")
|
tabPanel("Análisis")
|
||||||
)
|
)
|
||||||
@@ -28,9 +32,20 @@ ui <- fluidPage(
|
|||||||
|
|
||||||
# Define server logic required to draw a histogram
|
# Define server logic required to draw a histogram
|
||||||
server <- function(input, output) {
|
server <- function(input, output) {
|
||||||
|
dades<-reactiveValues()
|
||||||
|
dades$taula<-NULL
|
||||||
|
dades$groups<-NULL
|
||||||
|
dades$db<-NULL
|
||||||
|
observe({
|
||||||
|
if (!is.null(input$file_sizes)){
|
||||||
|
dades$taula<-read.xlsx(input$file_sizes$datapath, sheet = 1)
|
||||||
|
dades$groups<-read.xlsx(input$file_sizes$datapath, sheet = 2)[,1]
|
||||||
|
}
|
||||||
|
})
|
||||||
output$distPlot <- renderPlot({
|
output$distPlot <- renderPlot({
|
||||||
df<-read.xlsx(input$file1$datapath)
|
observeEvent(dades$taula, {})
|
||||||
|
if (!is.null(dades$taula)){
|
||||||
|
df<-dades$taula
|
||||||
up_cuttof<-400
|
up_cuttof<-400
|
||||||
low_cuttof<-50
|
low_cuttof<-50
|
||||||
df<-df[df$Volumen < up_cuttof & df$Volumen > low_cuttof,]
|
df<-df[df$Volumen < up_cuttof & df$Volumen > low_cuttof,]
|
||||||
@@ -38,16 +53,16 @@ server <- function(input, output) {
|
|||||||
|
|
||||||
s<-shapiro.test(df$Volumen)[[2]]
|
s<-shapiro.test(df$Volumen)[[2]]
|
||||||
|
|
||||||
ngroup<-5
|
ngroup<-length(dades$groups)
|
||||||
|
|
||||||
ind.list<-list()
|
ind.list<-list()
|
||||||
pval.list<-list()
|
pval.list<-list()
|
||||||
lvn.list<-list()
|
lvn.list<-list()
|
||||||
test.list<-list()
|
test.list<-list()
|
||||||
for (data in 1:2000){
|
for (data in 1:input$iterations){
|
||||||
interr=T
|
interr=T
|
||||||
while(interr == T){
|
while(interr == T){
|
||||||
ind<-sample(rep(1:ngroup, each=7), length(unique(df$Mouse)))
|
ind<-sample(rep(dades$groups, each=7), length(unique(df$Mouse)))
|
||||||
df_temp<-merge(df, data.frame("Mouse"=unique(df$Mouse), "group"=as.factor(ind)))
|
df_temp<-merge(df, data.frame("Mouse"=unique(df$Mouse), "group"=as.factor(ind)))
|
||||||
interr<-any(table(df_temp$group) < floor(nrow(df_temp)/5) | table(df_temp$group) > ceiling(nrow(df_temp)/5))
|
interr<-any(table(df_temp$group) < floor(nrow(df_temp)/5) | table(df_temp$group) > ceiling(nrow(df_temp)/5))
|
||||||
}
|
}
|
||||||
@@ -66,12 +81,14 @@ server <- function(input, output) {
|
|||||||
|
|
||||||
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]])
|
df_def<-merge(df, ind.list[[index]])
|
||||||
|
dades$db<-df_def
|
||||||
|
|
||||||
ggplot(df_def, aes(group, Volumen))+
|
ggplot(df_def, aes(group, Volumen))+
|
||||||
geom_boxplot(outlier.alpha = F)+
|
geom_boxplot(outlier.alpha = F)+
|
||||||
geom_jitter(width=0.25)+
|
geom_jitter(width=0.25)+
|
||||||
geom_point(stat="summary", color="blue", size=3)+
|
geom_point(stat="summary", color="blue", size=3)+
|
||||||
lims(y=c(0,max(df_def$Volumen)+10))
|
lims(y=c(0,max(df_def$Volumen)+10))
|
||||||
|
}
|
||||||
})
|
})
|
||||||
|
|
||||||
output$downloadData <- downloadHandler(
|
output$downloadData <- downloadHandler(
|
||||||
@@ -85,23 +102,45 @@ server <- function(input, output) {
|
|||||||
id_tumors<-c("L","R")
|
id_tumors<-c("L","R")
|
||||||
timepoint<-c(7,10,13,16,19,22,25)
|
timepoint<-c(7,10,13,16,19,22,25)
|
||||||
|
|
||||||
|
if (!is.null(input$file_sizes)){
|
||||||
|
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[,4:ncol(dtemplate)]<-""
|
||||||
|
}else{
|
||||||
template<-expand.grid(LETTERS[1:ncages], 1:5, id_tumors, timepoint)
|
template<-expand.grid(LETTERS[1:ncages], 1:5, id_tumors, timepoint)
|
||||||
colnames(template)<-c("Cage", "ID animal", "ID tumor", "Timepoint")
|
colnames(template)<-c("Cage", "ID animal", "ID tumor", "Timepoint")
|
||||||
template<-template[order(template$Timepoint, template$Cage, template$`ID animal`),]
|
template<-template[order(template$Timepoint, template$Cage, template$`ID animal`),]
|
||||||
template["Group"]<-""
|
template["Group"]<-""
|
||||||
|
if (input$measure_sys == "L-W-D"){
|
||||||
template<-rbind(template, template, template)
|
template<-rbind(template, template, template)
|
||||||
template<-template[order(template$Timepoint, template$Cage, template$`ID animal`, template$`ID tumor`),]
|
template<-template[order(template$Timepoint, template$Cage, template$`ID animal`, template$`ID tumor`),]
|
||||||
if (input$measure_sys == "L-W-D"){
|
|
||||||
template["TS"]<-rep(c("TS-Length", "TS-Width", "TS-Deep"), nrow(template)/3)
|
template["TS"]<-rep(c("TS-Length", "TS-Width", "TS-Deep"), nrow(template)/3)
|
||||||
dtemplate<-dcast(template, Cage+`ID animal`+`ID tumor`+Group+TS~Timepoint)
|
dtemplate<-dcast(template, Cage+`ID animal`+`ID tumor`+Group+TS~Timepoint)
|
||||||
}
|
}
|
||||||
if (input$measure_sys == "Min-Max"){
|
if (input$measure_sys == "Min-Max"){
|
||||||
|
template<-rbind(template, template)
|
||||||
|
template<-template[order(template$Timepoint, template$Cage, template$`ID animal`, template$`ID tumor`),]
|
||||||
template["DPV"]<-rep(c("Major", "Minor"), nrow(template)/2)
|
template["DPV"]<-rep(c("Major", "Minor"), nrow(template)/2)
|
||||||
dtemplate<-dcast(template, Cage+`ID animal`+`ID tumor`+Group+DPV~Timepoint)
|
dtemplate<-dcast(template, Cage+`ID animal`+`ID tumor`+Group+DPV~Timepoint)
|
||||||
}
|
}
|
||||||
|
|
||||||
dtemplate[,6:ncol(dtemplate)]<-""
|
dtemplate[,6:ncol(dtemplate)]<-""
|
||||||
|
}
|
||||||
write.xlsx(dtemplate,file)
|
write.xlsx(dtemplate,file)
|
||||||
}
|
}
|
||||||
)
|
)
|
||||||
|
|||||||
Reference in New Issue
Block a user