Summation of max function with vector input in R? - r

I want to build this function: f(a,b)=sum_{i=1 to n}(max(a-b_i,0)) where b=(b_1,b_2,...b_n). This is what I have done:
vec<-function(a,b){
z<-0
for(i in b){
ifelse(a > i,z <- z + (a-i), 0)
}
return(data.frame(z))
}
This code gives correct output for scalar input of a. But while using vector output answers are not always correct. For example
> vec(c(-6,5),c(3,1,3))
gives -25 for a=-6 and 8 for a=5 respectively.
But > vec(-6,c(3,1,3)) gives 0. And this the correct answer.
Please throw give some idea how will I correct it.

When you let a = c(-6,5), then this argument a > i becomes (FALSE, TRUE). Since it contains a true, the vector is passed into z <- z + (a-i). Note that if you use a=-6 in this formula, you get the output of -25. I would suggest doing something like this:
vec<-function(a,b){
z<-0
for(i in b){
p <- ifelse(a > i,z <- z + (a-i), 0)
}
return(data.frame(p))
}

I believe that what you are missing is the condition on only summing up positive numbers, as expressed by the condition 'max(a-b_i, 0)'.
This code works fine for the examples you provide:
vec <- function(a, b){
n <- NULL
for(i in 1:length(a)){
z <- a[i] - b
z <- z[z > 0]
n <- c(n, sum(z))
}
return(n)
}
For example:
> vec(c(-6, 5), c(3, 1, 3))
[1] 0 8
and
> vec(-6, c(3, 1, 3))
[1] 0
If you want to get a data.frame back just replace the return(n) instruction to return(data.frame(n)).

Related

Remove a vector from another vector

I would like to remove from the vector wine below the vector b=c(1,0).
The result should be d=c(1,1,0).
library(gtools)
wine=c(1,1,1,0,0)
x=combinations(5,2,v=wine,set=FALSE,repeats.allowed=FALSE)
y=matrix(NA,nrow(x),3)
I want to find the complementary matrix y of x.
Thanks for your time.
The following uses a function I have posted here. The function finds where in y the vector x occurs returning an index vector into y.
First, get where b occurs in wine. Then the location is used to remove the found vector.
occurs <- function(x, y) {
m <- length(x)
n <- length(y)
candidate <- seq.int(length = n - m + 1L)
for (i in seq.int(length = m)) {
candidate <- candidate[x[i] == y[candidate + i - 1L]]
}
candidate
}
wine <- c(1,1,1,0,0)
b <- c(1,0)
i <- occurs(b, wine)
d <- wine[-(i + seq(b) - 1L)]
d
#[1] 1 1 0

Sorting a vector in R without using sort function

I am trying to write a function to sort a vector, but without using R's inbuilt 'Sort' function.
My Code:
sorting <- function(x){
for(i in 1:length(x)){
for(j in (i+1):length(x)){
if(x[i] > x[j]){
x[c(i,j)] = x[c(j,i)]
}
}
}
x
}
I get below output:
> x <- c(3,1,4,7,2,9)
> sorting(x)
Error in if (x[i] > x[j]) { : missing value where TRUE/FALSE needed
>
I understand that we'll get above error when the 'IF' condition returns 'NA' instead of TRUE/FALSE.
Is there an issue with the statement:
for(j in (i+1):length(x)){
Python code for same:
def sorting(a):
for i in range(len(a)):
for j in range(i+1,len(a)):
if a[i] > a[j]:
a[i],a[j] = a[j],a[i]
return a
Output:
sorting([3,1,4,7,2,9])
Out[380]: [1, 2, 3, 4, 7, 9]
In Python, the code works fine.
Could someone let me know the issue with my R code.
The problem is with that (i+1). When length(x) reaches its max value, j goes out of range. I added this: (length(x)-1).
sorting <- function(x){
for(i in 1:(length(x)-1)){
for(j in (i+1):length(x)){
if(x[i] > x[j]){
x[c(i,j)] = x[c(j,i)] # +1 for this
}
}
}
x
}
sorting(c(3,1,4,7,2,9))
[1] 1 2 3 4 7 9
Sorting <- function(x){
xs <- rep(0, length(x))
for(i in 1:length(x)){
xs[i] = min(x)
x <- x[x != min(x)]
}
xs
}
Sorting(c(3,1,4,7,2,9))
[1] 1 2 3 4 7 9
Sorting is a function with a numeric vector argument x. Initially xs, the sorted vector of the same length as x, is filled with zeroes. The for loop aims at assigning the minimum value of vector x to each component of xs (for(i in 1:length(x)){ xs[i] = min(x) ). We then remove such minimum value from x by x <- x[x != min(x)] } to find the next minimum value. Finally, xs shows the sorted vector of x.

combinations of numbers to reach a given sum - recursive implementation in R

All I want to do is to implement the solution given here (the one in python)
in R.
I'm not very used to do debugging in R-Studio but even after I have tried that I still can't figure out why my code does not work. Basically (with the example input provided) I get the function to run over all the numbers and then it is stuck in a sort of infinite loop (or function). Can someone please point me in the right direction regarding this?
subset_sum <- function(numbers, target, partial = numeric(0)){
s <- sum(partial,na.rm = TRUE)
# check if the partial sum equals to target
if (s == target){
cat("sum(",partial,")","=",target)
}
else if (s >= target) {
return() # if we reach the number why bother to continue
}
else {
for(i in 1:length(numbers)){
n <- numbers[i]
remaining <- numbers[i+1:length(numbers)]
subset_sum(remaining, target, partial = append(partial,n))
}
}
}
subset_sum(c(3,9,8,4,5,7,10),15)
When not run in debug mode it gives me these errors:
Error: node stack overflow
Error during wrapup: node stack overflow
Here's a recursive implementation in R
subset_sum = function(numbers,target,partial=0){
if(any(is.na(partial))) return()
s = sum(partial)
if(s == target) print(sprintf("sum(%s)=%s",paste(partial[-1],collapse="+"),target))
if(s > target) return()
for( i in seq_along(numbers)){
n = numbers[i]
remaining = numbers[(i+1):length(numbers)]
subset_sum(remaining,target,c(partial,n))
}
}
I had to add one extra catch in R from python to handle when i+1 > length(numbers) and returned an NA.
> subset_sum(c(3,9,8,4,5,7,10),15)
[1] "sum(3+8+4)=15"
[1] "sum(3+5+7)=15"
[1] "sum(8+7)=15"
[1] "sum(5+10)=15"
I think (but I'm not sure) that your issue was nest if/else if logic in a recursive function. Interestingly, when I put the if(i+1 > length(numbers)) return() inside the for loop, that broke the functionality so I didn't get all the answers right - the return's need to be outside the recursion.
This is not a recursive function but it takes advantage of R's ability to handle matrix/array type data. Some output is shown after #
v <- c(3,9,8,4,5,7,10)
v <- sort(v)
# [1] 3 4 5 7 8 9 10
target <- 15
# we don't need to check more than at most 4 numbers since 3+4+5+7 (the smallest numbers) is greater than 15
mincombs <- min(which(cumsum(v) > target))
# [1] 4
Combs <- combn(v, mincombs) # make combinations of numbers
ans <- mapply(function(x,y) ifelse(y > 0, paste0(paste0(Combs[1:y,x], collapse="+"), "=", target), NA), 1:ncol(Combs), apply(Combs, 2, function(I) which(cumsum(I) == target)))
ans <- unlist(ans[lengths(ans) > 0])
# [1] "3+4+8=15" "3+4+8=15" "3+5+7=15" "3+5+7=15" "3+5+7=15" "7+8=15"
In a function
myfun <- function(V, target) {
V <- sort(V)
mincombs <- min(which(cumsum(V) > target))
Combs <- combn(V, mincombs)
ans <- mapply(function(x,y) ifelse(y > 0, paste0(paste0(Combs[1:y,x], collapse="+"), "=", target), NA), 1:ncol(Combs), apply(Combs, 2, function(I) which(cumsum(I) == target)))
ans <- unlist(ans[lengths(ans) > 0])
return(ans)
}
myfun(V = c(3,9,8,4,5,7,10), target = 15)
myfun(V = c(3,9,8,4,5,7,10,12,4,32),target = 20)

Prime numbers from random samples in R

I wrote the following code trying to find all the prime numbers from a random generated data set. sadly it seems something went wrong, could anybody help me.
set.seed(20171106)
n <- 10000
num <- sample(1:100000,n,replace=TRUE)
findPrime <- function(x){
apple<-c()
n<-length(x)
for(i in n){
if(any(x[i]%%(1:(x[i]-1))!=0)) apple <-c(apple,x[i])
}
return(apple)
}
To get results:
type:findPrime(num)
This is the warning message:
Warning message:
In if (x[i]%%(1:(x[i] - 1)) == 0) apple <- c(apple, x[i]) :
the condition has length > 1 and only the first element will be used
so how can I fix the problem?
if statements only accept single elements and in your declaration seems to get the whole vector. I have rewritten your function using a ifelse expression wrapped inside a sapply loop.
I hope this works for you.
findPrime <- function(x = 0){
primes <- c()
# Prime finder
primes <- sapply(X = x,FUN = function(x) {
ifelse(any(x %% (1:(x - 1)) != 0), T, F)}
)
# Select primes
primes <- num[primes]
return(primes)
}
findPrime(num)
I have checked another silly mistake... Inside the function change num for x in the select primes step and invert the F, T outcomes. It should look like this:
findPrime <- function(x = 0){
primes <- c()
# Prime finder
primes <- sapply(X = x,FUN = function(x) {
ifelse(any(x %% (2:(x - 1)) == 0), F, T)}
)
# Select primes
primes <- x[primes]
return(primes)
}
I have just tried it and it works fine.
use package "gmp" which has a function "isprime" which returns 0 for non prime numbers and 2 for prime numbers and then subset the data based on the same
say you have a vector a = c(1:10)
a = c(1:10)
b = gmp::isprime(a)
c = cbind(a,b)
c = as.data.frame(c)
c = c[c$b==2,]
a1 = c$a
a1
In your code: for(i in 1:n), there is the error

3-section transformation function in R

I hope this question is new as I couldn't find a solution that worked for me.
I have a vector x that can be filled with any real numbers. The elements in this vector should be transformed by a function in the following way:
x = 0, if x < a
x = (x-a)/(b-a), if a <= x <= b
x = 1, if x > b
This is the function I came up with:
transf <- function(x, a = 0, b = 1){
if(a > b) stop("\nThe lower bound must be smaller than the upper bound!")
if(x < a){
y = 0
}
else if(a <= x <= b){
y = (x-a)/(b-a)
}
else{
y = 1
}
return(y)
print(y)
}
I get a bunch of error messages that I can't quite put together. I also tried replacing else if and else with a simple if, but that didn't work either.
Any help on how to solve this would be very much appreciated
I'd use logical indexing:
i.low <- x < a
i.mid <- x >= a & x <= b
i.high <- x > b
x[i.low] <- 0
x[i.mid] <- (x[i.mid] - a) / (b - a)
x[i.high] <- 1
Your original post didn't say what the errors were, but I'd guess you were passing the vector in as your function argument and the errors were complaining "the condition has length > 1 and only the first element will be used". This is because you're testing the condition of a vector of logicals.

Resources