this is my program in R:
mletheta<-function(x)
{
n<-length(x)
temp<-x<=0
if(n==0||sum(temp)>0)
{
stop("ERROR:x must be a vector of positive real values.\n")
}
thetahat<--1*n/sum(log(1-exp(-1*x**2)))
return(thetahat)
}
mletheta(-3)
my problem is i can't understand if x<=0, then how sum(temp)>0. as x=-5:-4 then sum(temp) should be -9<0. I don't understand the logic??
Let's decompose the first part of the function:
x <- -5:-4
n <- length(x)
n
# [1] 2
temp <- x<=0
temp
# [1] TRUE TRUE
sum(temp)
# [1] 2
This meets the if statement if(n==0||sum(temp)>0), where the error message is displayed if the length of the vector in NULL (n==0), which is not true in this case, or if the sum of temp is greater than 0 (sum(temp)>0). Here, sum(temp) gives 2.
Related
How do I retrieve maximum sum of possible divisors numbers
I have a below function which will give possible divisors of number
Code
divisors <- function(x) {
y <- seq_len(ceiling(x / 2))
y[x %% y == 0]
}
Example
Divisors of 99 will give the below possible values.
divisors(99)
[1] 1 3 9 11 33
My expected Logic :
Go from last digit to first digit in the divisors value
The last number is 33, Here next immediate number divisible by 33 is 11 . So I selected 11 , now traversing from 11 the next immediate number divisible by 11 is 1. So selected 1. Now add all the numbers.
33 + 11 + 1 = 45
Move to next number 11, Now next immediate number divisible by 11 is 1. So selected 1. Now add all the numbers.
11 + 1 = 12
Here immediate
Move to next number 9, Now next immediate number divisible by 11 is 1. So selected 1. Now add all the numbers.
9 + 3 + 1 = 13
Move to next number 3, Now next immediate number divisible by 3 is 1. So selected 1. Now add all the numbers.
3+1=4
Now maximum among these is 45.
Now I am struggling to write this logic in R . Help / Advice much appreciated.
Note : Prime numbers can be ignored.
update
For large integers, e.g., the maximum integer .Machine$integer.max (prime number), you can run the code below (note that I modified functions divisors and f a bit)
divisors <- function(x) {
y <- seq(x / 2)
y[as.integer(x) %% y == 0]
}
f <- function(y) {
if (length(y) <= 2) {
return(as.integer(sum(y)))
}
l <- length(y)
h <- y[l]
yy <- y[-l]
h + f(yy[h %% yy == 0])
}
and you will see
> n <- .Machine$integer.max - 1
> x <- divisors(n)
> max(sapply(length(x):2, function(k) f(head(x, k))))
[1] 1569603656
You can define a recursive function f that gives successive divisors
f <- function(y) {
if (length(y) == 1) {
return(y)
}
h <- y[length(y)]
yy <- y[-length(y)]
c(f(yy[h %% yy == 0]), h)
}
and you will see all possible successive divisor tuples
> sapply(rev(seq_along(x)), function(k) f(head(x, k)))
[[1]]
[1] 1 11 33
[[2]]
[1] 1 11
[[3]]
[1] 1 3 9
[[4]]
[1] 1 3
[[5]]
[1] 1
Then, we apply f within sapply like below
> max(sapply(rev(seq_along(x)), function(k) sum(f(head(x, k)))))
[1] 45
which gives the desired output.
You can also use the following solution. It may sound a little bit complicated and of course there is always an easier, more efficient solution. However, I thought this could be useful to you. I will take it from your divisors output:
> x
[1] 1 3 9 11 33
# First I created a list whose first element is our original x and from then on
# I subset the first element till the last element of the list
lst <- lapply(0:(length(x)-1), function(a) x[1:(length(x)-a)])
> lst
[[1]]
[1] 1 3 9 11 33
[[2]]
[1] 1 3 9 11
[[3]]
[1] 1 3 9
[[4]]
[1] 1 3
[[5]]
[1] 1
Then I wrote a custom function in order to implement your conditions and gather your desired output. For this purpose I created a function factory which in fact is a function that creates a function:
As you might have noticed the outermost function does not take any argument. It only sets up an empty vector out to save our desired elements in. It is created in the execution environment of the outermost function to shield it from any changes that might affect it in the global environment
The inner function is the one that takes our vector x so in general we call the whole setup like fnf()(x). First element of of our out vector is in fact the first element of the original x(33). Then I found all divisors of the first element whose quotient were 0. After I fount them I took the second element (11) as the first one was (33) and stored it in our out vector. Then I modified the original x vector and omitted the max value (33) and repeated the same process
Since we were going to repeat the process over again, I thought this might be a good case to use recursion. Recursion is a programming technique that a function actually calls itself from its body or from inside itself. As you might have noticed I used fn inside the function to repeat the process again but each time with one fewer value
This may sound a bit complicated but I believed there may be some good points for you to pick up for future exploration, since I found them very useful, hoped that's the case for you too.
fnf <- function() {
out <- c()
fn <- function(x) {
out <<- c(out, x[1])
z <- x[out[length(out)]%%x == 0]
if(length(z) >= 2) {
out[length(out) + 1] <<- z[2]
} else {
return(out)
}
x <- x[!duplicated(x)][which(x[!duplicated(x)] == z[2]):length(x[!duplicated(x)])]
fn(x)
out[!duplicated(out)]
}
}
# The result of applying the custom function on `lst` would result in your
# divisor values
lapply(lst, function(x) fnf()(sort(x, decreasing = TRUE)))
[[1]]
[1] 33 11 1
[[2]]
[1] 11 1
[[3]]
[1] 9 3 1
[[4]]
[1] 3 1
[[5]]
[1] 1
In the end we sum each element and extract the max value
Reduce(max, lapply(lst, function(x) sum(fnf()(sort(x, decreasing = TRUE)))))
[1] 45
Testing a very large integer number, I used dear #ThomasIsCoding's modified divisors function:
divisors <- function(x) {
y <- seq(x / 2)
y[as.integer(x) %% y == 0]
}
x <- divisors(.Machine$integer.max - 1)
lst <- lapply(0:(length(x)-1), function(a) x[1:(length(x)-a)])
Reduce(max, lapply(lst, function(x) sum(fnf()(sort(x, decreasing = TRUE)))))
[1] 1569603656
You'll need to recurse. If I understand correctly, this should do what you want:
fact <- function(x) {
x <- as.integer(x)
div <- seq_len(abs(x)/2)
factors <- div[x %% div == 0L]
return(factors)
}
maxfact <- function(x) {
factors <- fact(x)
if (length(factors) < 3L) {
return(sum(factors))
} else {
return(max(factors + mapply(maxfact, factors)))
}
}
maxfact(99)
[1] 45
logically this code should make sense, I'm primarily a python programmer but I'm unsure why this is not working. It is not returning any errors. What I want is for this vector of primarily zeros to be changed to a vector of only 1's and -1's (hence using the sample function). My issue is that the values of the vector are not being updated, they are just staying as 0 and I'm not sure why.
Y = numeric(100)
for (i in 100){
x <- sample(1:2, 1)
if (x == 2){
Y[i] = 1
}
else{
Y[i] = -1
}
}
I've also changed the Y[i] = 1 to Y[i] <- 1 but this has not helped. I also know that x is either 1 or 2 because I test it manually using x == 2...etc
The only other issue I could think of is that x is an integer while the numbers sample returns are not but per checking this: (Note that x = 2L after the loop exited)
> typeof(x)
[1] "integer"
> typeof(2)
[1] "double"
> x == 2
[1] TRUE
I don't think it is the problem.
Any suggestions?
Because the loop is just run once i.e. the last iteration. It did change in the output vector Y
tail(Y)
#[1] 0 0 0 0 0 -1
Instead it would be 1:100
for(i in 1:100)
The second issue raised is with the typeof 'x'. Here, we are sampleing an integer with 1:2 instead of a numeric vector and that returns the same type as the input. According to ?':'
For numeric arguments, a numeric vector. This will be of type integer if from is integer-valued and the result is representable in the R integer type, otherwise of type "double"
typeof(1:2)
#[1] "integer"
typeof(c(1, 2))
#[1] "double"
Another option if it is a range (:) is to wrap with as.numeric
for (i in 1:100){
x <- sample(as.numeric(1:2), 1)
if (x == 2){
Y[i] = 1
}
else{
Y[i] = -1
}
}
check the type
typeof(Y)
#[1] "double"
typeof(x)
#[1] "double"
Also, R is a vectorized language so this:
x<-sample(1:2, 100, replace = TRUE)
Y<-ifelse(x==2, 1, -1)
will run about 1000 times faster than your loop.
I'm trying to convert a while loop to a recursion.
I know the while loop is more efficient, but I'm trying to understand how to convert a for/while loop to recursion, and recursion to a for/while/if loop.
my function as I'm using a while loop:
harmon_sum <- function(x){
n <- 1
sum <- 0
while (sum < x)
{
sum <- sum + (1/n)
n <- (n +1)
}
return(n)
}
This function takes some numeric value, suppose x=2, and returns the number of objects for the harmonic sum that you need to sum up in order to create a greater number then x. (for x=2, you'd need to sum up the first 5 objects of the harmonic sum)
[![harmonic sum][1]][1]
**example**: `harmon_sum <- function(x){
n <- 1
sum <- 0
while (sum < x)
{
sum <- sum + (1/n)
print(sum)
n <- (n +1)
print(n)
}
return(n)
}
> harmon_sum(x =2)
[1] 1
[1] 2
[1] 1.5
[1] 3
[1] 1.833333
[1] 4
[1] 2.083333
[1] 5
[1] 5`
my version for the recursive function:
harmon_sum2 <- function(x, n =1){
if( x<= 0){
return(n-1)
}
else {
x <- (x- (1/(n)))
harmon_sum2(x, n+1)
}
}
which returns me the wrong answer.
I'd rather find a solution with just one variable (x), instead of using two variables (x, n), but I couldn't figure a way to do that.
It seems to me that if you change return(n-1) to return(n) you do get the right results.
harmon_sum2 <- function(x, n=1){
if( x <= 0){
return(n)
}
else {
x <- (x- (1/(n)))
harmon_sum2(x, n+1)
}
}
harmon_sum(2)
[1] 5
harmon_sum2(2)
[1] 5
harmon_sum(4)
[1] 32
harmon_sum2(4)
[1] 32
Your function needs to know n. If you don't want to pass it, you need to store it somewhere where all functions on the call stack can access it. For your specific case you can use sys.nframe instead:
harmon_sum2 <- function(x){
if( x<= 0){
return(sys.nframe())
}
else {
x <- (x- (1/(sys.nframe())))
harmon_sum2(x)
}
}
harmon_sum(8)
#[1] 1675
harmon_sum2(8)
#[1] 1675
However, this doesn't work if you call your function from within another function:
print(harmon_sum2(8))
#[1] 4551
Another alternative is the approach I demonstrate in this answer.
I want to return the number of times in string vector v that the element at the next successive index has more characters than the current index.
Here's my code
BiggerPairs <- function (v) {
numberOfTimes <- 0
for (i in 1:length(v)) {
if((nchar(v[i+1])) > (nchar(v[i]))) {
numberOfTimes <- numberOfTimes + 1
}
}
return(numberOfTimes)
}
}
missing value where TRUE/FALSE needed.
I do not know why this happens.
The error you are getting is saying that your code is trying to evaluate a missing value (NA) where it expects a number. There are likely one of two reasons for this.
You have NA's in your vector v (I suspect this is not the actual issue)
The loop you wrote is from 1:length(v), however, on the last iteration, this will try the loop to try to compare v[n+1] > v[n]. There is no v[n+1], thus this is a missing value and you get an error.
To remove NAs, try the following code:
v <- na.omit(v)
To improve your loop, try the following code:
for(i in 1:(length(v) -1)) {
if(nchar(v[i + 1]) > nchar(v[i])) {
numberOfTimes <- numberOfTimes + 1
}
}
Here is some example dummy code.
# create random 15 numbers
set.seed(1)
v <- rnorm(15)
# accessing the 16th element produces an NA
v[16]
#[1] NA
# if we add an NA and try to do a comparison, we get an error
v[10] <- NA
v[10] > v[9]
#[1] NA
# if we remove NAs and limit our loop to N-1, we should get a fair comparison
v <- na.omit(v)
numberOfTimes <- 0
for(i in 1:(length(v) -1)) {
if(nchar(v[i + 1]) > nchar(v[i])) {
numberOfTimes <- numberOfTimes + 1
}
}
numberOfTimes
#[1] 5
Is this what you're after? I don't think there is any need for a for loop.
I'm generating some sample data, since you don't provide any.
# Generate some sample data
set.seed(2017);
v <- sapply(sample(30, 10), function(x)
paste(sample(letters, x, replace = T), collapse = ""))
v;
#[1] "raalmkksyvqjytfxqibgwaifxqdc" "enopfcznbrutnwjq"
#[3] "thfzoxgjptsmec" "qrzrdwzj"
#[5] "knkydwnxgfdejcwqnovdv" "fxexzbfpampbadbyeypk"
#[7] "c" "jiukokceniv"
#[9] "qpfifsftlflxwgfhfbzzszl" "foltth"
The following vector marks the positions with 1 in v where entries have more characters than the previous entry.
# The following vector has the same length as v and
# returns 1 at the index position i where
# nchar(v[i]) > nchar(v[i-1])
idx <- c(0, diff(nchar(v)) > 0);
idx;
# [1] 0 0 0 0 1 0 0 1 1 0
If you're just interested in whether there is any entry with more characters than the previous entry, you can do this:
# If you just want to test if there is any position where
# nchar(v[i+1]) > nchar(v[i]) you can do
any(idx == 1);
#[1] TRUE
Or count the number of occurrences:
sum(idx);
#[1] 3
I've been set a question on the Fibonacci Sequence and although I've been successful in doing the sequence, I haven't been as lucky summing the even terms up (i.e. 2nd, 4th, 6th... etc.) My code is below as well as the part of the question I am stuck on. Any guidance would be brilliant!
Question:
Write a function which will take as an input x and y and will return either the sum of the first x even Fibonacci numbers or the sum of even Fibonacci numbers less than y.
That means the user will be able to specify either x or y but not both.
You have to return a warning if someone uses both numbers (decide
on the message to return)
Code:
y <- 10
fibvals <- numeric(y)
fibvals[1] <- 1
fibvals[2] <- 1
for (i in 3:y) {
fibvals[i] <- fibvals[i-1]+fibvals[i-2]
if (i %% 2)
v<-sum(fibvals[i])
}
v
To get you started since this sounds like an exercise.
I would split your loop up into steps rather than do the summing within the loop with an if statement. Since you already have the sequence code working, you can just return what is asked for by the user. The missing function would probably help you out here
f <- function(x, y) {
if (missing(y)) {
warning('you must give y')
y <- 10
}
fibvals <- numeric(y)
fibvals[1] <- 1
fibvals[2] <- 1
for (i in 3:y) {
fibvals[i] <- fibvals[i-1]+fibvals[i-2]
}
evens <- fibvals %% 2 == 0
odds <- fibvals %% 2 != 0
if (missing(x)) {
return(sum(fibvals[evens]))
} else return(fibvals)
}
f(y = 20)
# [1] 3382
f(10)
# [1] 1 1 2 3 5 8 13 21 34 55
# Warning message:
# In f(10) : you must give y