Hola, Esta es una forma de hacerlo, evitando bucles....
#------------------------------------------------------------------------------------------ #1. Quiero generar N escuelas, con G grados y C divisiones. #2. Quiero asignar cada uno de T maestros a 2 divisiones en un grado y escuela #---------------------- Combinaciones de: Escuelas - Grados - Divisiones #Generar "n" Escuelas: e1, e2, e3... numEs <- 20 escuelas <- paste("e", 1:numEs, sep="") #Generar "g" Grados: g1, g2, g3... numGr <- 3 grados <- paste("g", 1:numGr, sep="") #Generar "c" Divisiones: c1, c2, c3... numDi <- 4 divis <- paste("c", 1:numDi, sep="") #Agrupo Escuelas - Grados EsGra <- outer(escuelas, grados, FUN="paste") #Agrupo (Escuelas - Grados) - Divisiones EsGraDiv <- outer(EsGra, divis, FUN="paste") #Estas son todas las combinaciones de Escuelas-Grados-Divisiones EsGraDivTmp <- as.matrix(EsGraDiv, ncol=1, nrow=length(EsGraDiv) ) EsGraDivEnd <- as.data.frame(EsGraDivTmp) #---------------------- Profesores #Asignar a cada uno de los T maestros a 2 clases en 1 grado y 1 escuela #Al ser 2 clases creo todas las parejas posibles #de las que escogeré 2 clases del mismo grado y misma escuela Allpairs <- as.data.frame(t(combn(EsGraDivTmp, 2))) AllpairsTmp <- paste(Allpairs$V1, Allpairs$V2, sep=" ") #Aqui tengo las parejas en la misma fila y separadas en columnas library(stringr) separoPairs <- as.data.frame(str_split_fixed(AllpairsTmp, " ", 6)) #de este data.frame escojo filas donde V1=V4 y V2=V5 : misma escuela + mismo grado separoPairs$valid <- ifelse(separoPairs$V1 == separoPairs$V4 & separoPairs$V2 == separoPairs$V5, "Valid", "Invalid") #Resultado Final validPairs <- separoPairs[separoPairs$valid=="Valid",] #Si a los "validPairs" tengo que asignar "T" profesores, de forma aleatoria t <- 10 validPairs[sample(1:nrow(validPairs), t), ] #--------------------------------------------------------- Saludos, Carlos Ortega www.qualityexcellence.es El 13 de julio de 2015, 21:03, Ignacio Martinez <ignaci...@gmail.com> escribió: > Hola, > > 0. La falta de 'elegancia' hace que sea mas dificil hacer cambios al > codigo. Por ejemplo cambiar n.classrooms <- 4 a n.classrooms <- 20 > > 1. Cuando tengo solo 4 puedo hacer esto: > > schoolGrade$A <- Teachers$Teacher.ID[1:cuttoff1] > schoolGrade$B <- Teachers$Teacher.ID[1:cuttoff1] > schoolGrade$C <- Teachers$Teacher.ID[(cuttoff1+1):n.teachers] > schoolGrade$D <- Teachers$Teacher.ID[(cuttoff1+1):n.teachers] > > Pero si tengo 20 tendria que escribir 20 lines en lugar de 4 y calcular > los cutoff para cada linea. Con 20 classrooms por escuela y por grado tengo > que asignar 600 maestros a 2 classrooms cada uno. > > 2. No necesito todas las asignaciones posible, con una es suficiente. > > Gracias! > > On Mon, Jul 13, 2015 at 2:54 PM Carlos Ortega <c...@qualityexcellence.es> > wrote: > >> Hola, >> >> ¿Pero el problema que tienes es de "elegancia del código" como indicas en >> StackOverflow? >> o ¿de performance porque al subir el número de clases el número total de >> combinaciones te explota?... >> >> En cuanto a las asignaciones de los profesores, ¿quieres tener todas las >> posibles asignaciones? ¿un solo caso de asignación?... >> >> Saludos, >> Carlos Ortega >> www.qualityexcellence.es >> >> 2015-07-13 15:23 GMT+02:00 Ignacio Martinez <ignaci...@gmail.com>: >> >>> Hola, >>> >>> Esta pregunta la hice en stackoverflow >>> >> < >>> http://stackoverflow.com/questions/31137940/randomly-assign-teachers-to-classrooms-imposing-restrictions/31143808#31143808 >>> >pero >> >> >>> nadie pudo contestarla. >>> >>> 1. Quiero generar N escuelas, con G grados y C divisiones. >>> 2. Quiero asignar cada uno de T maestros a 2 divisiones en un grado y >>> escuela >>> >>> Si tengo C=4 divisiones, puedo lograr lo que quiero con este código: >>> >>> library(randomNames) >>> set.seed(6232015) >>> n.schools <-20 >>> n.grades <- 3 >>> n.classrooms <- 4 >>> total.classrooms <- n.classrooms*n.grades*n.schools >>> >>> gen.names <- function(n, which.names = "both", name.order = >>> "last.first"){ >>> names <- unique(randomNames(n=n, which.names = which.names, >>> name.order = name.order)) >>> need <- n - length(names) >>> while(need>0){ >>> names <- unique(c(randomNames(n=need, which.names = which.names, >>> name.order = name.order), names)) >>> need <- n - length(names) >>> } >>> return(names)} >>> #Generates teachers data frame >>> n.teachers=total.classrooms/2 >>> gen.teachers <- function(n.teachers){ >>> Teacher.ID <- gen.names(n = n.teachers, name.order = "last.first") >>> Teacher.exp <- runif(n = n.teachers, min = 1, max = 30) >>> Teacher.Other <- sample(c(0,1), replace = T, prob = c(0.5, 0.5), >>> size = n.teachers) >>> Teacher.RE <- rnorm(n = n.teachers, mean = 0, sd = 1) >>> Teachers <- data.frame(Teacher.ID, Teacher.exp, Teacher.Other, >>> Teacher.RE) %>% mutate(Teacher.ID=as.character(Teacher.ID)) >>> return(Teachers)} >>> Teachers <- gen.teachers(n.teachers = n.teachers) >>> str(Teachers$Teacher.ID) >>> #Make a ‘schoolGrade’ object and then reshape >>> >>> schoolGrade <- expand.grid(grade = c(3,4,5), >>> School.ID = paste0(gen.names(n = n.schools, >>> which.names = "last"), >>> ' School')) >>> # assign each of T teachers to 2 classrooms within a single school and >>> grade >>> cuttoff1<-n.teachers/2 >>> schoolGrade$A <- Teachers$Teacher.ID[1:cuttoff1] >>> schoolGrade$B <- Teachers$Teacher.ID[1:cuttoff1] >>> schoolGrade$C <- Teachers$Teacher.ID[(cuttoff1+1):n.teachers] >>> schoolGrade$D <- Teachers$Teacher.ID[(cuttoff1+1):n.teachers] >>> >>> library(tidyr) >>> schoolGrade <- gather(schoolGrade, Classroom, Teacher.ID, A:D) %>% >>> full_join(Teachers, by="Teacher.ID") >>> >>> El problema es si quiero incrementar n.classroom incrementar de 4 a 20 >>> (en >>> lugar de A a D tener de A a T >>> >>> Gracias por la ayuda! >>> >>> [[alternative HTML version deleted]] >>> >>> _______________________________________________ >>> R-help-es mailing list >>> R-help-es@r-project.org >>> https://stat.ethz.ch/mailman/listinfo/r-help-es >>> >> >> >> >> -- >> Saludos, >> Carlos Ortega >> www.qualityexcellence.es >> > -- Saludos, Carlos Ortega www.qualityexcellence.es [[alternative HTML version deleted]] _______________________________________________ R-help-es mailing list R-help-es@r-project.org https://stat.ethz.ch/mailman/listinfo/r-help-es