[R-es] Crear datos aleatorios con restriciones

Carlos Ortega cof en qualityexcellence.es
Mar Jul 14 00:37:18 CEST 2015 

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

	[[alternative HTML version deleted]]

Más información sobre la lista de distribución R-help-es