Can I define two recursive functions simultaneously in R? - r

I have to functions f, and g with known initial values for f(1), and g(1) and their subsequent values are obtained trough iteration according to: f(n+1)=f(n)\cos(g(n))-g(n)\sin(g(n)) and g(n+1)=f(n)\cos(g(n))+g(n)\sin(g(n)) . I have been trying to solve this in R using:
N=100
for(n in 1:N)
{
f=function(n)
g=function(n)
if(n == 1) {
f(1)=0.8
g(1)=0.6} else {
f(n)=f(n-1)cos(g(n-1))-g(n-1)sin(g(n-1)
g(n)=f(n-1)cos(g(n-1))+g(n-1)sin(g(n-1))
}
However, this is not working. Any suggestions?

I am not sure that the following answers the question. But here are some errors in the code:
The functions are defined in the for loop.
None of the two functions is ever called.
My best guess is
f <- function(n){
if(n == 1){
0.8
}else{
f(n-1)*cos(g(n-1))-g(n-1)*sin(g(n-1))
}
}
g <- function(n){
if(n == 1) {
0.6
} else {
f(n-1)*cos(g(n-1))+g(n-1)*sin(g(n-1))
}
}
N <- 10
y <- numeric(N)
for(n in 1:N) {
y[n] <- f(n)
cat(y[n], "\n")
}
y

Related

Making a binomial expansion in R

I was working on a binomial expansion in R, I came across some issues and I feel the values do not make sense. Here is my code, I used factorial and combination from "scratch" to compute. I tried x=6, y=2 and n=4 I got 2784 as an answer. If I try 1 it gives 0. If n=i I get infinity because the denominator would equal zero
fact=1
for(i in 1:n){
fact=fact*i
}
return(fact)
}
Combi<-function(n,r){
result=f(n)/(f(r)*f(n-r))
return(result)
}
Combi(6,4)
expand.binomial<-function(x,y,n){
sumz=0
for(i in 1:n){
if(i==n){
break
}
sumz=sumz+Combi(n,i)*(x**i)*(y**(n-i))
}
return(sumz)
}
You should be aware of that, 0! is 1. In this case, f should be defined like below
f <- function(n) {
if (n == 0) {
return(1)
}
fact <- 1
for (i in 1:n) {
fact <- fact * i
}
return(fact)
}
Also, in expand.binomial, the exponents should start from 0 to n, i.e.,
expand.binomial <- function(x, y, n) {
sumz <- 0
for (i in 0:n) {
sumz <- sumz + Combi(n, i) * (x**i) * (y**(n - i))
}
return(sumz)
}
Test
> expand.binomial(6, 2, 4)
[1] 4096
> expand.binomial(6, 2, 1)
[1] 8
> expand.binomial(6, 2, 0)
[1] 1

How to find the smallest circumcircle of an irregular polygon on R project?

I was wondering about how to find the smallest circumcircle of an irregular polygon. I've worked with spatial polygons in R.
I want to reproduce some of the fragstats metrics in a vector mode because I had hard times with the package 'landscapemetrics' for a huge amount of data. In specific I would like to implement the circle (http://www.umass.edu/landeco/research/fragstats/documents/Metrics/Shape%20Metrics/Metrics/P11%20-%20CIRCLE.htm). So far, I could not find the formula or script for the smallest circumcircle.
All your comments are more than welcome.
Than you
As I mentioned in a comment, I don't know of existing R code for this, but a brute force search should be fast enough if you don't have too many points that need to be in the circle. I just wrote this one. The center() function is based on code from Wikipedia for drawing a circle around a triangle; circumcircle() is the function you want, found by brute force search through all circles that pass through 2 or 3 points in the set. On my laptop it takes about 4 seconds to handle 100 points. If you have somewhat bigger sets, you can probably get tolerable results by translating to C++, but it's an n^4 growth rate, so you'll need a better solution
for a really large set.
center <- function(D) {
if (NROW(D) == 0)
matrix(numeric(), ncol = 2)
else if (NROW(D) == 1)
D
else if (NROW(D) == 2) {
(D[1,] + D[2,])/2
} else if (NROW(D) == 3) {
B <- D[2,] - D[1,]
C <- D[3,] - D[1,]
Dprime <- 2*(B[1]*C[2] - B[2]*C[1])
if (Dprime == 0) {
drop <- which.max(c(sum((B-C)^2), sum(C^2), sum(B^2)))
center(D[-drop,])
} else
c((C[2]*sum(B^2) - B[2]*sum(C^2))/Dprime,
(B[1]*sum(C^2) - C[1]*sum(B^2))/Dprime) + D[1,]
} else
center(circumcircle(D))
}
radius <- function(D, U = center(D))
sqrt(sum((D[1,] - U)^2))
circumcircle <- function(P) {
n <- NROW(P)
if (n < 3)
return(P)
P <- P[sample(n),]
bestset <- NULL
bestrsq <- Inf
# Brute force search
for (i in 1:(n-1)) {
for (j in (i+1):n) {
D <- P[c(i,j),]
U <- center(D)
rsq <- sum((D[1,] - U)^2)
if (rsq >= bestrsq)
next
failed <- FALSE
for (k in (1:n)[-j][-i]) {
Pk <- P[k,,drop = FALSE]
if (sum((Pk - U)^2) > rsq) {
failed <- TRUE
break
}
}
if (!failed) {
bestset <- c(i,j)
bestrsq <- rsq
}
}
}
# Look for the best 3 point set
for (i in 1:(n-2)) {
for (j in (i+1):(n-1)) {
for (l in (j+1):n) {
D <- P[c(i,j,l),]
U <- center(D)
rsq <- sum((D[1,] - U)^2)
if (rsq >= bestrsq)
next
failed <- FALSE
for (k in (1:n)[-l][-j][-i]) {
Pk <- P[k,,drop = FALSE]
if (sum((Pk - U)^2) > rsq) {
failed <- TRUE
break
}
}
if (!failed) {
bestset <- c(i,j,l)
bestrsq <- rsq
}
}
}
}
P[bestset,]
}
showP <- function(P, ...) {
plot(P, asp = 1, type = "n", ...)
text(P, labels = seq_len(nrow(P)))
}
showD <- function(D) {
U <- center(D)
r <- radius(D, U)
theta <- seq(0, 2*pi, len = 100)
lines(U[1] + r*cos(theta), U[2] + r*sin(theta))
}
n <- 100
P <- cbind(rnorm(n), rnorm(n))
D <- circumcircle(P)
showP(P)
showD(D)
This shows the output

Determine if number is highly composite

I have troubles with my code that is supposed to determine whether a given natural number is highly composite or not. So far, I have come up with this:
ex33 <- function(x){
fact <- function(x) {
x <- as.integer(x)
div <- seq_len(abs(x))
factors <- div[x %% div == 0L]
return(factors)
}
k <- length(fact(x))
check <- NULL
tocheck <- c(1:(x-1))[-fact(x)]
for (i in tocheck) {
l <- length(fact(i))
if (l>=k){
check[i]<-1
break
}else{
check[i]<-0
}
}
if (1 %in% check){
return(FALSE)
}else{
return(TRUE)
}
}
I know, this is quite ineffective and slow, but I could not find another algorithm to speed this function up.

Calculate recursively `log(log(log(134)))`

I want to recursively count the log cylces in my function
logCounter <- function(number) {
k <- 0
if(k>=0){
k = k+1
}
result <- log(number)
if (result > 1) {
logCounter(result)
} else {
return(k)
}
}
logCounter(123)#returns 3 because log(log(log(123))) < 1
However, my counter k does not work as I would have inspected. Therefore I really would appreciate your answer!!!
You don't need to use Recall. Try this:
logCounter <- function(number) {
if (number <1) return(0) # A minor edit.
result <- log(number)
if (result > 1) return(logCounter(result)+1)
return(1)
}
The key is to try to compose your function in a way that doesn't require storing intermediate results.
You could do this much more easily without calling the function recursively with a while loop:
logCounter <- function(number) {
k <- 0
result <- number
while(result>1){
k <- k + 1
result <- log(result)
}
return(k)
}
> logCounter(123)
[1] 3
EDIT: If you need to use recursion, consider the Recall function:
logCounter <- function(number, iter=1) {
if(log(number)>1)
out <- Recall(log(number), iter+1)
else
out <- list(log(number),iter)
return(out)
}
> logCounter(123)
[[1]]
[1] 0.4518085
[[2]]
[1] 3

breaking out of for loop when running a function inside a for loop in R

Suppose you have the following function foo. When I'm running a for loop, I'd like it to skip the remainder of foo when foo initially returns the value of 0. However, break doesn't work when it's inside a function.
As it's currently written, I get an error message, no loop to break from, jumping to top level.
Any suggestions?
foo <- function(x) {
y <- x-2
if (y==0) {break} # how do I tell the for loop to skip this
z <- y + 100
z
}
for (i in 1:3) {
print(foo(i))
}
Admittedly my R knowledge is sparse and this is drycoded, but something like the following should work:
foo <- function(x) {
y <- x-2
if (y==0) {return(NULL)} # return NULL then check for it
z <- y + 100
z
}
for (i in 1:3) {
j <- foo(i)
if(is.null(j)) {break}
print(j)
}
Edit: updated null check for posterity
As a matter of coding practice, don't do this. Having a function that can only be used inside a particular loop is not a great idea. As a matter of educational interest, you can evaluate the 'break' in the parent environment.
foo <- function(x) {
y <- x-2
if (y==0) {eval.parent(parse(text="break"),1)}
z <- y + 100
z
}
for (i in 0:3) {
print(foo(i))
}
Are we allowed to be a little more creative? Could you recast your problem to take advantage of the following approach, where the operation is based on vectors?
x <- 1:3
y <- x[x-2 < 0] - 2 + 100 # I'm leaving the "- 2" separate to highlight the parallel to your code
y
If, however, a deeper form underlies the question and we need to follow this pattern for now, perhaps tweak it just a bit...
foo <- function(x) {
y <- x - 2
if (y != 0) {
z <- y + 100
z
} # else implicitly return value is NULL
}
for (i in 1:3) {
if (is.numeric(result <- foo(i))) {
print(result)
} else {
break
}
}
An alternative way is to throw an error and catch it with try, like so:
foo <- function(x) {
y <- x-2
if (y==0) {stop("y==0")}
z <- y + 100
z
}
try(for (i in 0:5) {
print(foo(i))
}, silent=TRUE)
## or use tryCatch:
for (i in 0:5) {
bar <- tryCatch(foo(i),error=function(e) NA)
if(is.na(bar)){ break } else { print(bar) }
}
I have no clue how r works but I found the question interesting because I could lookup a new language's syntax so excuse my answer if it is totally wrong :)
foo <- function(x) {
y <- x-2
if (y!=0) z <- NULL else z <- y + 100
z
}
for (i in 1:3)
{
a <- foo(i)
if (a == NULL) {next}
print(a)
}

Resources