i want to create an optimal script about 3 parameters in R. These parameters are: n = long of looping, x = any first number, y = any second number. Here the examples:
We can use rep to repeat x and y, n times.
x <- 13
y <- 10
n <- 2
rep(c(x, y), n)
#[1] 13 10 13 10
Using for loop :
vector <- integer(2 * n)
for (i in seq_len(n)) {
vector[c(2 * i -1, 2 * i)] <- c(x, y)
}
vector
#[1] 13 10 13 10
Related
Im trying to write a function based on the Luhn algorithm (mod 10 algorithm), and I need a function that sums all integers > 9 in my number vector individually. E.g. 10 should sum to 1+0=1, and 19 should sum to 1+9=10. Example code:
nmr <- ("1_9_8_2_0_5_0_1_3_3_4_8")
nmr <- strsplit(nmr, "_")
nmr <- as.numeric(as.character(unlist(nmr[[1]])))
luhn_alg <- c(0,0,2,1,2,1,2,1,2,1,2,0)
x <- nmr*luhn_alg
x
[1] 0 0 16 2 0 5 0 1 6 3 8 0
sum(x)
[1] 41
I dont want the sum of x to equal 41. Instead I want the sum to equal: 0+0+1+6+2+0+5+0+1+6+3+8+0=32. I tried with a for loop but doesn't seem to get it right. Any help is much appreciated.
You may need to split the data again after multiplying it with luhn_alg.
Luhn_sum <- function(x, y) {
nmr <- as.numeric(unlist(strsplit(x, "_")))
x1 <- nmr*y
x1 <- as.numeric(unlist(strsplit(as.character(x1), '')))
sum(x1)
}
nmr <- ("1_9_8_2_0_5_0_1_3_3_4_8")
luhn_alg <- c(0,0,2,1,2,1,2,1,2,1,2,0)
Luhn_sum(nmr, luhn_alg)
#[1] 32
You can use substring and seq to create a vector of single digit numbers, then you only need to do a sum over them:
sum(
as.numeric(
substring(
paste(x, collapse = ""),
seq(1, sum(nchar(x)), 1),
seq(1, sum(nchar(x)), 1)
)
)
)
so lets say I have
x = 1,4,2
i = 2
j = 4
k = 3
So i = 2 and j = 4, the point is i need to place k (3) between the numbers i,j in x so the result would be x = 1,4,3,2. I need it to work in a cycle because the numbers in i,j,k always change and so does the length of x when a new number from k is placed in x. The new x after step one is
x = 1,4,3,2 and lets say new values:
i = 4
j = 3
k = 5 so again in the cycle it should place 5 in x between 4 and 3 so final x = 1,4,5,3,2
Is there a way i could do it?
When i is always the number before j,
You could use append function:
ie:
x = c(1,4,2)
i = 4
k = 3
x <- append(x, k, match(i, x))
x
[1] 1 4 3 2
i = 4
k = 5
x <- append(x, k, match(i, x))
x
[1] 1 4 5 3 2
Putting this in a function:
insert <- function(x, k, i){
append(x, k, match(i, x))
}
Note that you did not specify what would happen if you had more than 1 four in your vector. ie x<- c(1,4,2,4,2) where exactly do you want to place the 3? Is it after the first four or the second four? etc
You can try this function :
insert_after <- function(x, i, k) {
ind <- match(i, x)
new_inds <- sort(c(seq_along(x), ind))
new_x <- x[new_inds]
new_x[duplicated(new_inds)] <- k
new_x
}
x = c(1,4,2)
x <- insert_after(x, 4, 3)
x
#[1] 1 4 3 2
x <- insert_after(x, 4, 5)
x
#[1] 1 4 5 3 2
Lets assume the integer x. I want to split this quantity in n mostly equal chunks and save the values in a vector. E.g. if x = 10 and n = 4 then the resulting vector would be:
(3,3,2,2)
and if n = 3:
(4,3,3)
Note: The order of the resulting vector does not matter
While this will create a (probably unnecessary) large object when x is large, it is still pretty quick:
x <- 10
n <- 4
tabulate(cut(1:x, n))
#[1] 3 2 2 3
On a decent modern machine dividing 10M records into 100K groups, it takes only 5 seconds:
x <- 1e7
n <- 1e5
system.time(tabulate(cut(1:x, n)))
# user system elapsed
# 5.07 0.06 5.13
Here are some solutions.
1) lpSolve Solve this integer linear program. It should be fast even for large x (but not if n is also large). I also tried it for x = 10,000 and n = 3 and it returned the solution immediately.
For example, for n = 4 and x = 10 it corresponds to
min x4 - x1 such that 0 <= x1 <= x2 <= x3 <= x4 and
x1 + x2 + x3 + x4 = 10 and
x1, x2, x3, x4 are all integer
The R code is:
library(lpSolve)
x <- 10
n <- 4
D <- diag(n)
mat <- (col(D) - row(D) == 1) - D
mat[n, ] <- 1
obj <- replace(numeric(n), c(1, n), c(-1, 1))
dir <- replace(rep(">=", n), n, "=")
rhs <- replace(numeric(n), n, x)
result <- lp("min", obj, mat, dir, rhs, all.int = TRUE)
result$solution
## [1] 2 2 3 3
and if we repeat the above with n = 3 we get:
## [1] 3 3 4
2) lpSolveAPI The lpSolveAPI package's interface to lpSolve supports a sparse matrix specification which may reduce storage if n is large although it may still be slow if n is sufficiently large. Rewriting (1) using this package we have:
library(lpSolveAPI)
x <- 10
n <- 4
mod <- make.lp(n, n)
set.type(mod, 1:n, "integer")
set.objfn(mod, c(-1, 1), c(1, n))
for(i in 2:n) add.constraint(mod, c(-1, 1), ">=", 0, c(i-1, i))
add.constraint(mod, rep(1, n), "=", x)
solve(mod)
get.variables(mod)
## [1] 2 2 3 3
3) Greedy Heuristic This alternative uses no packages. It starts with a candidate solution having n-1 values of x/n rounded down and one remaining value. On each iteration it tries to improve the current solution by subtracting one from the largest values and adding 1 to the same number of smallest values. It stops when it can make no further improvement in the objective, diff(range(soln)).
Note that for x <- 1e7 and n <- 1e5 it is quite an easy to solve since n divides evenly into x. In particular system.time(tabulate(cut(...))) reports 18 sec on my machine and for the same problem the code below takes 0.06 seconds as it gets the answer after 1 iteration.
For x <- 1e7 and n <- 1e5-1 system.time(tabulate(cut(...))) reports 16 seconds on my machine and for the same problem the code below takes 4 seconds finishing after 100 iterations.
In the example below, taken from the question, 10/4 rounded down is 2 so it starts out with c(2, 2, 2, 4). On the first iteration it gets c(2, 2, 3, 3). On the second iteration it cannot get any improvement and so returns the answer.
x <- 10
n <- 4
a <- x %/% n
soln <- replace(rep(a, n), n, x - (n-1)*a)
obj <- diff(range(soln))
iter <- 0
while(TRUE) {
iter <- iter + 1
soln_new <- soln
mx <- which(soln == max(soln))
ix <- seq_along(mx)
soln_new[ix] <- soln_new[ix] + 1
soln_new[mx] <- soln_new[mx] - 1
soln_new <- sort(soln_new)
obj_new <- diff(range(soln_new))
if (obj_new >= obj) break
soln <- soln_new
obj <- obj_new
}
iter
## [1] 2
soln
## [1] 2 2 3 3
I'm still getting to grips with R and have been set the task of specifically writing a function where if x and y are vectors:
x <- c(3,7,9)
y <- 20
...then all of x and multiples of x which are less than y need to be output in the form of a vector, e.g.:
v1 <- c(3,6,7,9,12,14,15,18)
But then within the function it needs to sum up all the numbers in the vector v1 - (3+6+...+15+18).
I've had a go at it but I can never really get my head around if else statements, so could anyone help me out and explain so I know for future reference?
No loops needed. Figure out how many times each x value goes into y, then generate a list of the unique numbers:
x <- c(3,7,9)
y <- 20
possible <- y %/% x
#[1] 6 2 2
out <- unique(sequence(possible) * rep(x,possible))
# or alternatively
# out <- unique(unlist(Map(function(a,b) sequence(a) * b, possible, x)))
out
#[1] 3 6 9 12 15 18 7 14
sum(out)
#[1] 84
Here's an example using basic loops and if else branching in R.
x <- c(3,7,9)
y1 <- 20
v1 <- numeric()
for(i in x){
nex <- i
counter <- 1
repeat{
if(!(nex %in% v1)){
v1 <- c(v1, nex)
}
counter <- counter + 1
nex <- i*counter
if(nex >= y1){
break
}
}
}
v1 <- sort(v1)
v1.sum <- sum(v1)
v1
## 3 6 7 9 12 14 15 18
v1.sum
## 84
I am doing this in R. Though there is a shortcut way to do the following in R, I want to check it out:
x <- c(7,6,8,7)
y <- 1
n <- length(x)
p=1
s = 0
for(i in 1:n){
s = s + (x^p * y^p)
}
s
Since I have not specified the index number of x in the for loop, I guessed that only the first element of x will be used. So I made a table:
i s= s + (x^p * y^p)
1 s= 0 + (7^1 * 1^1)=7
2 s= 7 + (7^1 * 1^1)=14
3 s= 14 + (7^1 * 1^1)=21
4 s= 21 + (7^1 * 1^1)=28
But the result was:
s
[1] 28 24 32 28
I couldn't match this result in any way. How does it work?
x is not a single integer, but a vector of integers. You need to subset your x the way god intended. When you specify x, R doesn't use just the first element, but all of them. This is the assumption that is clouding your solution.
x <- c(7,6,8,7)
y <- 1
n <- length(x)
p <- 1
s <- 0
for(i in 1:n){
s <- s + (x[1]^p * y^p)
message(s)
}
7
14
21
28