UP | HOME

Séance 3 : Algo & Prog avec R

Table des matières

1 Rappels : quelques fonctions utiles

L'exercice suivant est un complément de cours. Cherchez la documentation sur les fonctions intToBits, utf8ToInt, strtoi, et as.hexmode.

  1. Le é accentué a pour unicode 233 décimal. Comment demande-t-on au toplevel R de voir l'écriture binaire (base 2) de 233 ? Que remarquez-vous ?
l <- 'é'
ch <- utf8ToInt(l)
cat(paste("Le code UNICODE de", l, "est", ch, "\nEn binaire: "))
cat(intToBits(ch))
  1. Sur papier, quel est le résultat de l'addition 11010 + 10111 en binaire ? Vérifiez votre réponse au toplevel.
strtoi("11010", base = 2) + strtoi("10111", base = 2)
  1. Quelle est l'écriture hexadécimale (base 16) de l'entier qui s'écrit 164 en décimal ? Vérifiez-le au toplevel.
as.hexmode(164)
  1. Sur papier, quel est le résultat de l'addition 3F + A2 en hexadécimal ? En binaire ? Vérifiez votre réponse au toplevel.
as.hexmode("3F") + as.hexmode("A2")
as.integer(as.hexmode("3F") + as.hexmode("A2"))

2 Épluchages d'entiers et de chaînes   KEY

En utilisant l'idée d'épluchage d'un entier (cours 3), programmez les fonctions suivantes.

2.1 Somme des chiffres d'un nombre

SomCh <- function(n, base=10) {
  n <- abs(n);
  base <- abs(base)
  acc <- 0;
  while(n > 0) {
    acc <- acc + n %% base;
    n <- n %/% base;
  }
  return(acc)
}
  1. La fonction SomCh(n) prenant un entier n, et retournant la somme des chiffres de n en base 10.
    SomCh(3456)
    
    [1] 18
    
  2. La fonction SomChBin(n) retournant cette fois la somme des chiffres de n en binaire.
    SomCh(3456, base = 2)
    
    [1] 4
    
  3. Généraliser la fonction SomCh(n, base) pour une base quelquonque en ajoutant un second paramètre base.
    as.hexmode(3456)
    SomCh(3456,base = 16)
    
    [1] "d80"
    [1] 21
    

2.2 Écriture et lecture d'un nombre binaire.

  1. La fonction IntToBin(n) prenant un entier n et retournant la chaîne contenant l'écriture binaire de n.
    IntToBin <- function(n) {
      n <- abs(n);
      acc <- "";
      while(n > 0) {
        acc <- paste(n %% 2, str, sep="");
        n  <- n %/% 2;
      }
      return(acc)
      }
    
    n <- 3456  
    nbin <- IntToBin(3456)
    paste(n, "->", nbin,  "->", strtoi(nbin, base = 2))
    
    [1] "3456 -> 110110000000 -> 3456"
    
  2. La fonction inverse BinToInt(s) prenant une chaîne s contenant l'écriture binaire d'un entier n, et retournant n.
    BinToInt <- function(s) {
      digits <- utf8ToInt(s)-utf8ToInt("0")
      pows <- seq(from = length(digits)-1, to = 0)
      return(sum( 2**pows * digits))
    }
    
    n <- 3456  
    nbin <- IntToBin(3456)
    paste(n, "->", nbin,  "->", BinToInt(nbin))
    
    [1] "3456 -> 110110000000 -> 3456"
    

2.3 Renversement d'un nombre

Renverser <- function(n, base = 10) {
  n=abs(n);
  acc <- 0;
  while(n > 0) {
    acc <- acc * base + n %% base;
    n <- n %/% base;
  }
  return(acc)
}
  1. La fonction Renverser(n) prenant un entier positif n et retournant l'entier obtenu en prenant les chiffres de n en sens inverse.
    Renverser(34560)
    
    [1] 6543
    
  2. La fonction Renverser(n, base) prenant un entier positif n et retournant l'entier obtenu en prenant les chiffres de n en base b en sens inverse.
    ## 3456 en décimal devient 110110000000 en binaire 
    ## qui se renverse en (0000000)11011 en binaire soit 27 en décimal
    Renverser(3456, base = 2) 
    Renverser(as.hexmode("ABC"), base = 16)
    
    [1] 27
    [1] "cba"
    

3 Le tour de la boucle

Foo <- function(x,a,b) {
  for (i in a:b) {
    x = x + i
  }
  return(x)
}
Foo(10,15,20)
Foo(10,20,15)
[1] 115
[1] 115

À partir de maintenant, vous pouvez supposez que a<=b.

  1. Reprogrammez la fonction précédente en remplaçant la boucle for par une boucle while.
    Foo <- function(x,a,b) {
      while(a <= b) {
        x <- x + a
        a <- a + 1             
      }
      return(x)
    }
    Foo(10,15,20)
    
    [1] 115
    
  2. Reprogrammez cette même fonction sans utiliser aucune boucle !
    # Calcul Direct
    Foo <- function(x,a,b) {
      return( x + (b-a+1)* ((a+b) / 2) )
    }  
    Foo(10,15,20)   
    # Vectorisation
    Foo <- function(x,a,b) x + sum(a:b)
    Foo(10,15,20)
    
    [1] 115
    [1] 115
    

4 Alphabet

Alphabet <- function(upper=FALSE) intToUtf8( 0:25 + (utf8ToInt(ifelse(upper,'A','a'))))
  1. Programmez une fonction Alphabet() dont le résultat est la chaîne : 'abcdefghijklmnopqrstuvwxyz'.
Alphabet()
[1] "abcdefghijklmnopqrstuvwxyz"
  1. Ajoutez un paramètre optionel upper pour renvoyer l'alphabet en lettres minuscules ou majuscules.
Alphabet(upper = TRUE)
[1] "ABCDEFGHIJKLMNOPQRSTUVWXYZ"

5 Table ASCII

Programmez une fonction Ascii() qui affiche une table ASCII pour les caractères dont le code est compris entre 32 et 126.

Ascii <- function(upper=FALSE) {
  print(sprintf("%3d:%s", 32:126, intToUtf8(32:126, multiple=TRUE)), quote=FALSE)
}
Ascii()
 [1]  32:    33:!   34:"   35:#   36:$   37:%   38:&   39:'   40:(   41:) 
[11]  42:*   43:+   44:,   45:-   46:.   47:/   48:0   49:1   50:2   51:3 
[21]  52:4   53:5   54:6   55:7   56:8   57:9   58::   59:;   60:<   61:= 
[31]  62:>   63:?   64:@   65:A   66:B   67:C   68:D   69:E   70:F   71:G 
[41]  72:H   73:I   74:J   75:K   76:L   77:M   78:N   79:O   80:P   81:Q 
[51]  82:R   83:S   84:T   85:U   86:V   87:W   88:X   89:Y   90:Z   91:[ 
[61]  92:\\  93:]   94:^   95:_   96:`   97:a   98:b   99:c  100:d  101:e 
[71] 102:f  103:g  104:h  105:i  106:j  107:k  108:l  109:m  110:n  111:o 
[81] 112:p  113:q  114:r  115:s  116:t  117:u  118:v  119:w  120:x  121:y 
[91] 122:z  123:{  124:|  125:}  126:~

6 Tables de multiplication

Programmez une fonction TableMult(n) prenant un entier n compris entr 1 et 9, et affichant la table de mutliplication par n. Vérifier la validité de l'argument n en utilisant la fonction stopifnot.

TableMult <- function(n) {
  stopifnot(length(n) == 1, n > 0, n < 10, floor(n) == n)
  x <- 1:10
  cat(' ')
  cat(sprintf("%d x%2d = %3d\n",n,x,n*x))
}
## TableMult(0) ## error !
## TableMult(1.5) ## error !
TableMult(4)
4 x  1 =   4
4 x  2 =   8
4 x  3 =  12
4 x  4 =  16
4 x  5 =  20
4 x  6 =  24
4 x  7 =  28
4 x  8 =  32
4 x  9 =  36
4 x 10 =  40

7 Code de César   HARD

Le codage des messages secrets selon Jules César consistait à choisir une clé entière k dans [1,25] pour fabriquer à partir d'un message msg un nouveau message codé avec la technique suivante. Chaque lettre majuscule de msg est décalée de k positions vers la droite (l'alphabet est circulaire : après 'Z' on revient sur 'A'). Les autres caractères du message sont laissés intacts.

  1. Programmez la fonction CodeCesar(msg,k) qui retourne le message codé avec un décalage k.
  2. Programmez la fonction DecodeCesar(msg,k) qui prend un message codé par et retourne le message en clair.
  3. Défi urgent : décodez le message 'JLGVI XRJFZC' dont Jules a perdu la clef !
  4. Modifiez la fonction CodeCesar(msg,k) pour qu'elle code les majuscules et les minuscules.
CodeCesar <- function(msg, k) {
  ## traduction de la chaîne en vecteur de codes utf8
  cc <-utf8ToInt(msg)
  ## normalisation de la clé
  k <- k %% 26;
  CircShift <- function(aa) {
    aa <- utf8ToInt(aa)
    zz <- aa + 25
    enc <- cc >= aa & cc <= zz
    cc[enc] <- cc[enc] + k
    enc[enc] <- cc[enc] > zz
    cc[enc] <- cc[enc] - 26
    return(cc)
  }
  cc <- CircShift('a')
  cc <- CircShift('A')
  return(intToUtf8(cc))
}

DecodeCesar <- function(msg, k) CodeCesar(msg, -k)
TestCesar <- function(msg, k) {
  cod <- CodeCesar(msg,k)
  dcod <- DecodeCesar(cod,k)
  cat(paste('k=', k, ":" , msg, '-->', cod,'-->', dcod, '\n'))
}
TestCesar('envoyez 36 hommes !', 3)
TestCesar('ENVOYEZ 36 HOMMES !', -23)
TestCesar('ENVOyez 36 homMES !', 5)
k= 3 : envoyez 36 hommes ! --> hqyrbhc 36 krpphv ! --> envoyez 36 hommes !
k= -23 : ENVOYEZ 36 HOMMES ! --> HQYRBHC 36 KRPPHV ! --> ENVOYEZ 36 HOMMES !
k= 5 : ENVOyez 36 homMES ! --> JSATdje 36 mtrRJX ! --> ENVOyez 36 homMES !

8 Exercice complémentaire   HOME HARD

D'après le cours Python 6.00 du MIT. Recherche de chaînes : une perspective biologique. La recherche de chaînes (string matching) est intéressante dans plusieurs disciplines, comme la biologie, dont un problème courant consiste à comprendre la structure des molécules d'ADN, et le rôle de structures spécifiques dans le fonctionnement de la molécule. Une séquence ADN est représentée par une suite de caractères choisis parmi les quatre nucléotides : adenine (A), cytosine (C), guanine (G) et thymine (T). Par exemple, la chaîne de caractères 'AAACAACTTCGTAAGTATA' représente un brin d'ADN. Une manière de comprendre la fonction d'un brin d'ADN consiste à y rechercher une séquence précise, avec l'idée qu'une structure identique induira des effets identiques. Nous allons pénétrer un tout petit peu dans cette idée.

Programmez une fonction CountSubstringMatch(s1,s2) qui prend deux chaînes en argument et retourne le nombre de fois que s2 apparaît comme sous-chaîne de s1.
Indice : utiliser la fonction regexpr.

CountSubstringMatch <- function(str, pattern) {
  occ = 0
  r <- regexpr(pattern,str)
  while(r > 0) {
    occ <- occ + 1
    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(occ)
}
CountSubstringMatch('atatata','ata') 
CountSubstringMatch('atgacatgcacaagtatgcat','atgc') 
CountSubstringMatch('atatata','atc')
[1] 3
[1] 2
[1] 0

9 Commande tr   HOME HARD

La commande shell tr copie son entrée standard sur sa sortie standard en transposant ou éliminant des caractères. Par exemple, taper les commandes suivantes dans un terminal.

echo "foobar" | tr a-z A-Z
echo "foobar" | tr -d oa
FOOBAR
fbr

Programmer une fonction tr(text, str1, str2) similaire à la commande shell tr. La fonction retourne une copie de la chaîne de caractère text en effectuant l'une des manipulations suivantes :

  • si la chaîne str2 est vide, elle supprime les caractères de str1 ;
  • si la chaîne str2 n'est pas vide, elle transpose les caractères de str1 par ceux de str2.
tr <- function(text, str1, str2) {
  stopifnot(is.character(text), is.character(str1), 
            length(text) == 1,length(str1) == 1)
  ## transposer ou éliminer des caractères
  textL <- utf8ToInt(text)
  if( missing(str2) || is.na(str2) || nchar(str2) == 0) {
    ## éliminer les caractères de str1
    del <- utf8ToInt(str1)
    textL <- textL[ !( textL %in% del) ]
  }else {
    ## transposer les caractères de str1 par ceux de str2
    ch1 <- utf8ToInt(str1)
    ## recyclage de str2
    ch2 <- rep_len(utf8ToInt(str2), length(ch1))
    ## recherche des caractères
    x <- match(textL, ch1)
    ## position à trasnposer
    xb <- ! is.na(x)
    ## transposition
    textL[xb] <- ch2[x[xb]]
  }
  return (intToUtf8(textL))
}
tr("foobar","oo") 
tr("foobar","oa", "eu")
tr("foobar","oo", "eu")
tr("foobar","foar", "eu")
[1] "fbar"
[1] "feebur"
[1] "feebar"
[1] "euubeu"

Indice : lire la page de manuel de la commande shell tr

man tr

Created: 2017-10-04 mer. 10:02