Brief description:
I got a matrix based on action and states (1:25, nrow 5) and i want to be able to select the upcoming row (so whenever i am sitting on the first row no matter position i want to have an output of all the positions in the next row, example input function number 8, output = 4 9 14 19 24). Came up with a logical function but whenever i run it i get an error in environment_mat$cellnumb, $ operator is invalid for atomic vectors....
Can you maybe help a lad out here?
states <- seq(1,5, by = 1)
actions <- seq(1,5, by = 1)
state_sequence <- cbind(merge(states,states), state = seq(1, length(states)*length(actions)))
environment_mat <- matrix(state_sequence$state, nrow = length(states), ncol= length(actions))
rewards_mat <- matrix(data = c(-100,10,50,16,32,40,-100,80,41,7,50,1,-100,
85,2,16,98,4,-100,8,32,45,95,78,-100), nrow = 5)
environment_mat
nextCells <- function(curCell) {
nexSta <- seq(0, max(states)-1, by = 1)*max(states)+
environment[environment_mat$cellnum == curCell,]$y
return(nexSta)
}
nextCells(24)
As explained above i tried multiple things but i cannot come up with another logical function than this
You may be looking for the modulo operator %%.
nextCells <- function(curCell) {
environment_mat[(which(environment_mat == curCell) - 1L) %% nrow(environment_mat) + 2L,]
}
nextCells(24)
#> [1] 5 10 15 20 25
nextCells(8)
#> [1] 4 9 14 19 24
Or, more simply:
nextCells <- function(curCell) {
environment_mat[(curCell - 1L) %% nrow(environment_mat) + 2L,]
}
nextCells(24)
#> [1] 5 10 15 20 25
nextCells(8)
#> [1] 4 9 14 19 24
Related
I'm trying to create a function to linearly spline a variable in an h2o dataset, but can't get h2o to evaluate the function properly.
Here's my initial attempt on intermediate spline:
df <- data.frame( AGE = sample(1:100, 1e6, replace = TRUE))
df_A.hex <- as.h2o( df, 'df_A.hex' )
simple_spline <- function( x, L, U ) min( max(x-L,0), U-L)
spline_vector <- Vectorize( simple_spline, vectorize.args = 'x', USE.NAMES = FALSE )
df_A.hex[, 'AGE_12_24'] <- spline_vector( df_A.hex[, 'AGE'], 12, 24)
And here is the result:
AGE AGE_12_24
1 9 12
2 7 12
3 33 12
4 84 12
5 86 12
6 25 12
I tried using pmin and pmax, on the assumption that maybe it wasn't vectorizing the columns, but I get the following error:
> simple_spline <- function( x, L, U ) pmin( pmax(x-L,0), U-L)
> df_A.hex[, 'AGE_12_24'] <- simple_spline( df_A.hex[, 'AGE'], 12, 24)
Error in each[change] : invalid subscript type 'environment'
I'm guessing it's because the pmin and pmax aren't implemented in h2o?
I also tried using apply, but also hit an error:
> simple_spline <- function( x, L, U ) min( max(x-L,0), U-L)
> df_A.hex[, 'AGE_12_24'] <- apply( df_A.hex[, 'AGE'], 1, simple_spline, 12, 24)
> [1] "Lookup failed to find min"
Error in .process.stmnt(stmnt, formalz, envs) :
Don't know what to do with statement: min
I could write a function that iteratively overwrites the spline column like so:
df_A.hex[, 'AGE_12_24'] <- df_A.hex[, 'AGE'] - 12
df_A.hex[, 'AGE_12_24'] <- h2o.ifelse( df_A.hex[, 'AGE_12_24'] < 0, 0, df_A.hex[, 'AGE_12_24'] )
df_A.hex[, 'AGE_12_24'] <- h2o.ifelse( df_A.hex[, 'AGE_12_24'] > 12, 12, df_A.hex[, 'AGE_12_24'] )
This gets me my expected result:
AGE AGE_12_24
1 9 0
2 7 0
3 33 12
4 84 12
5 86 12
6 25 12
But it's a fairly ugly way of getting there. I'd like to know what I'm doing wrong and how to have a function pass on the values to the h2o frame.
Unfortunately you can't pass additional parameters to the H2O R apply() method (I've reported the bug here).
and even if you hardcode the original parameters to get the apply method to evaluate it, it won't evaluate correctly:
library(h2o)
h2o.init()
df <- data.frame( AGE = c(9,7,33,84,86,25))
df_A.hex <- as.h2o( df, 'df_A.hex' )
L = 12
U = 24
simple_spline <- function(x) { min( max(x-L,0), U-L )}
apply(df_A.hex, 1, simple_spline)
C1
1 -3
2 -5
3 21
4 72
5 74
6 13
I think your best bet is to use your iterative method, or play around with the apply method (not passing additional parameters) until you can trust the results you see.
I have question on replacing the value in between the vectors.
The algorithm should find that replacement number when the certain condition is met. In this case finding the number which makes the difference -20 with the previous number. So I prefer to use diff function.
Here is what I mean
x <- c(20,20,0,20,0,5)
> diff(x)
[1] 0 -20 20 -20 5
So in this case 0 makes the difference -20 and I want to change those 0s to 20.
. I know the easiest solution is the directly assigning x[3] <- 20 or x[5] <- 20
However, the 0 location is always different so I need an automated process that can do that. Thanks!
**EDIT
if we need to do this in a grouped data.frame
> df
x gr
1 20 1
2 20 1
3 0 1
4 20 1
5 0 1
6 5 1
7 33 2
8 0 2
9 20 2
10 0 2
11 20 2
12 0 2
How can we implement this ?
modify <- function(x){
value_search = c(0, 33)
value_replacement = c(20, 44)
for (k in 1:length(value_search)) {
index_position = which(x %in% value_search[k])
replacement = value_replacement[k]
for (i in index_position) {
x[i] = replacement
}
}
}
df%>%
group_by(gr)%>%
mutate(modif_x=modify(x))
Error in mutate_impl(.data, dots) :
Evaluation error: 'match' requires vector arguments.
You can do it using which to get the position, i.e.
x[which(diff(x) == -20)+1] <- 20
x
#[1] 20 20 20 20 20 5
if you want a generic way to replace values of a vector based on particular values, i would approach it this way.
x = c(20,20,0,20,0,5)
value_search = 0
value_replacement = 20
index_position = which(x %in% value_search)
for (i in index_position) {
x[i] = value_replacement
}
but this works for single values. if you want to look for multiple values, you can use a nested loop as below:
x = c(20,20,0,20,0,5,33)
value_search = c(0, 33)
value_replacement = c(20, 44)
for (k in 1:length(value_search)) {
index_position = which(x %in% value_search[k])
replacement = value_replacement[k]
for (i in index_position) {
x[i] = replacement
}
}
in response to OP's edits:
any number of ways to do this:
x = c(20,20,0,20,0,5,33)
gr = c(1,1,1,1,2,2,2)
df = data.frame(x, gr)
func_replace <- function(source, value_search, value_replacement) {
for (k in 1:length(source)) {
index_position = which(x %in% value_search[k])
replacement = value_replacement[k]
for (i in index_position) {
source[i] = replacement
} # for i loop
} # for k loop
return(source)
} # func_replace
value_search = c(0, 33)
value_replacement = c(20, 44)
gr_value = 1
df$replacement = with(df, ifelse(gr == gr_value, sapply(df, FUN = function(x) func_replace(x, value_search, value_replacement)), NA))
So i've written this basic code that sorts a list using the well-known merge-sorting algorithm, i've defined two functions mergelists that compares and merges the elements and mergesort that divides the list into single elements:
mergelists <- function(a,b) {
al <- length(a)
bl <- length(b)
r <- numeric(al+bl)
ai <- 1
bi <- 1
j <- 1
while((ai<=al) && (bi<=bl)) {
if(a[ai]<b[bi]) {
r[j] <- a[ai]
ai <- ai+1
} else {
r[j] <- b[bi]
bi <- bi+1
}
j <- j+1
}
if(ai<=al) r[j:(al+bl)] <- a[ai:al]
else if(bi<=bl) r[j:(al+bl)] <- b[bi:bl]
return(r)
}
mergesort <- function(x) {
l <- length(x)
if(l>1) {
p <- ceiling(l/2)
a <- mergesort(x[1:p])
b <- mergesort(x[(p+1):l])
return(mergelists(a,b))
}
return(x)
}
this seems to work fine for the examples i used so far, for example:
> mergesort(c(11,10,9,15,6,12,17,8,19,7))
[1] 6 7 8 9 10 11 12 15 17 19
now for the sake of some research i'm doing, i want to change this code to work with R-lists and not vectors, the lists are usually defined as following:
> list(number=10,data=c(10,5,8,2))
$number
[1] 10
$data
[1] 10 5 8 2
data represents here the vector and number is the number of comparaisons.
After the change i imagine that the program should give me something like this:
>mergelists(list(number=8,data=c(1,3,5,8,9,10)),list(number=5,data=c(2,4,6,7)))
$number
[1] 20
$data
[1] 1 2 3 4 5 6 7 8 9 10
> mergesort(c(11,10,9,15,6,12,17,8,19,7))
$number
[1] 22
$data
[1] 6 7 8 9 10 11 12 15 17 19
the 20 here is basically 8 + 5 + 7, because 7 comparaisons would be necessary to merge the two sorted lists, but i don't know how to do this because i have a little experience with R-lists. i would appreciate your help. Thanks.
The starting point for any vector vec is list(number = 0, data = vec), where number is 0 because it as taken 0 comparisons to start with an unsorted vector.
You first need to modify mergelists to deal with two lists, simply by adding the indexing and then reforming the list at the end.
mergelists <- function(a,b) {
firstn <- a$number + b$number
a <- a$data
b <- b$data
al <- length(a)
bl <- length(b)
r <- numeric(al+bl)
ai <- 1
bi <- 1
j <- 1
while((ai<=al) && (bi<=bl)) {
if(a[ai]<b[bi]) {
r[j] <- a[ai]
ai <- ai+1
} else {
r[j] <- b[bi]
bi <- bi+1
}
j <- j+1
}
if(ai<=al) r[j:(al+bl)] <- a[ai:al]
else if(bi<=bl) r[j:(al+bl)] <- b[bi:bl]
return(list(number = firstn + j - 1L, data = r))
}
mergelists(list(number=8,data=c(1,3,5,8,9,10)), list(number=5,data=c(2,4,6,7)))
# $number
# [1] 20
# $data
# [1] 1 2 3 4 5 6 7 8 9 10
Now that you have the "base function" defined, you need the calling function to generate the enhanced vector (list) and pass it accordingly. This function can easily be improved for efficiency, but I think its recursive properties are sound.
mergesort <- function(x) {
# this first guarantees that if called with a vector, it is list-ified,
# but if called with a list (i.e., every other time in the recursion),
# the argument is untouched
if (! is.list(x)) x <- list(number = 0, data = x)
l <- length(x$data)
if (l > 1) {
p <- ceiling(l/2)
# the `within(...)` trick is a sneaky trick, can easily be
# handled with pre-assignment/subsetting
a <- mergesort(within(x, { data <- data[1:p]; }))
b <- mergesort(within(x, { data <- data[(p+1):l]; }))
return(mergelists(a,b))
}
return(x)
}
mergesort(c(11,10,9,15,6,12,17,8,19,7))
# $number
# [1] 22
# $data
# [1] 6 7 8 9 10 11 12 15 17 19
I have a vector 'participant' in R.
> participant
[1] 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24
I am using a function 'modify' to change the contents of this vector.
modify <- function(x){
for (i in participant){
if (x[i] > 12)
(x[i]=x[i]-12)
print (x[i])
}}
When I run the function as modify(participant), it runs OK, but the elements of the vector participant remain unchanged.
Any suggestion, for where am I going wrong ?
Don't use a loop.
participant <- participant - (participant > 12) * 12
If you insist on using your function, loop over the indices, let you function return the modified vector and assign it:
modify <- function(x){
for (i in seq_along(participant)){
if (x[i] > 12) x[i]=x[i]-12
}
return(x)
}
participant <- modify(participant)
Of course, the loop is more difficult to write and also much slower.
Your problem is the function return. Use this solution, so the function returns the modified vector x:
modify <- function(x){
for (i in participant){
if (x[i] > 12)
(x[i] = x[i] - 12)
print (x[i])}
return(x)
}
participant <- modify(participant)
Another solution is the ifelse function:
participant <- ifelse(participant > 12, participant - 12, participant)
I want to create a double sliding window in a for loop. An example data set might look like:
a <- structure(list(a = c(0.0961136, 0.1028192, 0.1106424, 0.1106424,
0.117348, 0.117348, 0.117348, 0.122936, 0.1307592, 0.1307592,
0.1318768, 0.1318768, 0.1385824, 0.1385824, 0.1318768, 0.1251712,
0.1251712, 0.1251712, 0.1251712, 0.1251712)), .Names = "a", row.names = c(NA,
-20L), class = "data.frame")
The code I have so far looks like this:
windowSize <- 5
windowStep <- 1
dat <- list()
for (i in seq(from = 1, to = nrow(a), by = windowStep)){
window1 <- a[i:windowSize, ]
window2 <- a[i:windowSize + windowSize, ]
if (median(window1) <= 0.12 && (median(window1) >= 0.08)) {
p <- "True"
} else
p <- "not"
dat[[i]] <- c(p)
}
result <- as.data.frame(do.call(rbind, dat))
This example shows that I require two windows of size 5 (data points) to slide one in front of the other by 1 data point at a time. This example does not utilize window 2 because it doesn't work!(I will need it to work eventually) However using just window1 to calculate the median (in this case) at each step works but the output is incorrect. The if statements ask that if the median of window 1 is between 0.08 and 0.12 then output "True" else "not."
Output for my for loop =
1 True
2 True
3 True
4 True
5 True
6 True
7 True
8 True
9 True
10 not
11 not
12 not
13 not
14 not
15 not
16 not
17 not
18 not
19 not
20 not
Correct output as checked using rollapply (and obviously can be seen by eye)
rollapply(a, 5, FUN = median, by = 1, by.column = TRUE, partial = TRUE, align = c("left"))
should be:
1 True
2 True
3 True
4 not
5 not
6 not
7 not
8 not
9 not
10 not
11 not
12 not
13 not
14 not
15 not
16 not
17 not
18 not
19 not
20 not
Could the solution remain as a for loop if possible as I have much more to add but need to get this right first. Thanks.
This gets close..modified from: https://stats.stackexchange.com/questions/3051/mean-of-a-sliding-window-in-r
windowSize <- 10
windowStep <- 1
Threshold <- 0.12
a <- as.vector(a)
data <- a
slideFunct <- function(data, windowSize, WindowStep){
total <- length(data)
dataLength <- seq(from=1, to=(total-windowSize), by=windowStep)
result <- vector(length = length(dataLength))
for(i in 1:length(dataLength)){
result[i] <- if (median(data[dataLength[i]:(dataLength[i]+windowSize)]) <= Threshold)
result[i] <- "True"
else
result[i] <- "not"
}
return(result)
}