So what I just did is this:
s1 <- seq(1, 3, by = 0.5)
rep(s1, 3)
# [1] 1.0 1.5 2.0 2.5 3.0 1.0 1.5 2.0 2.5 3.0 1.0 1.5 2.0 2.5 3.0
s2 <- seq(-4, 4, by = 2)
rep(s2, each = 3)
# [1] -4 -4 -4 -2 -2 -2 0 0 0 2 2 2 4 4 4
Now I should code something that in the end should look like this:
1 2 3 4 5 2 3 4 5 6 3 4 5 6 7 4 5 6 7 8 5 6 7 8 9
1 to 5 5 times but the 1st number should always increase by 1.
How can I do that?
I guess you can try embed like below
> n <- 5
> c(embed(seq(n + 4), n)[, n:1])
[1] 1 2 3 4 5 2 3 4 5 6 3 4 5 6 7 4 5 6 7 8 5 6 7 8 9
Use mapply :
inds <- 1:5
c(mapply(seq, inds, inds + 4))
#[1] 1 2 3 4 5 2 3 4 5 6 3 4 5 6 7 4 5 6 7 8 5 6 7 8 9
Add to a corresponding matrix the cols.
m <- matrix(0:4, 5, 5)
as.vector(m + col(m))
# [1] 1 2 3 4 5 2 3 4 5 6 3 4 5 6 7 4 5 6 7 8 5 6 7 8 9
We can use rep
n <- 5
seq_len(n) + rep(0:4, each = n)
#[1] 1 2 3 4 5 2 3 4 5 6 3 4 5 6 7 4 5 6 7 8 5 6 7 8 9
Related
This question already has answers here:
R repeating sequence add 1 each repeat
(2 answers)
Closed 5 months ago.
Suppose that I am not allowed to use the c() function.
My target is to generate the vector
"1 2 3 4 5 2 3 4 5 6 3 4 5 6 7 4 5 6 7 8 5 6 7 8 9"
Here is my attempt:
rep(seq(1, 5, 1), 5)
# [1] 1 2 3 4 5 1 2 3 4 5 1 2 3 4 5 1 2 3 4 5 1 2 3 4 5
rep(0:4,rep(5,5))
# [1] 0 0 0 0 0 1 1 1 1 1 2 2 2 2 2 3 3 3 3 3 4 4 4 4 4
So basically I am sum them up. But I wonder if there is a better way to use rep and seq functions ONLY.
Like so:
1:5 + rep(0:4, each = 5)
# [1] 1 2 3 4 5 2 3 4 5 6 3 4 5 6 7 4 5 6 7 8 5 6 7 8 9
I like the sequence option as well:
sequence(rep(5, 5), 1:5)
You could do
rep(1:5, each=5) + rep.int(0:4, 5)
# [1] 1 2 3 4 5 2 3 4 5 6 3 4 5 6 7 4 5 6 7 8 5 6 7 8 9
Just to be precise and use seq as well:
rep(seq.int(1:5), each=5) + rep.int(0:4, 5)
(PS: You can remove the .ints, but it's slower.)
One possible way:
as.vector(sapply(1:5, `+`, 0:4))
[1] 1 2 3 4 5 2 3 4 5 6 3 4 5 6 7 4 5 6 7 8 5 6 7 8 9
I would also propose the outer() function as well:
library(dplyr)
outer(1:5, 0:4, "+") %>%
array()
Or without magrittr %>% function in newer R versions:
outer(1:5, 0:4, "+") |>
array()
Explanation.
The first function will create an array of 1:5 by 0:4 sequencies and fill the intersections with sums of these values:
[,1] [,2] [,3] [,4] [,5]
[1,] 1 2 3 4 5
[2,] 2 3 4 5 6
[3,] 3 4 5 6 7
[4,] 4 5 6 7 8
[5,] 5 6 7 8 9
The second will pull the vector from the array and return the required vector:
[1] 1 2 3 4 5 2 3 4 5 6 3 4 5 6 7 4 5 6 7 8 5 6 7 8 9
For a high number of time series, I want to optimize the smoothing parameters of the Holt-Winter's forecasting method so that I get one set of optimal parameters. There are three parameters: alpha, beta, and gamma. Below I present a simplified procedure for one time series to indicate the problems encountered. I create a seasonal time series as follows:
check_vec <- rep(c(7,6,5,4,3,2,1), times = 100)
check_ts <- ts(check_vec, frequency = 7)
The time series looks like the following.
Time Series:
Start = c(1, 1)
End = c(100, 7)
Frequency = 7
[1] 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6
[52] 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4
[103] 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2
[154] 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7
[205] 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5
[256] 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3
[307] 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1
[358] 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6
[409] 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4
[460] 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2
[511] 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7
[562] 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5
[613] 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3
[664] 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1 7 6 5 4 3 2 1
Then, I use the following function to use for optimization:
check_func <- function(param) {
a <- param[[1]]
b <- param[[2]]
c <- param[[3]]
if (c > 1 - a | a < b) {
return(100000)
} else {
rmse <- accuracy(hw(check_ts, h = 14, alpha = a, beta = b, gamma = c))[2]
return(rmse)
}
}
The function thus returns the root mean squared error (which I want to minimize). It returns different values for different inputs.
> check_func(c(a = 0.18, b = 0.07, c = 0.1))
[1] 3.77942e-16
> check_func(c(a = 0.18, b = 0.07, c = 0.2))
[1] 3.382083e-16
I use the following optim() command to optimize the parameters:
optim(par = c(a = 0.18, b = 0.07, c = 0.1),
fn = check_func,
lower = c(0.005,0.005,0.005),
upper = c(0.99, 0.99, 0.99),
method = "L-BFGS-B",
control = list(trace = 6,
pgtol = 1.490117e-08))
Executing the optim() command gives the initial parameters as result (that is zero iterations of the optimization procedure. It returns the following message.
N = 3, M = 5 machine precision = 2.22045e-16
L = 0.005 0.005 0.005
X0 = 0.18 0.07 0.1
U = 0.99 0.99 0.99
At X0, 0 variables are exactly at the bounds
At iterate 0 f= 37.794 |proj g|= 0
iterations 0
function evaluations 1
segments explored during Cauchy searches 0
BFGS updates skipped 0
active bounds at final generalized Cauchy point 0
norm of the final projected gradient 0
final function value 37.7942
X = 0.18 0.07 0.1
F = 37.7942
final value 37.794202
converged
$par
a b c
0.18 0.07 0.10
$value
[1] 37.7942
$counts
function gradient
1 1
$convergence
[1] 0
$message
[1] "CONVERGENCE: NORM OF PROJECTED GRADIENT <= PGTOL"
I have tried to increase the scale of the output of the function and decrease pgtol without any success. Does somebody know what to do?
EDIT I have added more code and results of the procedure I found.
EDIT 2 This is the modified check_func I use to test whether the method of Enrico works.
check_func <- function(param) {
a <- param[[1]]
b <- param[[2]]
c <- param[[3]]
rmse <- try(accuracy(hw(check_ts, h = 14, alpha = a, beta = b, gamma = c))[2])
if (inherits(rmse, "try-error"))
return(200)
else
return(rmse)
}
You might get more-helpful answers if you provided a reproducible example. Are accuracy and hw from package forecast? In any case, you could try a grid search:
library("NMOF")
res <- gridSearch(check_func,
lower = rep(0.05, 3),
upper = rep(0.99, 3),
n = 10)
## List of 4
## $ minfun : num 4.11e-17
## $ minlevels: num [1:3] 0.05 0.05 0.886
## $ values : num [1:1000] 3.81e-16 3.81e-16 ...
## $ levels :List of 1000
## ..$ : num [1:3] 0.05 0.05 0.05
## ..$ : num [1:3] 0.154 0.05 0.05
## ..$ : num [1:3] 0.259 0.05 0.05
For many parameter choices, check_func would fail. So I'd safeguard the computation with something like:
rmse <- try(accuracy(hw(check_ts, h = 14, alpha = a, beta = b, gamma = c))[2])
if (inherits(rmse, "try-error"))
return(200)
(Disclosure: I am the maintainer of package NMOF.)
I am new to R. In JAVA I would introduce a control variable to create a sequence such as
1 2 3 4 5 2 3 4 5 6 3 4 5 6 7 4 5 6 7 8 5 6 7 8 9
I was thinking on doing something like
seq(from=c(1:5),to=c(5,10),by=1)
However that does not work...
Can that be solved purely with seq and rep?
How about this?
rep(0:4, each=5)+seq(from=1, to=5, by=1)
[1] 1 2 3 4 5 2 3 4 5 6 3 4 5 6 7 4 5 6 7 8 5 6 7 8 9
Try this. You can create a function to create the sequence and apply to an initial vector v1. Here the code:
#Data
v1 <- 1:5
#Code
v2 <- c(sapply(v1, function(x) seq(from=x,by=1,length.out = 5)))
Output:
[1] 1 2 3 4 5 2 3 4 5 6 3 4 5 6 7 4 5 6 7 8 5 6 7 8 9
And the way using seq() and rep() can be:
#Code2
rep(1:5, each = 5) + 0:4
Output:
[1] 1 2 3 4 5 2 3 4 5 6 3 4 5 6 7 4 5 6 7 8 5 6 7 8 9
Using outer is pretty concise:
c(outer(1:5, 0:4, `+`))
#> [1] 1 2 3 4 5 2 3 4 5 6 3 4 5 6 7 4 5 6 7 8 5 6 7 8 9
Note, 0:4 is short for seq(from = 0, to = 4, by = 1)
A perfect use case for Map or mapply. I always prefer Map because it does not simplify the output by default.
Map(seq, from = 1:5, to = 5:9)
[[1]]
[1] 1 2 3 4 5
[[2]]
[1] 2 3 4 5 6
[[3]]
[1] 3 4 5 6 7
[[4]]
[1] 4 5 6 7 8
[[5]]
[1] 5 6 7 8 9
You can use unlist() to get it the way you want.
unlist(Map(seq, from = 1:5, to = 5:9))
[1] 1 2 3 4 5 2 3 4 5 6 3 4 5 6 7 4 5 6 7 8 5 6 7 8 9
Note that `by = 1`, the default.
For each row in the matrix "result" shown below
A B C D E F G H I J
1 4 6 3 5 9 9 9 3 4 4
2 5 7 5 5 8 8 8 7 4 5
3 7 5 4 4 7 9 7 4 4 5
4 6 6 6 6 8 9 8 6 3 6
5 4 5 5 5 8 8 7 4 3 7
6 7 9 7 6 7 8 8 5 7 6
7 5 6 6 5 8 8 7 3 3 5
8 6 7 4 5 8 9 8 4 6 5
9 6 8 8 6 7 7 7 7 6 6
I would like to plot a histogram for each row with 3 bins as shown below:
samp<-result[1,]
hist(samp, breaks = 3, col="lightblue", border="pink")
Now what is needed is to convert the histogram frequency counts into an array as follows
If I have say 4 bins and say first bin has count=5 and second bin has a count=2 and fourth bin=3. Now I want a vector of all values in each of these bins, coming from data result(for every row) in a vector as my output.
row1 5 2 0 3
For hundreds of rows I would like to do it in an automated way and hence posted this question.
In the end the matrix should look like
bin 2-4 bin 4-6 bin6-8 bin8-10
row 1 5 2 0 3
row 2
row 3
row 4
row 5
row 6
row 7
row 8
row 9
DF <- read.table(text="A B C D E F G H I J
1 4 6 3 5 9 9 9 3 4 4
2 5 7 5 5 8 8 8 7 4 5
3 7 5 4 4 7 9 7 4 4 5
4 6 6 6 6 8 9 8 6 3 6
5 4 5 5 5 8 8 7 4 3 7
6 7 9 7 6 7 8 8 5 7 6
7 5 6 6 5 8 8 7 3 3 5
8 6 7 4 5 8 9 8 4 6 5
9 6 8 8 6 7 7 7 7 6 6", header=TRUE)
m <- as.matrix(DF)
apply(m,1,function(x) hist(x,breaks = 3)$count)
# $`1`
# [1] 5 2 0 3
#
# $`2`
# [1] 5 0 2 3
#
# $`3`
# [1] 6 3 1
#
# $`4`
# [1] 1 6 2 1
#
# $`5`
# [1] 3 3 4
#
# $`6`
# [1] 3 4 2 1
#
# $`7`
# [1] 2 5 3
#
# $`8`
# [1] 6 3 1
#
# $`9`
# [1] 4 4 0 2
Note that according to the documentation the number of breaks is only a suggestion. If you want to have the same number of breaks in all rows, you should do the binning outside of hist:
breaks <- 1:5*2
t(apply(m,1,function(x) table(cut(x,breaks,include.lowest = TRUE))))
# [2,4] (4,6] (6,8] (8,10]
# 1 5 2 0 3
# 2 1 4 5 0
# 3 4 2 3 1
# 4 1 6 2 1
# 5 3 3 4 0
# 6 0 3 6 1
# 7 2 5 3 0
# 8 2 4 3 1
# 9 0 4 6 0
You could access the counts vector which is returned by hist (see ?hist for details):
counts <- hist(samp, breaks = 3, col="lightblue", border="pink")$counts
This is purely a curiosity (learning more about Reduce). There are way better methods to achieve what I'm doing and I am not interested in them.
Some people use a series of nested ifelse commands to recode/look up something. Maybe it looks like this:
set.seed(10); x <- sample(letters[1:10], 300, T)
ifelse(x=="a", 1,
ifelse(x=="b", 2,
ifelse(x=="c", 3,
ifelse(x=="d", 4, 5))))
Is there a way to use either do.call or Reduce with the ifelse to get the job done a little more eloquently?
Try this:
> library(gsubfn)
> strapply(x, ".", list(a = 1, b = 2, c = 3, d = 4, 5), simplify = TRUE)
[1] 5 4 5 5 1 3 3 3 5 5 5 5 2 5 4 5 1 3 4 5 5 5 5 4 5 5 5 3 5 4 5 1 2 5 5 5 5
[38] 5 5 5 3 3 1 5 3 2 1 5 2 5 4 5 3 5 2 5 5 5 4 5 1 2 5 4 5 5 5 5 1 3 1 5 5 5
[75] 1 5 4 5 3 3 5 5 3 5 3 1 5 3 2 2 5 5 5 5 4 5 3 5 5 1 4 1 4 5 5 5 5 5 5 5 5
[112] 5 2 5 5 5 3 5 5 5 2 4 4 5 3 3 5 4 5 5 5 1 5 3 4 3 5 5 2 5 5 3 1 5 2 5 5 5
[149] 1 5 5 2 1 2 4 2 2 3 5 2 5 5 5 5 5 3 5 5 5 5 5 5 5 5 5 5 2 3 5 4 4 2 5 5 5
[186] 5 5 5 5 2 1 1 1 5 5 5 5 3 5 5 3 5 5 5 2 5 5 5 3 5 5 5 5 5 1 5 5 5 5 2 2 5
[223] 5 5 4 3 4 5 5 4 5 5 5 3 5 3 5 5 5 5 4 5 5 1 5 5 2 5 5 5 2 5 5 3 2 5 4 5 2
[260] 5 5 3 5 5 1 4 3 5 4 5 2 5 5 3 5 5 5 5 5 1 1 5 2 5 1 5 5 5 5 5 5 5 5 5 5 5
[297] 5 1 5 2
Here is an attempt. It is neither beautiful nor does it use ifelse:
f <- function(w,s) {
if(is.null(s$old))
w$output[is.na(w$output)] <- s$new
else
w$output[w$input==s$old] <- s$new
return(w)
}
set.seed(10); x <- sample(letters[1:10], 300, T)
subst <- list(
list(old="a", new=1),
list(old="b", new=2),
list(old="c", new=3),
list(old="d", new=4),
list(old=NULL, new=5)
)
workplace <- list(
input=x,
output=rep(NA, length(x))
)
Reduce(f, subst, workplace)