[R-es] Crear datos aleatorios con restriciones
Ignacio Martinez
ignacio82 en gmail.com
Mar Jul 14 16:35:23 CEST 2015
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 <cof en 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 <ignacio82 en 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 <cof en 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 <ignacio82 en 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 <cof en 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 <ignacio82 en 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 <
>>>>>> cof en 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 <ignacio82 en 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 en 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]]
Más información sobre la lista de distribución R-help-es