I would like to create matrix A[i,j,k] with the following elements:
A[i,j,k] = 0 if k+j-s-i =/= 0
A[i,j,k] = p[s] if k+j-s-i =0 ( p[s] is given vector )
This may be written by characteristic function as p[s]*ð(k+j-s-i) or by Kronecker delta function as p[s]*ð(0,k+j-s-i).
Is there any "build in" function in R which gives that - I mean is there "ð" built in?
Or do I have to wrote it by myself?
I suppose it would be very useful to have built function which returns 1 for f(x)=0 and 0 otherwise, at least for linear f(x)
I'd rewrite this as
A[i,j,k] = p[k+j-i] if that exists, otherwise 0
which could then be implemented as
p <- c(1,2,3,4,5)
pfun <- function(x) {
if (x < 1 | x > length(p)) {
0
} else {
p[x]
}
}
n <- 5
A <- array(0, c(n, n, n))
for (i in 1:n) {
for (j in 1:n) {
for (k in 1:n) {
A[i,j,k] <- pfun(k+j-i)
}
}
}
There may be something more elegant than triply-nested for loops.
As for a the function you ask about, something as simple as
as.numeric(f(x)==0)
would work.
Related
I'm trying to solve the problem #14 of Project Euler.
So the main objective is finding length of Collatz sequence.
Firstly I solved problem with regular loop:
compute <- function(n) {
result <- 0
max_chain <- 0
hashmap <- 1
for (i in 1:n) {
chain <- 1
number <- i
while (number > 1) {
if (!is.na(hashmap[number])) {
chain <- chain + hashmap[number]
break
}
if (number %% 2 == 0) {
chain <- chain + 1
number <- number / 2
} else {
chain <- chain + 2
number <- (3 * number + 1) / 2
}
}
hashmap[i] <- chain
if (chain > max_chain) {
max_chain <- chain
result <- i
}
}
return(result)
}
Only 2 seconds for n = 1000000.
I decided to replace while loop to recursion
len_collatz_chain <- function(n, hashmap) {
get_len <- function(n) {
if (is.na(hashmap[n])) {
hashmap[n] <<- ifelse(n %% 2 == 0, 1 + get_len(n / 2), 2 + get_len((3 * n + 1) / 2))
}
return(hashmap[n])
}
get_len(n)
return(hashmap)
}
compute <- function(n) {
result <- 0
max_chain <- 0
hashmap <- 1
for (i in 1:n) {
hashmap <- len_collatz_chain(i, hashmap)
print(length(hashmap))
if (hashmap[i] > max_chain) {
max_chain <- hashmap[i]
result <- i
}
}
return(result)
}
This solution works but works so slow. Almost 1 min for n = 10000.
I suppose that one of the reasons is R creates hashmap object each time when call function len_collatz_chain.
I know about Rcpp packages and yes, the first solution works fine but I can't understand where I'm wrong.
Any tips?
For example, my Python recursive solution works in 1 second with n = 1000000
def len_collatz_chain(n: int, hashmap: dict) -> int:
if n not in hashmap:
hashmap[n] = 1 + len_collatz_chain(n // 2, hashmap) if n % 2 == 0 else 2 + len_collatz_chain((3 * n + 1) // 2, hashmap)
return hashmap[n]
def compute(n: int) -> int:
result, max_chain, hashmap = 0, 0, {1: 1}
for i in range(2, n):
chain = len_collatz_chain(i, hashmap)
if chain > max_chain:
result, max_chain = i, chain
return result
The main difference between your R and Python code is that in R you use a vector for the hashmap, while in Python you use a dictionary and that hashmap is transferred many times as function argument.
In Python, if you have a Dictionary as function argument, only a reference to the actual data is transfered to the called function. This is fast. The called function works on the same data as the caller.
In R, a vector is copied when used as function argument. This is potentially slow, but safer in the sense that the called function cannot alter the data of the caller.
This the main reason that Python is so much faster in your code.
You can however alter the R code slightly, such that the hashmap is not transfered as function argument anymore:
len_collatz_chain <- local({
hashmap <- 1L
get_len <- function(n) {
if (is.na(hashmap[n])) {
hashmap[n] <<- ifelse(n %% 2 == 0, 1 + get_len(n / 2), 2 + get_len((3 * n + 1) / 2))
}
hashmap[n]
}
get_len
})
compute <- function(n) {
result <- rep(NA_integer_, n)
for (i in seq_len(n)) {
result[i] <- len_collatz_chain(i)
}
result
}
compute(n=10000)
This makes the R code much faster. (Python will probably still be faster though).
Note that I have also removed the return statements in the R code, as they are not needed and add one level to the call stack.
I want to create an script that calculates probabilities for a rol game.
I´m new to programming and I´m stuck with the return values and nested functions. What I want is to use the values returned by the first function in the next one.
I have two functions dice(k, n) and fight(a, b). (for the example, the functions are partly written):
dice <- function (k, n) {
if (k > 3 && n > 2){
a <- 3
b <- 2
attack <- sample(1:6, a)
deff <- sample(1:6, b)
}
return(c(attack, deff))
}
So I want to use the vector attack, and deff in the next function:
fight <- function(a, b){
if (a == 3 && b == 2){
if(sort(attack,T)[1] > sort(deff,T)[1]){
n <- n - 1}
if (sort(attack,T)[1] <= sort(deff,T)[1]) {
k <- k - 1}
if (sort(attack,T)[2] > sort(deff,T)[2]) {
n <- n - 1}
if (sort(attack,T)[2]<= sort(deff,T)[2]){
k <- k - 1}
}
return(c(k, n)
}
But this gives me the next error:
Error in sort(attack, T) : object 'attack' not found
Any ideas? Thanks!
I just got a simple question for you. It concerns nested for loops code in R.
I got this kind of algorithm to develop:
N = 180; k = 1 ... N; l = 1...k; alpha = 1
So I tried this nested for loop, but it was a disaster.
N <- 180
nu <- 0
for (k in 1:N) {
for (l in 1:k) {
nu<- nu + 1/(N-l+1)
}
E<- N*nu
print(E)
}
I got 180 E values, but all of them are wrong.
For example, for k = 10 I expect to get a nu = 0.057 and a related E[10] = 10.26. Whereas script returns me a E[10] = 55.94.
I really cannot figure out why.
Thank you.
You keep summing on nu, here is a fix for the problem. When calculating a new E at the first for loop just zero the nu again.
This return the expected result:
N <- 180
nu <- 0
for (k in 1:N) {
nu <- 0
for (l in 1:k) {
nu <- nu + 1/(N-l+1)
}
E<- N*nu
print(E)
}
And, below is a somewhat better solution using the sum function instead of looping.
### Functions
vk <- function(k, alpha, N) {
return(sum(1 / (N - 1:k + 1)^alpha))
}
E <- function(N, k) {
return(N * vk(k, 1, N))
}
N <- 180
k <- N
result.vec <- rep(NA, k)
for (i in 1:k) {
result.vec[i] <- E(N, i)
}
I am trying to simulate data 10000 observations for the following distribution:
{ 3x(1-x)2 0 < x < 1
f(x) = { 3(2-x)(1-x)2 1 ≤ x < 2
{ 0 otherwise
Using the rejection method, I am boxing the distribution by the following rectangle: x=0,x=2,y=0,y=2
However, there is some fault in my code below as it doesn't seem to work. Can any one please advise on a fix?
n=10000
t=0
x=0
while(t<n)
{u=runif(1,0,2)
y=runif(1,0,2)
if {(u in c(0:1))
fun=3*u*(1-u)^2
else (u in c(1:2))
fun=3*(2-u)*(1-u)^2}
if (y<fun)
{t=t+1
x[t]=u}}
You have a bunch of R syntax errors. You should review a basic R introduction. be careful with placement of braces. Also there is no in keyword in R.
n <- 10000
t <- 0
x <- 0
while(t<n) {
u <- runif(1,0,2)
y <- runif(1,0,2)
if (u > 0 & u < 1) {
fun <- 3*u*(1-u)^2
} else if (u >= 1 & u < 2) {
fun <- 3*(2-u)*(1-u)^2
} else {
fun <- 0
}
if (y<fun){
t <- t+1
x[t] <- u
}
}
Is there a way to make lpSolve return multiple solutions? In below case i want (5,0) and (0,5) both.
If lpSolve cannot do that then is there any other R package which will return all possible solutions of an integral linear optimization program?
library("lpSolve")
A=matrix (c(1, 1), nrow=1, byrow=TRUE)
b=(5)
signs='=='
c_=c(1,1)
res = lpSolve::lp('max', c_, A, signs, b, all.int = TRUE)
res$solution
=======================================================================
I would also like to know why lpSolve package provides all possible solutions if all decision variables are binary. Why cannot it repeat the same when all variables are integer...
Code:
library(lpSolveAPI)
vBiv_of_v <- function (nbits,v){
taillev<-length(v)
taillevBivalent<-nbits*taillev
vBivalent<-rep(0,taillevBivalent)
for(iLg in seq(1,taillev)) {
iCoef<-1
for(iDelta in seq(1,nbits)){
vBivalent[(iLg-1)*nbits+iDelta]<- iCoef*v[iLg]
iCoef<-iCoef*2
}
}
vBivalent
}
vBiv_to_v <- function (nbits,vBivalent) {
taillevBivalent<-length(vBivalent)
taillev<-taillevBivalent/nbits
v<-rep(0,taillev)
for(iLg in seq(1,taillev)) {
for(iDelta in seq(1,nbits)){
v[iLg]<-v[iLg]+2^(iDelta-1)*vBivalent[(iLg-1)*nbits+iDelta]
}
}
v
}
nbVariable<-2
nbBits=3
nbVariableBivalentes<-nbVariable*nbBits
f.obj<-rep(0,nbVariableBivalentes)
mylp <- make.lp(0, nbVariableBivalentes)
set.objfn(mylp,f.obj)
add.constraint(mylp, vBiv_of_v(nbBits,c(1,1)), "=", 5)
set.type(mylp, 1:nbVariableBivalentes , type = "binary")
repeat {
status<-solve(mylp)
if(status == 0) {
last_sol<-get.variables(mylp)
vRes<-vBiv_to_v(nbBits,last_sol)
cat(vRes[1],vRes[2],"\n")
#add cutting
new_rhs <- 0;
f.condSup<-rep(0,nbVariableBivalentes)
for (iCol in 1:nbVariableBivalentes) {
f.condSup[iCol] <- 2 * last_sol[iCol] - 1
new_rhs <- new_rhs + last_sol[iCol];
}
add.constraint(mylp, f.condSup, "<=", new_rhs - 1)
}
else if(status == 2) {
cat("No more solution.\n")
break
}
}
Result:
5 0
4 1
3 2
1 4
2 3
0 5
No more solution.