UP | HOME

Séance 5 : Algo & Prog avec R

Table des matières

1 Recherche de maximum(s) dans un vecteur

1.1 Recherche à partir d'une position

Programmez la fonction MaxFrom(x,i) prenant un vecteur numérique x et retournant le maximum de x à partir de l’indice i inclus.

  1. Avec une boucle.
    MaxFrom <- function(x, i = 1) {
      vmax <- -Inf
      j <- max(i,1)
      while(j <= length(x)) {
          if(x[j] > vmax) {
            vmax <- x[j]
          }
          j <- j + 1
        }
      return(vmax)
    }
    
    print(MaxFrom(c(), 1))
    x <- sample(1:100, 6, replace = TRUE)
    print(x)
    print(MaxFrom(x,0))
    print(MaxFrom(x,4))
    print(MaxFrom(x,7))
    
    [1] -Inf
    [1] 51 57 98 30 19 75
    [1] 98
    [1] 75
    [1] -Inf
    
  2. Avec des fonctions prédéfinies. Indices : tail et max.
    MaxFrom <- function(x, i = 1) {
      if(i > 1) {
        x <- tail(x,-i+1)
      }
      return(max(x))
    }
    
    print(MaxFrom(c(), 1))
    print(MaxFrom(x,0))
    print(MaxFrom(x,4))
    print(MaxFrom(x,7))
    
    [1] -Inf
    Warning message:
    In max(x) : aucun argument pour max ; -Inf est renvoyé
    [1] 98
    [1] 75
    [1] -Inf
    Warning message:
    In max(x) : aucun argument pour max ; -Inf est renvoyé
    

1.2 Recherche de la valeur et de la position

Programmer une fonction MaxAndIdx(x) prenant en argument un vecteur x numérique, et retournant un vecteur contenant le plus grand élément et sa position.

  1. Avec une boucle.
    MaxAndIdx <- function(x) {
        imax=0;
        vmax=-Inf
        for (i in seq_along(x)) {
          if(x[i] > vmax) {
            imax=i;
            vmax=x[i];
          }
        }
        return (c(vmax, imax))
      }
    
    x <- runif(6);
    print(x)
    print(MaxAndIdx(x))
    
    [1] 0.2560613 0.7291801 0.5234866 0.2992518 0.3504035 0.4288227
    [1] 0.7291801 2.0000000
    
  2. Avec des fonctions prédéfinies. Indice : which.max.
    MaxAndIdx <- function(x) c(max(x), which.max(x))
    
    print(MaxAndIdx(x))
    
    [1] 0.7291801 2.0000000
    
  3. Attention, l'affichage facilite la lecture, mais peut induire en erreur sur le type des données.
    x <- c(0, 0.25, 0.5)
    print(x)  
    print(x[-2])
    print(x[1]) 
    print(typeof(x[1]))
    
    [1] 0.00 0.25 0.50
    [1] 0.0 0.5
    [1] 0
    [1] "double"
    

1.3 Recherche des k plus grands éléments.

  1. Programmez une fonction avec une boucle Max2(x) prenant un vecteur x numérique, et retournant le couple des deux plus grands éléments de x, le maximum étant en première position.
    Max2 <- function(x) {
      v1=-Inf
      v2=-Inf
      for (v in x) {
        if(v > v1) {
          v2 <- v1
          v1 <- v
        } else if(v > v2) {
          v2 <- v
        }
      }
      return(c(v1,v2))
    }
    
    print(Max2(c()))
    x <- runif(6);
    print(x)
    print(Max2(x))
    
    [1] -Inf -Inf
    [1] 0.6031135 0.1285228 0.3853113 0.7070992 0.7411141 0.9772133
    [1] 0.9772133 0.7411141
    
  2. Programmez une fonction avec une boucle Kmax(x, k) prenant un vecteur x numérique, et retournant les k plus grands éléments de x triés par ordre non croissant. Indices : sort et tail.
    Kmax <- function(x, k) {
      k <- max(1,k)
      return( head( sort(x, decreasing = TRUE), k) )
    }
    
    x <- sample(1:100, 6, replace = TRUE)
    print(x)
    print(Kmax(x, 0))
    print(Kmax(x, 2))
    print(Kmax(x, 4))
    print(Kmax(x, 7))
    
    [1] 85 31 20 43 60 37
    [1] 85
    [1] 85 60
    [1] 85 60 43 37
    [1] 85 60 43 37 31 20
    

2 Flux d'élèves

En l’an 2000, le lycée A compte 2 000 élèves et le lycée B compte 8 000 élèves. Une étude montre que, chaque année :

  • 10% des élèves du lycée A quittent leur lycée pour aller au lycée B ;
  • 15% des élèves du lycée B quittent leur lycée pour aller au lycée A.
    1. Au bout de combien de temps le lycée A comptera-t-il plus d’élèves que le lycée B ?
    2. Quelle est l'évolution de ce système dynamique ? Est-ce qu'il atteint un état stationnaire ? Si oui, caractèrisez-le.
    3. Tracer un graphique illustrant l'évolution de ce système dynamique. Que se passe t'il ? Expliquez.
n <- 50;  
na <- numeric(n)
na[1] <- 2000
nab <- 10000
for(i in seq(2,n)) {
   da <- round( na[i-1] / 10 )
   db <- round( 3*(nab-na[i-1])/20 )  
   na[i] <- na[i-1] - da + db 
   if(na[i] == na[i-1]) {
     na <- head(na, i)
     break
   }
 }
nb <- nab - na
plot(na, type = 'b', xlab = "Année", ylab = "Effectif", lty = 1, pch = 1)
lines(nb, type = 'b', lty = 2, pch = 2)

3 Vectorisation ou fonction prédéfinie Filter

Vous ne devez utiliser aucune boucle.

3.1 Nombres non multiples d'un entier k

Programmez une fonction NoMult(k,a,b) retournant le vecteur des entiers non multiples de k dans l’intervalle [a,b]. Essayez de programmer une fonction sans boucle, en la vectorisant ou utilisant la fonction filter.

NoMult <- function(k,a,b) {
  x <- a:b;
  return(x[ x %% k != 0])
}
NoMult(5,10,30)
[1] 11 12 13 14 16 17 18 19 21 22 23 24 26 27 28 29
NoMult <- function(k,a,b) Filter(function(n) n %% k != 0 , a:b)
NoMult(2,11,31)
[1] 11 13 15 17 19 21 23 25 27 29 31

3.2 Nombres premiers avec un entier k   HARD

Programmez une fonction CoPremiers(k,a,b) retournant le vecteur des entiers copremiers avec k dans l’intervalle [a,b].

PGCD <- function(a,b) {
  while ( b != 0 ) {
    tmp = a %% b
    a = b
    b = tmp
  }
  return(a);
}
CoPremiers <- function(k,a,b) Filter(function(n) PGCD(n,k) == 1 , a:b)
CoPremiers(15,10,30)
[1] 11 13 14 16 17 19 22 23 26 28 29

4 Jeu de Pendu

Le pendu est un jeu consistant à trouver un mot en devinant quelles sont les lettres qui le composent.

  1. Programmer une fonction JeuPendu() sans limite du nombre de coups. Le joueur entre une lettres au clavier jusqu'à ce qu'il ait trouvé le mot.
  2. Modifier la fonction JeuPendu(n) pour que le joueur soit déclaré perdant après n erreurs.

Vous pouvez utiliser la fonction suivante pour capturer les saisies au claviers.

Read1 <- function(x) {
  cat(sprintf("Entrer %s :\n", x))
  word <- scan(file = "", what = "character", n = 1, quiet = TRUE)
  stopifnot(length(word) == 1)
  return(word)
}

Le déroulement du jeu doit s'inspirer de l'exemple ci-dessous.

JeuPendu <- function(n = Inf) {
  ## Type a word
  word <- Read1("un mot")
  cat("Tapez Ctrl + L pour effacer l'écran.\n")

  ## Init. search objects
  word.code <- utf8ToInt(tolower(word))
  word.mask <- !logical(nchar(word))
  i <- 1
  j <- 0
  while(any(word.mask) && j < n) {
    ## Type a letter
    letter <- Read1("une lettre")
    stopifnot(nchar(letter) == 1)
    ## Update search status 
    word.letter <- word.code != utf8ToInt(letter)
    if(all(word.letter)) {
     j <- j + 1
    }
    word.mask <- word.mask & word.letter
    ## Pretty print of the search status
    word.current <- word.code
    word.current[word.mask] <- utf8ToInt("_")
    cat(sprintf("Tour %d : %s\n", i, intToUtf8(word.current)))
    ## Increment round
    i <- i + 1
  }
  cat( ifelse( any(word.mask), "Perdu\n", "Gagné\n"))
 }
}
> JeuPendu()
Entrer un mot :
1: ici
Tapez Ctrl + L pour effacer l'écran.
Entrer une lettre :
1: a
Tour 1 : ___
Entrer une lettre :
1: i
Tour 2 : i_i
Entrer une lettre :
1: b
Tour 3 : i_i
Entrer une lettre :
1: c
Tour 4 : ici
>

5 Compression d'un vecteur

  1. Programmez une fonction Compacter(x) prenant une vecteur x et remplaçant toute suite d’éléments consécutifs x, x,…, x par le seul élément x.
    Compacter <- function(x) {
      i <- 1
      cx <- c()
      while (i <= length(x) ) {
        y <- x[i]
        i <- i + 1
        cx <- append(cx, y)
        ## ou
        ## cx[length(cx)+1] <- x
        while (i <= length(x) && x[i]==y) {
          i <- i + 1
        }
      }
      return(cx)
    }
    
    x <- c(3,3,3,8,5,5,5,7,7)
    Compacter(x)
    Compacter(c(1,x,9))
    Compacter(c(x,x))
    
    [1] 3 8 5 7
    [1] 1 3 8 5 7 9
    [1] 3 8 5 7 3 8 5 7
    
  2. Programmez une fonction Compacter(x) vectorisée. Indice : utiliser les fonctions diff et as.logical.
    Compacter <- function (x) x[c(TRUE, as.logical(diff(x)))]
    Compacter(x)
    Compacter(c(1,x,9))
    
    [1] 3 8 5 7
    [1] 1 3 8 5 7 9
    
  3. Modifiez la fonction Compacter de sorte qu’elle indique en plus la longueur de chaque sous-suite d’éléments consécutifs.   HARD

    La fonction renvoie une liste nommée contenant deux vecteurs.

    Compacter <- function(x) {
      i <- 1
      cx <- c()
      cl <- c()
      while (i <= length(x) ) {
        y <- x[i]
        j <- i + 1
        cx <- append(cx, y)
        while (j <= length(x) && x[j]==y) {
          j <- j + 1
        }
        cl <- append(cl, j-i)
        i <- j
      }
      return(list(values = cx, lengths = cl ))
    }
    
    Compacter(x)
    
    $values
    [1] 3 8 5 7
    
    $lengths
    [1] 3 1 3 2
    
    Compacter(c(1,x,9))
    
    $values
    [1] 1 3 8 5 7 9
    
    $lengths
    [1] 1 3 1 3 2 1
    

6 Masque d'une chaîne

Programmez une fonction masque(s,x) prenant un vecteur x numérique et une chaîne s, et retournant une nouvelle chaîne contenant les caractères dont les positions dans s figurent dans la liste x.

masque <- function(str, pos) intToUtf8(utf8ToInt(str)[pos])
masque("CAGCTACCTA",c(2,5,3,8))
[1] "ATGC"

Attention : les chaînes de caractères ne sont pas des vecteurs.

7 Algorithme d'Euclide

L’algorithme d’Euclide pour calculer le PGCD de deux entiers a et b ≥ 0 consiste à appliquer les deux règles suivantes :

  • si b = 0, le PGCD de a et de b est a
  • sinon, le PGCD de a et b est le même que celui de b et du reste de la division de a par b
  1. Calculez le PGCD de 8 et 12 par cette méthode.
  2. Programmez une fonction récursive pgcd(a,b).
    pgcd <- function(a,b) ifelse(b == 0, a, pgcd(b, a %% b))
    pgcd(12,8)
    pgcd(8,12)
    pgcd(87,116)
    
    [1] 4
    [1] 4
    [1] 29
    
  3. Programmez cette fonction de manière itérative.
    pgcd <- function(a,b) {
      while ( b != 0 ) {
        tmp = a %% b
        a = b
        b = tmp
      }
      return(a);
    }
    pgcd(12,8)
    pgcd(8,12)
    pgcd(87,116)
    
    [1] 4
    [1] 4
    [1] 29
    

8 Algorithme de Bezout

L’algorithme de Bezout prolonge l’algorithme d’Euclide. Il dit qu’il est possible d’écrire le PGCD g de a et b comme combinaison linéaire de a et b à coefficients entiers : il existe u et v (non uniques) tels que g = a*u + b*v. Par exemple 4 = 8*(-1) + 12*1.

  1. On se propose de programmer une fonction bezout(a,b) retournant un triplet (g,u,v).
  2. Montrez que si l’on sait calculer bezout(b,a %% b), alors on peut en déduire bezout(a,b).
  3. Programmez une fonction bezout(a,b) récursive. Testez-la sur bezout(8,12).
    bezout <- function(a,b) {
      ## fonction récursive 
      if(b == 0) return(c(a,1,0))
      x <- bezout(b, a %% b)
      return( c(x[1], x[3], x[2] - a %/% b * x[3]))
    }
    print(bezout(8, 12))
    
    [1] 12  0  1
    [1]  4 -1  1
    
  4. Programmez une fonction aff_bezout(a,b) affichant la décomposition g = a*u + b*v.
    aff_bezout <- function(a,b) {
      bz <- bezout(a,b);
      paste(bz[2],'*',a,'+',bz[3],'*',b,'=',bz[1])
    }
    
    aff_bezout(8, 12)
    aff_bezout(120,23)
    aff_bezout(5040,4116)
    
    [1] "-1 * 8 + 1 * 12 = 4"
    [1] "-9 * 120 + 47 * 23 = 1"
    [1] "9 * 5040 + -11 * 4116 = 84"
    
  5. Programmez une fonction bezout(a,b) itérative. Testez-la sur bezout(8,12).
    bezout <- function(a,b) {
      ## fonction itérative 
      bz <- c(a,1,0,b,0,1)
      ## égalités r = a*u+b*v et r' = a*u'+b*v' sont des invariants de boucle
      while(bz[4] != 0) {
        q <- bz[1] %/% bz[4]
        bz <- c(bz[4:6], bz[1:3]-q*bz[4:6])
        ##print(bz)
      }
      return(bz[1:3])
    }
    aff_bezout(8, 12)
    aff_bezout(120,23)
    aff_bezout(5040,4116)
    
    [1] "-1 * 8 + 1 * 12 = 4"
    [1] "-9 * 120 + 47 * 23 = 1"
    [1] "9 * 5040 + -11 * 4116 = 84"
    

9 Recherche d'un motif   HOME

Nous poursuivons l’exercice complémentaire du TP3, dont nous supposons que vous avez programmé la fonction CountSubstringMatch(s1,s2) dont vous allez vous inspirer. Programmez une fonction SubstringMatchExact(s1,s2) retournant le vecteur conternant les positions successives de l’apparition de s2 dans s1.

SubstringMatchExact <- function(str, pattern) {
  res <- c();
  r <- regexpr(pattern,str)
  i <- 0
  while(r > 0) {
    i <- i + r
    res <- append(res, i)
    str <- substr(str,start=r+1,stop=nchar(str))
    r <- regexpr(pattern,str)
    ## On ne peut pas utilisr gregexpr, car on autorise le chevauchement entre les motifs
  }
  return(res)
}
SubstringMatchExact('atatata','ata')
[1] 1 3 5
SubstringMatchExact('atgacatgcacaagtatgcat','atgc')
[1]  6 16

Created: 2017-11-02 jeu. 13:59