If n(1) = 1 ,n(2) = 5, n(3) = 13, n(4) = 25, ...
I am using a for loop for summation of these terms
1 + (1*4 - 4) + (2*4 - 4) + (3*4 - 4) + ..
This is the function I am using with a for loop:
shapeArea <- function(n) {
terms <- as.numeric(1)
for(i in 1:n){
terms <- append(terms, (i*4 - 4))
}
sum(terms)
}
This works fine (as shown here):
> shapeArea(3)
[1] 13
> shapeArea(2)
[1] 5
> shapeArea(4)
[1] 25
Yet I was also thinking how can I do this without saving the terms of the series in numeric vector terms. In other words is there a way to find summations of terms without saving them in a vector first. Or is this the efficient way to do this.
Thanks
You can change your shapeArea function to a one-liner
shapeArea <- function(num) {
1 + sum(seq(num) * 4) - (4 * num)
}
shapeArea(1)
#[1] 1
shapeArea(2)
#[1] 5
shapeArea(3)
#[1] 13
shapeArea(4)
#[1] 25
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
I'm trying to write a for-loop of a dataset. Just to make it simple, I'll write an example:
Two variables, X and Y.
X = 3, 6, 9
Y = 4, 8, 12
I want to make a loop that does this:
(Xi - Yi)^2, so first (3-4)^2, then
(6-8)^2 and so on.
Then, after that is done, multiply by this:
((1/2)/(n*(n-1))).
In this example, it would be:
(3-4)^2 + (6-8)^2 + (9-12)^2 = 1 + 4 + 9 = 14
1/2 / (3*(3-1)) = 0.5 / 6 = 0.0833.
0.0833 * 14 = 1.166.
result <- 0
sum <- rep(NA, n)
for (i in (1:n)) {
for(j in (1:n)) {
sum <- ((gathered$X[i] - gathered$X[j])^2)
}
}
Usually in R you can avoid for loops most of the times. For your case you can do
sum((X - Y)^2) * (1/2)/(length(X) * (length(X) - 1))
#[1] 1.166666667
However, as far as for loop is concerned you should be using a single loop since you want to access X[i] and Y[i] together.
sum <- 0
n <- 3
for (i in (1:n)) {
sum <- sum + (X[i] - Y[i])^2
}
sum * (1/2)/(n*(n-1))
#[1] 1.1667
data
X = c(3, 6, 9)
Y = c(4, 8, 12)
How about this, i think outer is fit to your problem.
CASE 1 ( X-Y )
sum(diag(outer(X,Y,function(X,Y)(X-Y)^2))) *
(1/2)/(length(X) * (length(X) - 1))
1.166667
CASE 2 ( all X and Y calculation )
sum(outer(X,Y,function(X,Y)(X-Y)^2)) *
(1/2)/(length(X) * (length(X) - 1))
15.5
I am trying to multiply elements of column with itself but am unable to do it.
I have column A with values a, b, c, I want answer as (a*b + a*c + b*c).
For example, with
A <- c(2, 3, 5) the expected output is sum(6 + 10 + 15) = 31.
I am trying to run for loop to execute but was failing. Can anyone please provide R code to do this.
example data :
df1 <- data.frame(A=c(2,3,5))
combn will give you the combinations
combinations <- combn(df1$A,2)
# [,1] [,2] [,3]
# [1,] 2 2 3
# [2,] 3 5 5
apply with margin 2 (by columns), will do the multiplication
multiplied_terms <- apply(combinations,2,function(x) x[1]*x[2])
# [1] 6 10 15
Or shorter and more general, thanks to #zacdav :
multiplied_terms <- apply(combinations,2,prod)
then we can sum them
output <- sum(multiplied_terms)
# [1] 31
Piped for a compact solution:
library(magrittr)
df1$A %>% combn(2) %>% apply(2,prod) %>% sum
Here's another way. Approach by #Moody_Mudskipper maybe easier to extend to groups of 3 etc. But, I think this should be much faster since there isn't the need to actually find the combinations.
Using for loop
It just goes through the vector A multiplying the rest of the elements until the last one.
len <- length(A)
res <- numeric(0)
for (j in seq_len(len - 1))
res <- res + sum(A[j] * A[(j+1) : len]))
res
#[1] 31
Using lapply or sapply
The for loop can be replaced by using lapply
res <- sum(unlist(lapply(1 : (len - 1), function(j) sum(A[j] * A[(j+1) : len]))))
or sapply,
res <- sum(sapply(1 : (len - 1), function(j) sum(A[j] * A[(j+1) : len])))
I didn't check which of these is the fastest.
# If you need to store the pairwise multiplications, then use the following;
# res <- NULL
# for (j in 1 : (len-1))
# res <- c(res, A[j] * A[(j+1) : len])
# res
# [1] 6 10 15
# sum(res)
# [1] 31
Consider the following function:
addAmount <- function(x, amount) {
stopifnot(length(x) == 1)
return(x + amount)
}
It can be used to add some amount to x:
> addAmount(x = 5, amount = 3)
[1] 8
> addAmount(x = 2, amount = 3)
[1] 5
However, x must be of length 1:
> addAmount(x = 7:9, amount = 3)
Error: length(x) == 1 is not TRUE
I added this restriction intentionally for exemplification.
Using Vectorize, it is possible to pass in a vector for x:
> Vectorize(addAmount)(x = 7:9, amount = 3)
[1] 10 11 12
So far, so good.
However, I'd like to turn my addAmount function into a "add 3" function, using currying:
add3 <- functional::Curry(addAmount, amount = 3)
This works as expected if x is of length 1 and fails (as expected) if x is not of length 1:
> add3(x = 5)
[1] 8
> add3(x = 7:9)
Error: length(x) == 1 is not TRUE
The problem is: add3 cannot be vectorized:
> Vectorize(add3)(x = 7:9)
Error: length(x) == 1 is not TRUE
Somehow, the curried function is not "compatible" with Vectorize, i.e. it behaves as if it had not been vectorized at all.
Question: What can I do about this? How can currying and vectorization be combined? (And: What is going wrong?)
I found a workaround (heavily inspired by Hadley's add function) using environments instead of Curry, but I'm looking for a cleaner solution that doesn't require this kind of clumsy "factory" functions:
getAdder <- function(amount) {
force(amount)
addAmount <- function(x) {
stopifnot(length(x) == 1)
return(x + amount)
}
return(addAmount)
}
add3 <- getAdder(3)
Vectorize(add3)(x = 7:9)
[1] 10 11 12
Tested with R 3.4.1 and the functional package (version 0.6).
You can vectorize before currying:
add3 <- functional::Curry(Vectorize(addAmount), amount = 3)
add3(1:10)
[1] 4 5 6 7 8 9 10 11 12 13
I set up a 3 dimensinoal matrix of size 365x7x4.
x <- array(rep(1, 365*5*4), dim=c(365, 5, 4))
Now I would to use a for loop to fill each element with a value.
Lets say the value of each element should be sum of row, column and depth.
I guess this is relatively easy.
Thanks! best, F
Using a simpler example so we can see what is being done
arr <- array(seq_len(3*3*3), dim = rep(3,3,3))
the following code gives the requested output:
dims <- dim(arr)
ind <- expand.grid(lapply(dims, seq_len))
arr[] <- rowSums(ind)
The above gives
> arr
, , 1
[,1] [,2] [,3]
[1,] 3 4 5
[2,] 4 5 6
[3,] 5 6 7
, , 2
[,1] [,2] [,3]
[1,] 4 5 6
[2,] 5 6 7
[3,] 6 7 8
, , 3
[,1] [,2] [,3]
[1,] 5 6 7
[2,] 6 7 8
[3,] 7 8 9
> arr[1,1,1]
[1] 3
> arr[1,2,3]
[1] 6
> arr[3,3,3]
[1] 9
Update: Using the example in #TimP's Answer here I update the Answer to show how it can be done in a more R-like fashion.
Given
arr <- array(seq_len(3*3*3), dim = rep(3,3,3))
Replace elements of arr with i + j + k unless k > 2, in which case j*k-i is used instead.
dims <- dim(arr)
ind <- expand.grid(lapply(dims, seq_len))
## which k > 2
want <- ind[,3] > 2
arr[!want] <- rowSums(ind[!want, ])
arr[want] <- ind[want, 2] * ind[want, 3] - ind[want, 1]
Whilst it is tempting to stick with familiar idioms like looping, and contrary to popular belief loops are not inefficient in R, learning to think in a vectorised way will pay off many times over as you learn the language and start applying it to data analysis task.
Here are some timings on Fabian's example:
> x <- array(rep(1, 365*5*4), dim=c(365, 5, 4))
> system.time({
+ for (i in seq_len(dim(x)[1])) {
+ for (j in seq_len(dim(x)[2])) {
+ for (k in seq_len(dim(x)[3])) {
+ val = i+j+k
+ if (k > 2) {
+ val = j*k-i
+ }
+ x[i,j,k] = val
+ }
+ }
+ }
+ })
user system elapsed
0.043 0.000 0.044
> arr <- array(rep(1, 365*5*4), dim=c(365, 5, 4))
> system.time({
+ dims <- dim(arr)
+ ind <- expand.grid(lapply(dims, seq_len))
+ ## which k > 2
+ want <- ind[,3] > 2
+ arr[!want] <- rowSums(ind[!want, ])
+ arr[want] <- ind[want, 2] * ind[want, 3] - ind[want, 1]
+ })
user system elapsed
0.005 0.000 0.006
and for a much larger (for my ickle laptop at least!) problem
> x <- array(rep(1, 200*200*200), dim=c(200, 200, 200))
> system.time({
+ for (i in seq_len(dim(x)[1])) {
+ for (j in seq_len(dim(x)[2])) {
+ for (k in seq_len(dim(x)[3])) {
+ val = i+j+k
+ if (k > 2) {
+ val = j*k-i
+ }
+ x[i,j,k] = val
+ }
+ }
+ }
+ })
user system elapsed
51.759 0.129 53.090
> arr <- array(rep(1, 200*200*200), dim=c(200, 200, 200))
> system.time({
+ dims <- dim(arr)
+ ind <- expand.grid(lapply(dims, seq_len))
+ ## which k > 2
+ want <- ind[,3] > 2
+ arr[!want] <- rowSums(ind[!want, ])
+ arr[want] <- ind[want, 2] * ind[want, 3] - ind[want, 1]
+ })
user system elapsed
2.282 1.036 3.397
but even that may be modest to small by today's standards. You can see that the looping starts to become ever more uncompetitive because of the all the function calls required by that method.
Fabian: from the phrasing of your question, I believe you're just looking for a simple way of setting values in the array to follow any set of rules you might devise. No problem.
Your array is small (and from the context I strongly suspect you only want to use the code for something of that size). So good practice is simply to use a set of three for loops, which will run almost instantly - no need for any unnecessary complications. My code below shows an example: here we set element x[i,j,k] to be i+j+k, unless k>2, in which case we set it to be j*k-i instead.
Obviously, you can have as many rules as you want - just add an if statement for each one, and define val to be the value you want x[i,j,k] to take if that condition is true. (There's a few different ways to set this up, but this one seems the simplest to understand.) At the end of the innermost loop, x[i,j,k] gets set to the required value (val), and we then go on and do the next element until they're all done. That's it!
x = array(rep(1, 365*5*4), dim=c(365, 5, 4))
for (i in seq_len(dim(x)[1])) {
for (j in seq_len(dim(x)[2])) {
for (k in seq_len(dim(x)[3])) {
val = i+j+k
if (k > 2) {
val = j*k-i
}
x[i,j,k] = val
}
}
}
Hope this helps :)
Quick update (non-loopy method): For completeness, if you're in a real hurry and want your code to run in 0.07 seconds rather than 0.19 seconds... you could also set things up in a vectory way like this:
comb = expand.grid(seq_len(365), seq_len(5), seq_len(4))
i = comb$Var1; j = comb$Var2; k = comb$Var3
val = i+j+k
subs = which(k>2); val[subs] = (j*k-i)[subs]
x = array(val, dim = c(365, 5, 4))
In the above, the variables i, j and k are vectors with length 7300 (the number of cells in the array). As before, the default choice for val is the sum i+j+k except on the subset k>2, where val is j*k-i instead - exactly the same as the example in the first part of my answer. Obviously the notation in this method is quite a bit harder which is why I thought it'd be better to show you the loop-based solution. Hopefully you'll see how you could add in other conditions to the above though. The final line maps the vector val over to the array x in the right way so that each x[i,j,k] takes on the correct value of val. Try it and see :)
One small point to note though: if you were ever to want to run this sort of algorithm on a massive array (much, much, much bigger than the one you have now), then the approach immediately above would definitely be the one to use to minimise runtime. For your case, my advice is to use whichever one you feel more comfortable with as the runtime isn't really an issue.
Cheers! :)