Lo primero gracias a todos,
Una de los problemas que me encontré fue al hacer modelos sociales para un
máster que estoy haciendo, aunque esta duda me surge habitualmente en mi
trabajo. La verdad es que por comodidad intento evitar vectorizar las
operaciones ya que a mi parecer hace incomodo el proceso de lectura,
sobretodo una vez pasados un par de meses.



Ahora al lio, esto he sido incapaz de vectorizarlo y creo que lo voy a
intentar con c++... Estoy modelizando el modelo social Axelrof
# Info extra
# Artículo
# http://www-personal.umich.edu/~axe/research/Dissemination.pdf
# Tendría que quedar algo así
# http://ifisc.uib.es/research/APPLET_Axelrod/Culture.html
#------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
1 Genero una matriz de datos nxn que representan individuos con unas
características, la conjunción de dichas características le da un color,
los individuos están distribuidos como un tablero de ajedrez en el plano.
(Empieza el bucle.
Este bucle se puede ver al final de este documento. Buscar
require(animation)   con control +F si se quiere llegar al bucle de manera
rápida al bucle)
2 Elijo un individuo al azar que interactua con uno de sus cuatro vecinos
este, oeste, norte o sur, la probabilidad de interactuar depende de el
número de características comunes que tenga con el resto a más parecido más
probable a menos menos.

3 Se cambia una caracterítstica y se sigue el proceso. A poder ser 80.000
veces (imposible con mi máquina pasar de 8.000)

(Fin del bucle)
Os mando el bucle por si lo quereis correr. Pero la cosa no es que nadie me
lo haga, es una cosa personal entre mi máquina y yo. De todas manera es
demasiado código para leer, por eso no lo he mandado de primeras.

#---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
#---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
#---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
#---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
rm(list=ls())
#Parametros
L<- 15 #Tamaño del grupo N=L*L
N<-L*L #Sample size
Fc<-2 #Number of commponents
q<-3   #Number of commponent values
p<-0.05 #Probability of remote conexion
traits<-letters[1:q] #Numeric values is not a good idea for this exercise I
prefer do with letters
#----------------------------------------------------------
#Matriz de valores culturales
M1<-matrix(NA, ncol=Fc+1, nrow=N)
i<-1
for(i in 1:N){#Create vectors
  M1[i,-(Fc+1)]<-
    sample(traits, Fc, replace=T)
  M1[i,(Fc+1)]<-
    paste( M1[i,1:Fc], sep="", collapse="")
}

M2<-matrix(NA, nrow=N, ncol=2)
M2[,2]<-rep(1:L,L) #unidades
for(i in 1:L){
  M2[(1+(i-1)*L):(L+(i-1)*L),1]<-rep(i,L) #Decenas de las coordenas
}
M<-cbind(M2,M1)
#head(M)
#----------------------------------------------------------
#Creamos los factores que definiran los colores
colores<-rainbow(q^Fc)
combn(x=traits,m=Fc)#Combina valores no nos vale
combn(letters[1:4], 2, simplify=F)
require(utils)
lista<-NULL
for(i in 1:Fc){
  lista[[i]]<-traits #create a list for function expand.grid
}
factores<-interaction(lista,sep="")


cbind(factores, colores)

factores1<-levels(factores)

#-----------------------------------------------------------
#Creamos ahora el factor en la matriz de datos

datos<-as.data.frame(M, stringsAsFactors=F)

names(datos)[c(1,2)]<-c("x","y")
names(datos)[2+Fc+1]<-c("factor")
datos$factor<-  factor(datos$factor, levels=factores1)
datos[,c(1)]<-as.numeric(datos[,c(1)])
datos[,c(2)]<-as.numeric(datos[,c(2)])
head(datos)
summary(datos)
#--------------------------------------------------------------------------
#We calculate th interaction matrix
#We can alocate the file and colum by row name with this algorithm
# file %% L = y coordenade if is equal to zero we must plus one and
# x coordenade is file %/% L = x coordenade
# in other case file %/% L = x coordenade -1

#On other hand if we are in the border we only have 3 or 2 neighbours
#Two if the point is a corner and 3 in other case.
interac<-matrix(0,nrow=N,ncol=N)
coordenades<-NULL
coordenades<-as.data.frame(matrix(0,nrow=N, ncol=3))
names(coordenades)<-c("x","y","file")

for ( i in 1:N){
  if(i %% L!= 0){
    coordenades[i,]$y<-i %% L
    coordenades[i,]$x<- i%/% L +1
  }else{
    coordenades[i,]$y<- L
    coordenades[i,]$x<- i%/% L
  }
  coordenades[i,]$file<-i
}

head(coordenades)
#coordenades
#Now we compute standard interacction matrix
i<-1
for(i in 1:(N)){#central map values
  x<-coordenades[coordenades$file==i,]$x
  y<-coordenades[coordenades$file==i,]$y
  interac[i,coordenades[coordenades$x==(x+1) & coordenades$y==(y),]$file]<-1
  interac[i,coordenades[coordenades$x==(x-1) & coordenades$y==(y),]$file]<-1
  interac[i,coordenades[coordenades$x==(x) & coordenades$y==(y+1),]$file]<-1
  interac[i,coordenades[coordenades$x==(x) & coordenades$y==(y-1),]$file]<-1
}

#-------------------------------------------------------------------------
plot(datos[,c(1,2)], col=colores[datos$factor],pch=15, cex=2 ,las=1,
xlim=c(1,L), ylim=c(0.5,L+0.5))
title("n=0" )
rm(M,M1,M2,i,lista)
#Variable names
#factores1 contain al factor names
#datos contain x and y coordenades trait of F dimensions(features) and the
factor value
#coordenades keep the relation between x and y coordenade and corresponde
with data file number
#interac all interacctions between elemets
#colores all color pallet
#L Tamaño del grupo N=L*L
#N Sample size
# Fc Number of commponents
#q Number of commponent values
#p Probability of remote conexion
#traits Numeric values is not a good idea for this exercise I prefer do
with letters
#----------------------------------------------------------
head(datos)



total<-8000
#datos11<-datps
setwd("C:/Documents and Settings/UIB/Mis documentos/Dropbox/Máster/Física")
#install.packages("animation")
require(animation)
## A quick and dirty demo
saveHTML({
#----------------------------------------------------------------------------------------------------------------------------
#Loop  for Start html file
  for(k in 1:total){
    aleatorio<-sample(1:N,1)       #Selects one random element
    #aleatorio<-1
    selected<-datos[aleatorio,]   #Selected file
    neighboursIndex<-row(as.matrix(interac[aleatorio,]))[interac[aleatorio,
]==1] #Selects neighbours of our random element
    neighbours<-datos[neighboursIndex,]
    neighbours
    comunMeasure<-matrix(0, nrow=dim(neighbours)[1],
ncol=dim(neighbours)[2]-3)   #measures the comum values
    for(i in 3:(Fc+2)){
      NumberN<-dim(neighbours)[1] #the number of neighbours measure
      for(j in 1:NumberN){
        if( selected[,i]==neighbours[j,i]){
          comunMeasure[j,i-2]<-1  #When is a neighbour
        }
      }

    }

    if(sum(apply(comunMeasure,1, sum))!=0){
      ProbVect<-apply(comunMeasure,1, sum)/sum(apply(comunMeasure,1, sum))
      selectedIndex<-sample(1:dim(neighbours)[1],prob=ProbVect, size=1 )
#Densitiy interaction function if is most similar is most probable of
interact
      similar<-
        neighbours[selectedIndex,] #Select the most similar neighbour and
we choose a different feature if any for change.

      if(sum(comunMeasure[selectedIndex,])!=Fc){ #Change different feature
respect original or selected value

change<-sample(row(as.matrix(comunMeasure[selectedIndex,]))[comunMeasure[selectedIndex,
]!=1],1)
        change<-change+2
        similar[change]<-selected[change]
        similar$factor<-paste( similar[3:(Fc+2)], sep="", collapse="")
        similar
      }

      datos[rownames(similar),]<-similar
      datos[rownames(similar),]


    }else{
      #No do anything
    }
    #plot(datos1[,c(1,2)], col=colores[datos1$factor],pch=15, cex=2 ,las=1,
xlim=c(1,L), ylim=c(0.5,L+0.5))
    plot(datos[,c(1,2)], col=colores[datos$factor],pch=15, cex=2 ,las=1,
xlim=c(1,L), ylim=c(0.5,L+0.5))
    title(paste("n=",k,sep="" ))
    print(paste(k ," de ",total, sep=""))

    }

#finish loop  for html file
#----------------------------------------------------------------------------------------------------------------------------
}, img.name = "Axel", imgdir = "A50011", htmlfile =
"Axel1000.html",modelautobrowse = T, title = "Axelrof ",
description = F , outdir=getwd())


El 12 de junio de 2012 14:32, Javier Villacampa González <
javier.villacampa.gonzalez@gmail.com> escribió:

> Buenas días a todos,
>
> una vez más os escribo para preguntaros una duda. Estoy haciendo bucles
> con data frames, el problema es que al hacer bucles de esta manera el
> sistema se relentiza. He buscado por internet y en varias web te dicen que
> evites los bucles en la medida de lo posible y que intentes funcionar con
> c++ con la librería Rccp
> http://cran.r-project.org/web/packages/Rcpp/Rcpp.pdf.
>
> Mi preguta es
> 1 Se puede acelerar el proceso dentro de R si irme a otro lenguaje
> 2  Alguna página con ejemplitos fáciles de Rccp.
>
> Como ya veis tengo la duda a medio madurar, pero si me podeis dar un
> empujón os lo agradeceré.
>
> Un saludo y gracias por adelantado.
>

	[[alternative HTML version deleted]]

