Below are the solutions to these exercises on Functional Programming.

#################### # # # Exercise 1 # # # #################### factorial_reduce <- function(n){ stopifnot( n>=0) if(n==0){ return(1) } else{ Reduce(`*`,as.numeric(n:1)) } } #################### # # # Exercise 2 # # # #################### factorial_memoized <- function (n){ stopifnot((n>=0)) ret_value <- NA if(n==0){ return(1) } mem_vect <- rep(NA,n) mem_vect[1] <- 1 func_to_calc_fact <- function(n) if(!is.na(mem_vect[n])){ mem_vect[n] }else{ mem_vect[n-1] <<- func_to_calc_fact(n-1) n * mem_vect[n-1] } ret_value <- func_to_calc_fact(n) ret_value } #################### # # # Exercise 3 # # # #################### cum_add <- function(x) Reduce("+", x, accumulate = TRUE) #################### # # # Exercise 4 # # # #################### answer4 <- function(df){ Map(function(x) { list("min" = min(x),"max"=max(x),"avg"= mean(x)) }, Filter( function(x)is.numeric(x), df)) } #################### # # # Exercise 5 # # # #################### mm <- data.frame(x= 1:5,y=6:10,c=11:15) sweep(mm,2,colMeans(mm),"-")

## x y c ## 1 -2 -2 -2 ## 2 -1 -1 -1 ## 3 0 0 0 ## 4 1 1 1 ## 5 2 2 2

#################### # # # Exercise 6 # # # #################### my_movielist <- list(star_wars= list("A NEW HOPE","The Last Jedi","The Force Awakens"),LOTR=list("THE FELLOWSHIP OF THE RING","THE Two Towers","The RETURN of the KING","Hobbit" = list("An unexpected Journey","The Battle of the FIVE ARMY","The Desolation of Smaug") )) helper_fncs <- function(x){ x <- strsplit(x," ")[[1]] paste0(toupper(substring(x,1,1)),tolower(substring(x,2,)),collapse = " ") } rapply(my_movielist,helper_fncs,how = "replace")

## $star_wars ## $star_wars[[1]] ## [1] "A New Hope" ## ## $star_wars[[2]] ## [1] "The Last Jedi" ## ## $star_wars[[3]] ## [1] "The Force Awakens" ## ## ## $LOTR ## $LOTR[[1]] ## [1] "The Fellowship Of The Ring" ## ## $LOTR[[2]] ## [1] "The Two Towers" ## ## $LOTR[[3]] ## [1] "The Return Of The King" ## ## $LOTR$Hobbit ## $LOTR$Hobbit[[1]] ## [1] "An Unexpected Journey" ## ## $LOTR$Hobbit[[2]] ## [1] "The Battle Of The Five Army" ## ## $LOTR$Hobbit[[3]] ## [1] "The Desolation Of Smaug"

## keep in mind that this will replace the original list #################### # # # Exercise 7 # # # #################### dataset <- diamonds helper_function <- function(x){ max(x[x < max(x)]) } aggregate(dataset$price,by = dataset["color"],FUN = helper_function)

## color x ## 1 D 18674 ## 2 E 18729 ## 3 F 18784 ## 4 G 18806 ## 5 H 18795 ## 6 I 18797 ## 7 J 18706

#################### # # # Exercise 8 # # # #################### dataset <- diamonds tapply(dataset$price,list(dataset$cut,dataset$color),mean)

## D E F G H I J ## Fair 4291.061 3682.312 3827.003 4239.255 5135.683 4685.446 4975.655 ## Good 3405.382 3423.644 3495.750 4123.482 4276.255 5078.533 4574.173 ## Very Good 3470.467 3214.652 3778.820 3872.754 4535.390 5255.880 5103.513 ## Premium 3631.293 3538.914 4324.890 4500.742 5216.707 5946.181 6294.592 ## Ideal 2629.095 2597.550 3374.939 3720.706 3889.335 4451.970 4918.186

#################### # # # Exercise 9 # # # #################### aggregate(iris,iris["Species"],"[[",3)

## Species Sepal.Length Sepal.Width Petal.Length Petal.Width Species ## 1 setosa 4.7 3.2 1.3 0.2 setosa ## 2 versicolor 6.9 3.1 4.9 1.5 versicolor ## 3 virginica 7.1 3.0 5.9 2.1 virginica

#################### # # # Exercise 10 # # # #################### m <- new.env() m$a = 1:10 m$b = 100:500 m$c = 1000:1500 eapply(m,mean)

## $a ## [1] 5.5 ## ## $b ## [1] 300 ## ## $c ## [1] 1250

**What's next:**

- Become a Top R Programmer Fast with our Individual Coaching Program
- Explore all our (>4000) R exercises
- Find an R course using our R Course Finder directory
- Subscribe to receive weekly updates and bonus sets by email
- Share with your friends and colleagues using the buttons below

Dinh Tien Tai says

Very interesting and useful. I like your solutions. Thank you very much

Biswarup Ghosh says

Hi Dinh ,

Thanks for the feedback . Glad you liked it .Check the other part as well .

Jim Hunter says

Unless I’m completely mistaken, the first question has an error. In the Reduce function, you have to put the object being reduced before the reduction operation. So it should be

reduce(as.numeric(n:1), `*`), not as you have it. Your version throws an error.

Biswarup Ghosh says

Hi Jim ,

first answer uses Reduce from base R ,not reduce from purrr ,the format of Reduce is

Reduce(f, x, init, right = FALSE, accumulate = FALSE)

where as reduce from purrr has the following format

reduce(.x, .f, …, .init)

I guess that was the confusion you had

Cheers

Biswarup

Ren Lagac says

Other solutions

Exercise 1:

factorial <- function(x) {

return(

Reduce(f = '*', x = seq(from = x, to = 1), accumulate = FALSE)

)

}

Exercise 2:

fact_memoized <- function() {

mem_vector <- vector()

function(x) {

mem_vector <<- Reduce(f = '*', x = seq(from = 1, to = x), accumulate = TRUE)

cat("Your factorial result is: ", mem_vector[x], "\n")

cat("The memory contains: ", mem_vector, "\n")

}

}

func <- fact_memoized()

func(4)