You might ask what R has to do with theater.
I assure you it has. I act in the theater group ‘ndescenze. We will soon present (actually, we just performed) a show based on the Marx Brothers Radio Shows. We shuffle actors and characters during the show (we like it complicated!) and we needed to find at least one sequence of scenes which allowed people to change dress and be ready quickly to be back on stage.
I manually described a number of rules based on the roles of the actors.
For example, “Teatro”, in which I act as Ravelli and I am on stage until the end of the scene, cannot be followed by “Autobus”, in which I act as Miss Dimple and I am on stage in the beginning of the scene…
After doing that, I just needed to find the combination of six scenes (named “affitto”,”autobus”,”eredita”,”ristorante”,”tassista” and “teatro”) which didn’t break any of the imposed rules.
No need to say that I used R! It worked, I found a good answer, but with a really ugly piece of code… Let’s see if you can find the right answer(s) and with a better piece of code (ok, the latter is not so difficult)

Here I list the rules:
“teatro” must take place after “affitto”, because in “affitto” we explain some things that will be needed for “teatro”.
They don’t need to be consecutive, though.
Then a list of consecutive combinations that are forbidden
“affitto” cannot be followed by “tassista” nor by “teatro”
“autobus” cannot be followed by “ristorante”
“eredita” cannot be followed by “tassista” nor by “autobus”
“ristorante” cannot be followed by “affitto”, “tassista”, “teatro” nor by “autobus”
“tassista” cannot be followed by “affitto”, “teatro” nor by “eredita”
“teatro” cannot be followed by “autobus”, “affitto”, nor by “ristorante”

Here’s the code:

scenes<-c("affitto","autobus","eredita","ristorante","tassista","teatro")
choose.me<-expand.grid(list(scenes,scenes,scenes,scenes,scenes,scenes),
                       stringsAsFactors=FALSE)
for (bbb in 1: nrow(choose.me))
	{
	if(length(unique(as.character(choose.me[bbb,])))<6) 
    {choose.me[bbb,]<-rep(NA,6);next} 
    if(which(choose.me[bbb,]=="affitto") > which(choose.me[bbb,]=="teatro")) 
    {choose.me[bbb,]<-rep(NA,6);next}	
	if(which(choose.me[bbb,]=="affitto")+1==which(choose.me[bbb,]=="tassista")) 
    {choose.me[bbb,]<-rep(NA,6);next}
	if(which(choose.me[bbb,]=="affitto")+1==which(choose.me[bbb,]=="teatro")) 
    {choose.me[bbb,]<-rep(NA,6);next}
	if(which(choose.me[bbb,]=="autobus")+1==which(choose.me[bbb,]=="ristorante")) 
    {choose.me[bbb,]<-rep(NA,6);next}
	if(which(choose.me[bbb,]=="eredita")+1==which(choose.me[bbb,]=="tassista")) 
    {choose.me[bbb,]<-rep(NA,6);next}
	if(which(choose.me[bbb,]=="eredita")+1==which(choose.me[bbb,]=="autobus")) 
    {choose.me[bbb,]<-rep(NA,6);next}
	if(which(choose.me[bbb,]=="ristorante")+1==which(choose.me[bbb,]=="affitto")) 
    {choose.me[bbb,]<-rep(NA,6);next}
	if(which(choose.me[bbb,]=="ristorante")+1==which(choose.me[bbb,]=="tassista")) 
    {choose.me[bbb,]<-rep(NA,6);next}
	if(which(choose.me[bbb,]=="ristorante")+1==which(choose.me[bbb,]=="teatro")) 
    {choose.me[bbb,]<-rep(NA,6);next}
	if(which(choose.me[bbb,]=="ristorante")+1==which(choose.me[bbb,]=="autobus")) 
    {choose.me[bbb,]<-rep(NA,6);next}
	if(which(choose.me[bbb,]=="tassista")+1==which(choose.me[bbb,]=="affitto")) 
    {choose.me[bbb,]<-rep(NA,6);next}
	if(which(choose.me[bbb,]=="tassista")+1==which(choose.me[bbb,]=="teatro")) 
    {choose.me[bbb,]<-rep(NA,6);next}
	if(which(choose.me[bbb,]=="tassista")+1==which(choose.me[bbb,]=="eredita")) 
    {choose.me[bbb,]<-rep(NA,6);next}
	if(which(choose.me[bbb,]=="teatro")+1==which(choose.me[bbb,]=="autobus")) 
    {choose.me[bbb,]<-rep(NA,6);next}
	if(which(choose.me[bbb,]=="teatro")+1==which(choose.me[bbb,]=="affitto")) 
    {choose.me[bbb,]<-rep(NA,6);next}
	if(which(choose.me[bbb,]=="teatro")+1==which(choose.me[bbb,]=="ristorante")) 
    {choose.me[bbb,]<-rep(NA,6);next}
	} 
choose.me<-na.omit(choose.me)

Using this code, I was able to find 10 combinations of scenes that were technically feasible. Among them we chose the one likely to have the best impact on the audience…
The list of all the technically possible scenes and the chosen one will be out soon… Obviously, if you attended our show you already know!
Waiting for comments on how to improve the code and your guesses for the right answer!

Improved code by Paul Fruin
Following Paul’s comment I paste below the complete code for solving the same problem. I tested it and it provides the right answer. In addition, Paul’s code avoids the loop and thus saves a considerable amount of time! I am always happy when I learn a way to avid a loop, so thanks Paul!

BTW: stay tuned, I will soon add alternative versions suggested by comments… I just need some time to test them and comment them!!

Here’s Paul’s code:

scenes<-c("affitto","autobus","eredita","ristorante","tassista","teatro")
choose.me<-expand.grid(list(scenes,scenes,scenes,scenes,scenes,scenes),
		stringsAsFactors=FALSE)
##now knock out rows step by step, using apply() to index the bad rows
choose.me[ apply(choose.me,1,function(x) 
					! length(unique(as.character(x)))<6),] -> choose.me

#remove rows based on next criteria
choose.me[ apply(choose.me,1,function(x)
					! which(x=="affitto") > which(x=="teatro") ) , ] -> choose.me

#remove al the other rows...
choose.me[ apply(choose.me,1,function(x)
					! which(x=="affitto")+1 == which(x=="tassista") ) , ] -> choose.me
choose.me[ apply(choose.me,1,function(x)
					! which(x=="affitto")+1 == which(x=="teatro") ) , ] -> choose.me
choose.me[ apply(choose.me,1,function(x)
					! which(x=="autobus")+1 == which(x=="ristorante") ) , ] -> choose.me
choose.me[ apply(choose.me,1,function(x)
					! which(x=="eredita")+1 == which(x=="tassista") ) , ] -> choose.me
choose.me[ apply(choose.me,1,function(x)
					! which(x=="eredita")+1 == which(x=="autobus") ) , ] -> choose.me
choose.me[ apply(choose.me,1,function(x)
					! which(x=="ristorante")+1 == which(x=="affitto") ) , ] -> choose.me
choose.me[ apply(choose.me,1,function(x)
					! which(x=="ristorante")+1 == which(x=="tassista") ) , ] -> choose.me
choose.me[ apply(choose.me,1,function(x)
					! which(x=="ristorante")+1 == which(x=="teatro") ) , ] -> choose.me
choose.me[ apply(choose.me,1,function(x)
					! which(x=="ristorante")+1 == which(x=="autobus") ) , ] -> choose.me
choose.me[ apply(choose.me,1,function(x)
					! which(x=="tassista")+1 == which(x=="affitto") ) , ] -> choose.me
choose.me[ apply(choose.me,1,function(x)
					! which(x=="tassista")+1 == which(x=="teatro") ) , ] -> choose.me
choose.me[ apply(choose.me,1,function(x)
					! which(x=="tassista")+1 == which(x=="eredita") ) , ] -> choose.me
choose.me[ apply(choose.me,1,function(x)
					! which(x=="teatro")+1 == which(x=="autobus") ) , ] -> choose.me
choose.me[ apply(choose.me,1,function(x)
					! which(x=="teatro")+1 == which(x=="affitto") ) , ] -> choose.me
choose.me[ apply(choose.me,1,function(x)
					! which(x=="teatro")+1 == which(x=="ristorante") ) , ] -> choose.me

Carlos Ortega provided an even faster solution. It uses libraries “combinat” and “stringr” and it runs in less than 3 secs even on my old laptop! I tested it and it provides the right answer. I promise that I will try to learn this efficient implementation!
You can find Carlo’s code below:

a<-Sys.time()
library(combinat)
library(stringr)

scenes<-c("affitto","autobus","eredita","ristorante","tassista","teatro")
all.sce<-permn(scenes )

foo<-function(x) {
	str_c(x, collapse="-")
}
sce.god<-lapply(all.sce, foo)

# Working data.frame
sce.end<-as.data.frame(sce.god)
names(sce.end)<-NULL
sce.wrk<-t(sce.end)

###### Forbidden Rules
r01<-c('affitto-tassista')
r02<-c('affitto-teatro')
r03<-c('autobus-ristorante')
r04<-c('eredita-tassista')
r05<-c('eredita-autobus')
r06<-c('ristorante-affitto')
r07<-c('ristorante-tassista')
r08<-c('ristorante-teatro')
r09<-c('ristorante-autobus')
r10<-c('tassista-affitto')
r11<-c('tassista-teatro')
r12<-c('tassista-eredita')
r13<-c('teatro-autobus')
r14<-c('teatro-affitto')
r15<-c('teatro-ristorante')
r16<-c('^teatro')

rul.for<-data.frame(
		r01, r02, r03, r04, r05,
		r06, r07, r08, r09, r10,
		r11, r12, r13, r14, r15, r16
)

############# Process to get the valid scenes
sce.ini<-sce.wrk

for(i in 1:ncol(rul.for)) {
	
	rul.tmp<-as.vector(rul.for[1,i])
	val.tmp<-str_locate(sce.ini, rul.tmp)
	sce.tmp<-sce.ini[is.na(val.tmp[,1])]
	
	sce.ini<-sce.tmp
	
}

### To eliminate first rule Ð teatro after affittoÉ
te.val<-str_locate(sce.ini, "teatro")
af.val<-str_locate(sce.ini, "affitto")
te.af<-data.frame(te=te.val[,1],af=af.val[,1])

no.val<-as.numeric(row.names(te.af[te.af$te < te.af$af,]))

### Valid Scenes
valid.scenes <- sce.ini[-no.val]
valid.scenes

b<-Sys.time()
b-a

Last but not least, Ben Bolker found another elegant solution providing the correct answer.
I paste it below:

scenes<-c("affitto","autobus","eredita","ristorante","tassista","teatro")
choose.me<-expand.grid(list(scenes,scenes,scenes,scenes,scenes,scenes),
stringsAsFactors=FALSE)
##now knock out rows step by step, using apply() to index the bad rows
choose.me[ apply(choose.me,1,function(x) ! length(unique(as.character(x)))<6),] -> choose.me

choose.me[ apply(choose.me,1,function(x)
! which(x=="affitto") > which(x=="teatro") ) , ] -> choose.me

##remove rows based on next criteria
not_adjacent <- function(t1,t2) {
apply(choose.me,1,function(x)
! (which(x==t1)+1 == which(x==t2)))
}
omit_pairs <- matrix(c("affitto","tassista",
"affitto","teatro",
"autobus","ristorante",
"eredita","tassista",
"eredita","autobus",
"ristorante","affitto",
"ristorante","tassista",
"ristorante","teatro",
"ristorante","autobus",
"tassista","affitto",
"tassista","teatro",
"tassista","eredita",
"teatro","autobus",
"teatro","affitto",
"teatro","ristorante"),
ncol=2,byrow=TRUE)
invisible(apply(omit_pairs,1,
function(z) {
choose.me <<- choose.me[not_adjacent(z[1],z[2]),]
}))
nrow(choose.me) ## 10

All the solutions provided so far were correct, fast and elegant. This makes me realize the paucity of my R skills, but at the same time stimulates me to learn more!