I have a vector like that
objetosDisponibles <- c(1,2,3,4)
I choose random one with this
objetoAleatorio <- sample(objetosDisponibles,size = 1, replace = F)
Then, I delete the choosen element in the vector
objetosDisponibles <- objetosDisponibles[objetosDisponibles!=objetoAleatorio]
If I do this 4 times, I want to choose the elements ramdonly, when I used sample method at the vector with 1 element, it choose other diferent. You can probe this with this code:
cont <- 0
objetosDisponibles <- c(1,2,3,4)
while(cont < 4){
objetoAleatorio <- sample(objetosDisponibles,size = 1, replace = F)
print(objetoAleatorio)
objetosDisponibles <- objetosDisponibles[objetosDisponibles!=objetoAleatorio]
print(objetosDisponibles)
cont <- cont +1
}
The error, a number with "L":
Print output:
Related
If the last value of each sublist in the list ListResiduals (e.g: OptionAOptionD) is > than the value with the corresponding name in the ListSigma (e.g: OptionAOptionD), it adds the name (e.g: OptionAOptionD) to the Watchlist list.
In the last line of the code I put "> 5" just for the example work, it's the "> 5" that I want to replace in the condition that I mentioned in the previous paragraph.
DF <- data.frame("OptionA" = sample(1:100, 50),
"OptionB" = sample(1:100, 50),
"OptionC" = sample(1:100, 50),
"OptionD" = sample(1:100, 50))
#Unfolding options and creating DF
UnFolding <- data.frame(
First = as.vector(sapply(names(DF[]), function(x)
sapply(names(DF[]), function(y)
paste0(x)))),
Second = as.vector(sapply(names(DF[]), function(x)
sapply(names(DF[]), function(y)
paste0(y)))))
#Deleting lines with the same names
UnFolding <-
UnFolding[UnFolding$First != UnFolding$Second, ]
#Creating list with dependent and independent variables
LMList <- apply(UnFolding, 1, function(x)
as.formula(paste(x[1], "~", x[2])))
#Change list data to variable names
names(LMList) <- substring(lapply(LMList, paste, collapse = ""), 2)
#Linear regression - lm()
LMListRegression <- lapply(LMList, function(x) {
eval(call("lm", formula = x, data = DF))
})
#Residuals
ListResiduals <- lapply(LMListRegression, residuals)
#Sigma
ListSigma <- lapply(LMListRegression, function(x) {
sigma(x)*2
})
#Watchlist
Watchlist <- as.list(unlist(lapply(ListResiduals,
function(x) names(x)[1][tail(x, 1) > 5])))
I would gravitate towards converting your Simga and Residual values to a vector and compare the vectors. You could also use a data.frame approach to be sure the order of your lists/vectors doesn't change.
# create a vector with the last value from the Residuals list.
last_residual <- sapply(ListResiduals, `[`, 50)
names(last_residual) <- substr(names(last_residual), 1, stop = -4)
# Using sapply() rather than lapply, will return a named vector
sigma_vector <- sapply(LMListRegression, function(x) {
sigma(x)*2
})
Watchlist <- sigma_vector[last_residual > sigma_vector]
Watchlist
# named numeric(0)
In your example, it returns an empty named vector because no values meet your condition
max(last_residual)
# [1] 31.70949
min(sigma_vector)
# [1] 52.93234
# To demonstrate that it works, let's devide sigma by 2 so that at least some values will pass
half_sigma <- sigma_vector/2
Watchlist2 <- sigma_vector[last_residual > half_sigma]
Watchlist2
# OptionDOptionA OptionDOptionB OptionDOptionC
# 54.52411 57.09503 56.79341
I'm trying to "pseudo-randomize" a vector in R using a while loop.
I have a vector delays with the elements that need to be randomized.
I am using sample on a vector values to index randomly into delays. I cannot have more than two same values in a row, so I am trying to use an if else statement. If the condition are met, the value should be added to random, and removed from delays.
When I run the individual lines outside the loop they are all working, but when I try to run the loop, one of the vector is populated as NA_real, and that stops the logical operators from working.
I'm probably not great at explaining this, but can anyone spot what I'm doing wrong? :)
delay_0 <- rep(0, 12)
delay_6 <- rep(6, 12)
delays <- c(delay_6, delay_0)
value <- c(1:24)
count <- 0
outcasts <- c()
random <- c(1,2)
while (length(random) < 27) {
count <- count + 1
b <- sample(value, 1, replace = FALSE)
a <- delays[b]
if(a == tail(random,1) & a == head(tail(random,2),1) {
outcast <- outcasts + 1
}
else {
value <- value[-(b)]
delays <- delays[-(b)]
random <- c(random,a)
}
}
Two problems with your code:
b can take a value that is greater than the number of elements in delays. I fixed this by using sample(1:length(delays), 1, replace = FALSE)
The loop continues when delays is empty. You could either change length(random) < 27 to length(random) < 26 I think or add length(delays) > 0.
The code:
delay_0 <- rep(0, 12)
delay_6 <- rep(6, 12)
delays <- c(delay_6, delay_0)
value <- c(1:24)
count <- 0
outcasts <- c()
random <- c(1, 2)
while (length(random) < 27 & length(delays) > 0) {
count <- count + 1
b <- sample(1:length(delays), 1, replace = FALSE)
a <- delays[b]
if (a == tail(random, 1) & a == head((tail(random, 2)), 1))
{
outcast <- outcasts + 1
}
else {
value <- value[-(b)]
delays <- delays[-(b)]
random <- c(random, a)
}
}
I would like to take input from a dataframe with a systemName variable and a popNum variable and use this to generate a named list of vectors whose elements are the random numbers (1-6)*5 ie (5, 10, 15, 20, 25, 30) where the vector length is equal to the popNum of the system.
The following code works:
## Data
#Create a vector of integers
popNum <- c (2,5,3,9)
#Create corresponding names
systemNames <- c("Ruie", "Regina", "Roupe", "Efate")
# form up into a recatangular data frame
dataSource <- cbind.data.frame(systemNames,popNum )
## Create and Fill the List
#initialise the list
availableCargoes <- vector( mode = "list", length = nrow(dataSource))
#name the list
names(availableCargoes) <- dataSource$systemNames
#fill the list
for (loopCounter in 1:nrow(dataSource)) {
availableCargoes[[loopCounter]] <- sample.int( n = 6,
size = dataSource$popNum[loopCounter],
replace = TRUE) * 5
}
How can I get rid of the for-loop through something from the apply family or the purrr package? The problem I am having a hard time resolving is what is the X that the lapply runs the sample.int over? How do I pass the vector of popNum as an argument to control the size of the resulting vectors?
Use lapply to loop directly through dataSource$popNum.
Note that I set the RNG seed to make the results reproducible.
set.seed(1234)
for (loopCounter in 1:nrow(dataSource)) {
availableCargoes[[loopCounter]] <- sample.int( n = 6,
size = dataSource$popNum[loopCounter],
replace = TRUE) * 5
}
set.seed(1234)
ac <- lapply(dataSource$popNum, function(s)
sample.int(n = 6, size = s, replace = TRUE)*5)
names(ac) <- dataSource$systemNames
ac
identical(availableCargoes, ac)
#[1] TRUE
sapply version
## Data
#Create a vector of integers
popNum <- c (2,5,3,9)
#Create corresponding names
systemNames <- c("Ruie", "Regina", "Roupe", "Efate")
# form up into a recatangular data frame
dataSource <- cbind.data.frame(systemNames,popNum )
## Create and Fill the List
#initialise the list
availableCargoes <- vector( mode = "list", length = nrow(dataSource))
#name the list
names(availableCargoes) <- dataSource$systemNames
#fill the list
availableCargoes <- sapply(as.character(dataSource$systemNames),function(sysname){
sample.int( n = 6,
size = dataSource$popNum[dataSource$systemNames==sysname],
replace = TRUE) * 5
},USE.NAMES=T,simplify = F)
This is my code where I explain some parts where I think there is a problem.
set.seed(5623)
t_llegada <- (1:30)
t_viaje <- (1:30)
t_intervalo<- (1:30)
#Prob. morning
pllegadaM <- rexp(30,rate=0.81) #Prob
pviajeM <- rexp(30,rate=30.47) #Prob
pinterM<- rexp(30,rate=0.12) #Prob
#Prob afternoon
pllegadaT <- rexp(30,rate=0.096) #Prob
pviajeT <- rexp(30,rate=31.80) #Prob
pinterT<- rexp(30,rate=0.97) #Prob
#Prob night
pllegadaN <- rexp(30,rate=0.12) #Prob
pviajeN <- rexp(30,rate=32.12) #Prob
pinterN<- rexp(30,rate=0.9) #Prob
sim <-NULL
##Dimension variables:
minutos.dia<-numeric(600)
min.llegada <- minutos.dia
min.salida <- minutos.dia
tinterval <- minutos.dia
tservicio.llegada<-minutos.dia
##Sample time with probs
tintervalM <- sample(t_intervalo,size=1, replace=TRUE, prob= pinterM)
tllegadasM <- sample(t_llegada,size=1,replace = TRUE,prob=pllegadaM)
tviajeM <- sample(t_viaje,size=1,replace = TRUE,prob=pviajeM)
tintervalT <- sample(t_intervalo,size=1, replace=T, prob= pinterT)
tllegadasT <- sample(t_llegada,size=1,replace = TRUE,prob=pllegadaT)
tviajeT <- sample(t_viaje,size=1,replace = TRUE,prob=pviajeT)
tintervalN <- sample(t_intervalo,size=1, replace=T, prob= pinterN)
tllegadasN <- sample(t_llegada,size=1,replace = TRUE,prob=pllegadaN)
tviajeN <- sample(t_viaje,size=1,replace = TRUE,prob=pviajeN)
##Count first person
min.llegada[1]<- 1
tinterval[1]<- 1
min.salida[1]<-tinterval[1]+tviajeM[1]
###Save in data frame "Sim"
uno <- data.frame (caso = 1,
minuto_llegada = min.llegada[1],
minuto_inicio_del_viaje = tinterval[1],
Tiempo_viaje = tviajeM [1],
minuto_salida_del_cliente = min.salida[1])
sim <- rbind(sim, uno)
##Loop to asigne probs acording to number cases
for (c in 2:600){
tllegadasM[c] <- if(c <300){sample(t_llegada,size=1,replace =TRUE,prob=pllegadaM)#VAL 2
} else{
sample(t_llegada,size=1,replace = TRUE,prob=pllegadaT)}
tviajeM[c] <- if(c<300){sample(t_viaje,size=1,replace = TRUE,prob=pviajeM)#VAL 3
}
else{
sample(t_viaje,size=1,replace = TRUE,prob=pviajeT)}
tintervalM[c]<-if(c <300){sample(t_intervalo,size=1, replace=TRUE, prob=pinterM)#VAL 2
} else{
sample(t_intervalo,size=1, replace=T, prob= pinterT)
}}
I previously asgined the number aleat. to the variable tintervalM, and in the second loop I suposed to I only pick the number from the variables aleats. an just sum. I hope to be well explained and be helped.
#Loop for times
for (c in 3:600){
min.llegada[c]<-min.llegada[c-1]+tllegadasM[c] #VAL 1
tinterval[c]<-if(min.llegada[c-1]>tinterval[c-1]){
tinterval[c-1]+ tintervalM[c]+tintervalM[c+1]} #VAL 2 HERE IS THE PROBLEM
min.salida[c]<-tinterval[c]+tviajeM[c] #VAL 4
nuevo <- data.frame (caso = c,
minuto_llegada = min.llegada[c],#1
minuto_inicio_del_viaje = tinterval[c],#2
Tiempo_viaje = tviajeM [c],#3
minuto_salida_del_cliente = min.salida[c])#4
sim <- rbind(sim, nuevo)
}
I want to asigne the sum of the previos number of tinterval[c-1] plus the number generated by tintervalM[c] and plus next number generated by tintervalM[c] to the variable tinterval[c] if min.salida[c] is greater than tinverval[c],but i recive the error has length zero,
Despite not understanding what your code does, I think I can point to the error. This part will fail if the condition within if in not TRUE.
tinterval[c] <- if(min.llegada[c-1]>tinterval[c-1]){
tinterval[c-1] + tintervalM[c] + tintervalM[c+1]
} #VAL 2 HERE IS THE PROBLEM
If the condition is FALSE, the if clause returns NULL and it cannot be assigned to tinterval[c].
How I guess it should be written is as follow
if( min.llegada[c-1] > tinterval[c-1] ){
tinterval[c] <- tinterval[c-1] + tintervalM[c] + tintervalM[c+1]
}
Now if the condition is FALSE, nothing happens.
my problem is similar to the question as followingthe problem of R-input Format
I have tried the above code in the above link and revised some part to suit my data. my data is like follow
I want my data can be created as a data frame with 4 variable vectors. The code what I have revised is
formatMhsmm <- function(data){
nb.sequences = nrow(data)
nb.variables = ncol(data)
data_df <- data.frame(matrix(unlist(data), ncol = 4, byrow = TRUE))
# iterate over these in loops
rows <- 1: nb.sequences
# build vector with id value
id = numeric(length = nb.sequences)
for( i in rows)
{
id[i] = data_df[i,2]
}
# build vector with time value
time = numeric (length = nb.sequences)
for( i in rows)
{
time[i] = data_df[i,3]
}
# build vector with observation values
sequences = numeric(length = nb.sequences)
for(i in rows)
{
sequences[i] = data_df[i, 4]
}
data.df = data.frame(id,time,sequences)
# creation of hsmm data object need for training
N <- as.numeric(table(data.df$id))
train <- list(x = data.df$sequences, N = N)
class(train) <- "hsmm.data"
return(train)
}
library(mhsmm)
dataset <- read.csv("location.csv", header = TRUE)
train <- formatMhsmm(dataset)
print(train)
The output observation is not the data of 4th col, it's a list of (4, 8, 12,...,396, 1, 1, ..., 56, 192,...,6550, 68, NA, NA,...) It has picked up 1/4 data of each col. Why it is like this?
Thank you very much!!!!
Why don't you simply count yout observations by Id, and create the hsmm.data object directly? Supposing yout dataframe is called "data", we have:
N <- as.numeric(table(data$id))
train <- list(x=data$location, N = N)
class(train) <- "hsmm.data"
Extracted from http://www.jstatsoft.org/v39/i04/paper