Genial Carlos! Tu codigo produce lo que quiero! Estoy tratando de entender cada paso y hacer algunos cambios. Mi problema es con como usar `str_plit_fixed`. Con tu codigo tengo eso:
> separoPairs <- as.data.frame(str_split_fixed(AllpairsTmp, " ", 6)) head(separoPairs) V1 V2 V3 V4 V5 V6 1 e1 g1 c1 e2 g1 c1 2 e1 g1 c1 e3 g1 c1 3 e1 g1 c1 e4 g1 c1 4 e1 g1 c1 e5 g1 c1 5 e1 g1 c1 e6 g1 c1 6 e1 g1 c1 e7 g1 c1 V1 y V4 son el nombre de las escuelas, V2 y V5 del grado y V3 y V6 de la division. Yo hice unos cambios para tener datos un poco mas complejos, pero como resultado inintencional no puedo producir `separoPairs` Esto es lo que mi codigo produce: > head(separoPairs) V1 V2 V3 V4 V5 V6 1 Aslamy School 3 grade A Maruyama School 3 grade A 2 Aslamy School 3 grade A Smith School 3 grade A 3 Aslamy School 3 grade A Linares School 3 grade A 4 Aslamy School 3 grade A Dieyleh School 3 grade A 5 Aslamy School 3 grade A Hernandez School 3 grade A 6 Aslamy School 3 grade A Padgett School 3 grade A Se puede arreglar? Este es mi codigo library(dplyr) library(randomNames) library(geosphere) set.seed(7142015) # Define Parameters n.Schools <- 20 first.grade<-3 last.grade<-5 n.Grades <-last.grade-first.grade+1 n.Classrooms <- 4 n.Teachers <- (n.Schools*n.Grades*n.Classrooms)/2 #Two classrooms per teacher # Define Random names function: 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) } # Generate n.Schools names gen.schools <- function(n.schools) { School.ID <- paste0(gen.names(n = n.schools, which.names = "last"), ' School') School.long <- rnorm(n = n.schools, mean = 21.7672, sd = 0.025) School.lat <- rnorm(n = n.schools, mean = 58.8471, sd = 0.025) School.RE <- rnorm(n = n.schools, mean = 0, sd = 1) Schools <- data.frame(School.ID, School.lat, School.long, School.RE) %>% mutate(School.ID = as.character(School.ID)) %>% rowwise() %>% mutate (School.distance = distHaversine( p1 = c(School.long, School.lat), p2 = c(21.7672, 58.8471), r = 3961 )) return(Schools) } Schools <- gen.schools(n.schools = n.Schools) # Generate Grades Grades <- c(first.grade:last.grade) # Generate n.Classrooms Classrooms <- LETTERS[1:n.Classrooms] # Group schools and grades SchGr <- outer(Schools$School.ID, Grades, 'grade', FUN="paste") # Group SchGr and Classrooms SchGrClss <- outer(SchGr, Classrooms, FUN="paste") # These are the combination of School-Grades-Classroom SchGrClssTmp <- as.matrix(SchGrClss, ncol=1, nrow=length(SchGrClss) ) SchGrClssEnd <- as.data.frame(SchGrClssTmp) # Assign n.Teachers (2 classroom in a given school-grade) Allpairs <- as.data.frame(t(combn(SchGrClssTmp, 2))) AllpairsTmp <- paste(Allpairs$V1, Allpairs$V2, sep=" ") library(stringr) separoPairs <- as.data.frame(str_split_fixed(AllpairsTmp, " ", 6)) head(separoPairs) Muchas gracias! Estoy aprendiendo un monto gracias a vos! Ignacio On Tue, Jul 14, 2015 at 3:31 AM Carlos Ortega <c...@qualityexcellence.es> wrote: > OK. > Bueno, para esa última parte para tener un data.frame con toda la > información, ya filtrada y con los datos de los profesores puedes hacer > esto: > > #------------------------------------------ > > #Si a los "validPairs" tengo que asignar "T" profesores > t <- 10 > teachers <- data.frame( > Name=sample(paste("Prof_",1:t, sep=""),t) > ,Speciality=sample(paste("Spec_",1:t, sep=""),t) > ,Age=sample(25:60,t) > ) > > placesEnd <- validPairs[sample(1:nrow(validPairs), t), ] > row.names(placesEnd) <- NULL > placesEndRed <- placesEnd[,c(1,2,3,6)] > names(placesEndRed) <- c("School", "Grade", "Class_1", "Class_2") > endAssig <- cbind.data.frame(placesEndRed, teachers) > endAssig > > #------------------------------------------ > > Que produce este tipo de resultado: > > > endAssig > School Grade Class_1 Class_2 Name Speciality Age > 1 e11 g2 c3 c18 Prof_2 Spec_5 39 > 2 e11 g2 c5 c16 Prof_8 Spec_1 49 > 3 e12 g1 c3 c17 Prof_1 Spec_10 36 > 4 e2 g2 c15 c17 Prof_10 Spec_9 29 > 5 e1 g3 c9 c15 Prof_3 Spec_6 55 > 6 e6 g3 c2 c18 Prof_6 Spec_8 42 > 7 e17 g2 c9 c14 Prof_4 Spec_3 27 > 8 e18 g3 c2 c12 Prof_7 Spec_2 53 > 9 e13 g1 c10 c20 Prof_9 Spec_4 58 > 10 e18 g2 c4 c19 Prof_5 Spec_7 59 > > Saludos, > Carlos Ortega > www.qualityexcellence.es > > > El 14 de julio de 2015, 1:00, Ignacio Martinez <ignaci...@gmail.com> > escribió: > >> Perdon por no se lo suficientemente claro :( >> >> Tu codigo produce `validPairs` que tiene 7 variables y 360 observaciones. >> Donde >> >> > validPairs[1,] V1 V2 V3 V4 V5 V6 valid >> 60 e1 g1 c1 e1 g1 c2 Valid >> >> >> indica que un maestro tiene asignado c1 y c2 en la escuela e1 y el grado >> g1. Correcto? Si es asi, esto es casi lo que queira producir y creo que >> puedo llegar a donde quiero usando tu codigo de base. >> >> El objecto que yo quiero generar es el que genero en stakoverflow >> `schoolGrade`. Donde >> >> > schoolGrade[1:2,] grade School.ID Classroom Teacher.ID >> > Teacher.exp Teacher.Other Teacher.RE >> 1 3 Modi School A Sage, Kendell 27.87402 0 >> -0.04372723 >> 2 4 Modi School A Delgado, Vanessa 26.20701 0 >> -0.88280564 >> >> >> Es decir, cada observación es un aula en una escuela con informacion >> sobre el grado, nombre del maestro, otras caracteristics del maestro. >> >> Muchas gracias por la ayuda. >> >> >> >> On Mon, Jul 13, 2015 at 6:37 PM Carlos Ortega <c...@qualityexcellence.es> >> wrote: >> >>> Hola, >>> >>> No entiendo muy bien. >>> El número de clases lo puedes modificar a tu gusto, en la variable >>> "numDi". >>> >>> He puesto un valor de ejemplo de 4 porque así aparecía en tu código, >>> obviamente puedes poner otro valor... >>> La única limitación aparecerá cuando escojas un valor muy grande y el >>> cálculo de las combinaciones posibles tarde en generarse. He probadoc con >>> 20 y sigue siendo manejable. >>> >>> #--------------------------------------------- >>> >>> #Generar "c" Divisiones: c1, c2, c3... >>> *numDi <- 4* >>> divis <- paste("c", 1:numDi, sep="") >>> #---------------------------------------------- >>> >>> Y la otra discrepancia parece ser el número de combinaciones válidas. >>> Lo que has dicho es que quieres "asignar un profesor a una escuela un >>> grado y dos clases". Dos clases, del mismo colegio y en el mismo grado, ¿es >>> así?... >>> >>> Saludos, >>> Carlos Ortega >>> www.qualityexcellence.es >>> >>> >>> >>> El 14 de julio de 2015, 0:07, Ignacio Martinez <ignaci...@gmail.com> >>> escribió: >>> >>>> Gracias Carlos, >>>> >>>> Tu codigo es un gran paso en el sentido correcto pero no produce >>>> exactamente lo que estoy buscando. >>>> >>>> Mi "solucion" en stackoverflow >>>> <http://stackoverflow.com/questions/31137940/randomly-assign-teachers-to-classrooms-imposing-restrictions/31143808#31143808> >>>> produce un data frame `schoolGrade` con 240 observaciones y 7 variables. Mi >>>> objetivo es poder generar un data frame asi pero con la flexibilidad de >>>> poder usar n.classrooms <- 20 (o cualquier otro numero) en lugar de 4 >>>> (hardcoded) >>>> >>>> Gracias de nuevo! >>>> >>>> Ignacio >>>> >>>> >>>> >>>> >>>> On Mon, Jul 13, 2015 at 5:54 PM Carlos Ortega <c...@qualityexcellence.es> >>>> wrote: >>>> >>>>> 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 >>>>> >>>> >>> >>> >>> -- >>> 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