Cours complet pour débutants pour apprendre la programmation en R

Solution de l'exercice 2.1

1. Il y a plusieurs façons de créer les troisième et quatrième éléments de la liste. Le plus simple consiste à utiliser numeric() et logical() :

    

   Sélectionnez

   > x <- list(1:5, data = matrix(1:6, 2, 3), numeric(3),
   + test = logical(4))

2. > names(x)

3. >

    

   Sélectionnez

   mode(x$test)
   > length(x$test)

4. > dim(x$data)

5. > x[[2]][c(2, 3)]

6. > x[[3]] <- 3:8

Solution de l'exercice 2.2

1. > x[2]
2. > x[1:5]
3. > x[x > 14]
4. > x[-c(6, 10, 12)]

Solution de l'exercice 2.3

1. > x[4, 3]
2. > x[6, ]
3. > x[, c(1, 4)]
4. > x[x[, 1] > 50, ]

Solution de l'exercice 3.1

1. > rep(c(0, 6), 3)
2. > seq(1, 10, by = 3)
3. > rep(1:3, 4)
4. > rep(1:3, 1:3)
5. > rep(1:3, 3:1)
6. > seq(1, 10, length = 3)
7. > rep(1:3, rep(4,3))

Solution de l'exercice 3.2

1. > 11:20 / 10
2. > 2 * 0:9 + 1
3. > rep(-2:2, 2)
4. > rep(-2:2, each = 2)
5. > 10 * 1:10

Solution de l'exercice 3.3 Soit mat une matrice.

1. > apply(mat, 1, sum)
2. > apply(mat, 2, sum)
3. > apply(mat, 1, mean)

4. > apply(mat, 2, mean)

   Solution de l'exercice 3.4> cumprod(1:10)

   Solution de l'exercice 3.5x == (x %% y) + y * (x %/% y)

   Solution de l'exercice 3.6

    

   Sélectionnez

   > x[1:5]
   > head(x, 5)

5. > max(x)

    

   Sélectionnez

   > mean(x[1:5])
   > mean(head(x, 5))

6. S

> mean(x[16:20])
> mean(x[(length(x) - 4):length(x)])  # plus général
> mean(tail(x, 5))                    # plus lisible!

Solution de l'exercice 3.7

1. (j - 1)*I + i
2. ((k - 1)*J + j - 1)*I + i

Solution de l'exercice 3.8

1. > rowSums(mat)
2. > colMeans(mat)
3. > max(mat[1:3, 1:3])
4. > mat[rowMeans(mat) > 7,]

Solution de l'exercice 3.9> temps[match(unique(cummin(tps)), temps)]

Solution de l'exercice 4.1> sum(P / cumprod(1 + i))

Solution de l'exercice 4.2

> x <- c(7, 13, 3, 8, 12, 12, 20, 11)
> w <- c(0.15, 0.04, 0.05, 0.06, 0.17, 0.16, 0.11, 0.09)
> sum(x * w)/sum(w)

Solution de l'exercice 4.3> 1/mean(1/x)

Solution de l'exercice 4.4

> lambda <- 2
> x <- 5
> exp(-lambda) * sum(lambda^(0:x)/gamma(1 + 0:x))

Solution de l'exercice 4.5

> x <- 10^(0:6)
> probs <- (1:7)/28

1. > sum(x^2 * probs) - (sum(x * probs))^2

Solution de l'exercice 4.6

> i <- 0.06
> 4 * ((1 + i)^0.25 - 1)

Solution de l'exercice 4.7

> n <- 1:10
> i <- seq(0.05, 0.1, by = 0.01)
> (1 - outer((1 + i), -n, "^"))/i

ou

> n <- 1:10
> i <- (5:10)/100
> apply(outer(1/(1+i), n, "^"), 1, cumsum)

Solution de l'exercice 4.8

> v <- 1/1.06
> k <- 1:10
> sum(k * v^(k - 1))

Solution de l'exercice 4.9

> pmts <- rep(1:4, 1:4)
> v <- 1/1.07
> k <- 1:10
> sum(pmts * v^k)

Solution de l'exercice 4.10

> v <- cumprod(1/(1 + rep(c(0.05, 0.08), 5)))
> pmts <- rep(1:4, 1:4)
> sum(pmts * v)

Solution de l'exercice 5.1

variance <- function(x, biased = FALSE)
{
    if (biased)
    {
        n <- length(x)
        (n - 1)/n * var(x)
    }
    else
        var(x)
}

Solution de l'exercice 5.2 Une première solution utilise la transposée. La première expression de la fonction s'assure que la longueur de data est compatible avec le nombre de lignes et de colonnes de la matrice demandée.

matrix2 <- function(data = NA, nrow = 1, ncol = 1,
                    bycol = FALSE, dimnames = NULL)
{
    data <- rep(data, length = nrow * ncol)

    if (bycol)
        dim(data) <- c(nrow, ncol)
    else
    {
        dim(data) <- c(ncol, nrow)
        data <- t(data)
    }

    dimnames(data) <- dimnames
    data
}

La seconde solution n'a pas recours à la transposée. Pour remplir la matrice par ligne, il suffit de réordonner les éléments du vecteur data en utilisant la formule obtenue à l'exercice 3.7.

matrix2 <- function(data = NA, nrow = 1, ncol = 1,
                    bycol = FALSE, dimnames = NULL)
{
    data <- rep(data, length = nrow * ncol)

    if (!bycol)
    {
        i <- 1:nrow
        j <- rep(1:ncol, each = nrow)
        data <- data[(i - 1)*ncol + j]
    }
    dim(data) <- c(nrow, ncol)
    dimnames(data) <- dimnames
    data
}

Solution de l'exercice 5.3

phi <- function(x)
{
    exp(-x^2/2) / sqrt(2 * pi)
}

Solution de l'exercice 5.4

Phi <- function(x)
{
    n <- 1 + 2 * 0:50
    0.5 + phi(x) * sum(x^n / cumprod(n))
}

Solution de l'exercice 5.5 La première solution utilise une fonction interne et une structure de contrôle if ... else.

Phi <- function(x)
{
    fun <- function(x)
    {
        n <- 1 + 2 * 0:50
        0.5 + phi(x) * sum(x^n / cumprod(n))
    }

    if (x < 0)
        1 - fun(-x)
    else
        fun(x)
}

Seconde solution sans structure de contrôle if ... else. Rappelons que dans des calculs algébriques, FALSE vaut 0 et TRUE vaut 1.

Phi <- function(x)
{
    n <- 1 + 2 * 0:50
    neg <- x < 0
    x <- abs(x)
    neg + (-1)^neg * (0.5 + phi(x) * sum(x^n / cumprod(n)))
}

Solution de l'exercice 5.6

Phi <- function(x)
{
    n <- 1 + 2 * 0:30
    0.5 + phi(x) * colSums(t(outer(x, n, "^")) / cumprod(n))
}

Solution de l'exercice 5.7

prod.mat <- function(mat1, mat2)
{
    if (ncol(mat1) == nrow(mat2))
    {
        res <- matrix(0, nrow = nrow(mat1),
                      ncol = ncol(mat2))
        for (i in 1:nrow(mat1))
        {
            for (j in 1:ncol(mat2))
            {
                res[i, j] <- sum(mat1[i,] * mat2[,j])
            }
        }
        res
    }
    else
        stop("Les dimensions des matrices ne permettent pas le produit matriciel.")
}

prod.mat<-function(mat1, mat2)
{
    if (ncol(mat1) == nrow(mat2))
    {
        res <- matrix(0, nrow = nrow(mat1),
                      ncol = ncol(mat2))
        for (i in 1:nrow(mat1))
            res[i,] <- colSums(mat1[i,] * mat2)
        res
    }
    else
        stop("Les dimensions des matrices ne permettent pas le produit matriciel.")
}

Solutions bonus : deux façons de faire équivalentes qui cachent la boucle dans un sapply.

prod.mat<-function(mat1, mat2)
{
    if (ncol(mat1) == nrow(mat2))
        t(sapply(1:nrow(mat1),
                 function(i) colSums(mat1[i,] * mat2)))
    else
    stop("Les dimensions des matrices ne permettent pas le produit matriciel.")
}

prod.mat<-function(mat1, mat2)
{
    if (ncol(mat1) == nrow(mat2))
        sapply(1:ncol(mat2),
               function(j) colSums(t(mat1) * mat2[,j]))
    else
        stop("Les dimensions des matrices ne permettent pas le produit matriciel.")
}

Solution de l'exercice 5.8 Le calcul à faire n'est qu'un simple produit matriciel, donc :

notes.finales <- function(notes, p) notes %*% p

Solution de l'exercice 5.10

param <- function (moyenne, variance, loi)
{
    loi <- tolower(loi)
    if (loi == "normale")
    {
        param1 <- moyenne
        param2 <- sqrt(variance)
        return(list(mean = param1, sd = param2))
    }
    if (loi == "gamma")
    {
        param2 <- moyenne/variance
        param1 <- moyenne * param2
        return(list(shape = param1, scale = param2))
    }
    if (loi == "pareto")
    {
        cte <- variance/moyenne^2
        param1 <- 2 * cte/(cte-1)
        param2 <- moyenne * (param1 - 1)
        return(list(alpha = param1, lambda = param2))
    }
    stop("La loi doit etre une de \"normale\", \"gamma\" ou \"pareto\"")
}

Solution de l'exercice 6.1 Soit Xij et wij des matrices, et Xijk et wijk des tableaux à trois dimensions.

1. > rowSums(Xij * wij)/rowSums(wij)
2. > colSums(Xij * wij)/colSums(wij)
3. > sum(Xij * wij)/sum(wij)
4. > apply(Xijk * wijk, c(1, 2), sum) / apply(wijk, c(1, 2), sum)
5. > apply(Xijk * wijk, 1, sum)/apply(wijk, 1, sum)
6. > apply(Xijk * wijk, 2, sum)/apply(wijk, 2, sum)
7. > sum(Xijk * wijk)/sum(wijk)

Solution de l'exercice 6.2

1. > unlist(lapply(0:10, seq, from = 0))
2. > unlist(lapply(1:10, seq, from = 10))
3. > unlist(lapply(10:1, seq, to = 1))

Solution de l'exercice 6.3

1. > x <- lapply(seq(100, 300, by = 50), rpareto, shape = 2, scale = 5000)
2. > names(x) <- paste("sample", 1:5, sep = "")

3. > sapply(x, mean)

    

   Sélectionnez

   > lapply(x, function(x) sort(ppareto(x, 2, 5000)))
   > lapply(lapply(x, sort), ppareto,  shape = 2, scale = 5000)

4. > hist(x$sample5)

5. > lapply(x, "+", 1000)

Solution de l'exercice 6.4

1. > mean(sapply(x, function(liste) liste$franchise))

   Les crochets utilisés pour l'indiçage constituent en fait un opérateur dont le « nom » est [[. On peut donc utiliser cet opérateur dans la fonction sapply :

    

   Sélectionnez

   > mean(sapply(x, "[[", "franchise"))

2. > sapply(x, function(x) mean(x$nb.acc))

3. > sum(sapply(x, function(x) sum(x$nb.acc))) ou > sum(unlist(sapply(x, "[[", "nb.acc")))

4. > mean(unlist(lapply(x, "[[", "montants")))

5. > sum(sapply(x, function(x) sum(x$nb.acc) == 0))

6. > sum(sapply(x, function(x) x$nb.acc[1] == 1))

7. > var(unlist(lapply(x, function(x) sum(x$nb.acc))))

8. > sapply(x, function(x) var(x$nb.acc))

> y <- unlist(lapply(x, "[[", "montants"))
> sum(y <= x)/length(y)

La fonction ecdf retourne une fonction permettant de calculer la fonction de répartition empirique en tout point :

> ecdf(unlist(lapply(x, "[[", "montants")))(x)

> y <- unlist(lapply(x, "[[", "montants"))
> colSums(outer(y, x, "<="))/length(y)

La fonction retournée par ecdf accepte un vecteur de points en argument :

> ecdf(unlist(lapply(x, "[[", "montants")))(x)

Solution de l'exercice 7.1

> f <- function(x) x^3 - 2 * x^2 - 5
> uniroot(f, lower = 1, upper = 4)

1. Comme un simple graphique le démontre, il y a deux racines dans l'intervalle.

> f <- function(x) x^3 + 3 * x^2 - 1
> curve(f, xlim = c(-4, 0))
> uniroot(f, lower = -4, upper = -1)
> uniroot(f, lower = -1, upper = 0)

> f <- function(x) x - 2^(-x)
> uniroot(f, lower = 0, upper = 1)

> f <- function(x) exp(x) + 2^(-x) + 2 * cos(x) - 6
> uniroot(f, lower = 1, upper = 2)

> f <- function(x) exp(x) - x^2 + 3 * x - 2
> uniroot(f, lower = 0, upper = 1)

Solution de l'exercice 7.2

> X <- c(2061, 1511, 1806, 1353, 1600)
> w <- c(100155, 19895, 13735, 4152, 36110)
> g <- function(a, X, w, s2)
+ {
+     z <- 1/(1 + s2/(a * w))
+     Xz <- sum(z * X)/sum(z)
+     sum(z * (X - Xz)^2)/(length(X) - 1)
+ }
> uniroot(function(x) g(x, X, w, 140E6) - x, c(50000, 80000))

Solution de l'exercice 7.3

> dpareto <- function(x, alpha, lambda)
+ {
+     (alpha * lambda^alpha)/(x + lambda)^(alpha+1)
+ }
> f <- function(par, x) -sum(log(dpareto(x, par[1], par[2])))
> optim(c(1, 1000), f, x = x)

ou, en utilisant le truc du logarithme des paramètres expliqué dans le code informatique de la section 7.4Exemples pour éviter les soucis de convergence :

> dpareto <- function(x, logAlpha, logLambda)
+ {
+     alpha <- exp(logAlpha)
+     lambda <- exp(logLambda)
+     (alpha * lambda^alpha)/(x + lambda)^(alpha+1)
+ }
> optim(c(log(2), log(1000)), f, x = x)
> exp(optim(c(log(2), log(1000)), f, x = x)$par)

Solution de l'exercice 8.1

> x <- rlnorm(1000, meanlog = log(5000) - 0.5, sdlog = 1)
> hist(x)

Solution de l'exercice 8.2

> x <- rpois(10000, lambda = rgamma(10000, shape = 5, rate = 4))
> xx <- seq(min(x), max(x))
> px <- table(x)
> plot(xx, dnbinom(xx, size = 5, prob = 0.8),
+ type = "h", lwd = 5, col = "blue")
> points(xx, px/length(x), pch = 16)

Solution de l'exercice 8.3

> w <- rbinom(1, 10000, 0.55)
> x <- c(rlnorm(w, 3.5, 0.6), rlnorm(10000 - w, 4.6, 0.3))
> hist(x)