École polytechnique
Épreuve facultative d'algorithmique

[Graphics:Images/Xalgo2002_gr_1.gif]

n = 10; 
tableau = Table[Random[Integer, 20], {n}]
a[k_] := tableau[[k + 1]]
[Graphics:Images/Xalgo2002_gr_2.gif]

Q1: on utilise un parcours linéaire du tableau [Graphics:Images/Xalgo2002_gr_3.gif]pour déterminer le max et l'inf, la fonction est donc en temps linéaire ([Graphics:Images/Xalgo2002_gr_4.gif])

amplitude[a_] := Module[{max = -Infinity, min = 
Infinity}, 
   Do[If[a[i] > max, max = a[i]]; If[a[i] < min, min = a[i]], {i, 0, n - 1}];
    max - min]
{tableau, amplitude[a]}
[Graphics:Images/Xalgo2002_gr_5.gif]

Remarque: il est évidemment plus simple d'écrire
Max[tableau]-Min[tableau]

Q2: si le max précède le min, on aura du mal à faire un gain égal à amplitude ! Ex [Graphics:Images/Xalgo2002_gr_6.gif]L'amplitude est la valeur absolue du gain ou de la perte maximale.

Q3: on utilise un parcours sur [Graphics:Images/Xalgo2002_gr_7.gif], puis sur [Graphics:Images/Xalgo2002_gr_8.gif], la fonction est donc en temps quadratique ([Graphics:Images/Xalgo2002_gr_9.gif]).

gain[a_] := Module[{bid = 0}, 
Do[If[a[j] - a[i] > bid, bid = a[j] - a[i]],
     {j, 1, n - 1}, {i, 0, j}]; bid]
gain[a]
[Graphics:Images/Xalgo2002_gr_10.gif]

Remarque: on peut se contenter de 0≤i≤j-1.

Q4: la condition j-i minimal entraîne une difficulté. On peut noter qu'il n'y a défaut d'unicité que si le max ou l'inf est atteint plusieurs fois. Une solution est d'inverser les boucles imbriquées, de faire décrémenter [Graphics:Images/Xalgo2002_gr_11.gif] et de remplacer < par ≤ !

gain[a_] := Module[{bid = 0, iMax, jMax}, 

   Do[If[a[j] - a[i] >= bid, bid = a[j] - a[i];
    iMax = i; jMax = j],
     {i, 0, n - 1}, {j, n - 1, i + 1, -1}];
    {bid, {iMax, jMax}}]
gain[a]
[Graphics:Images/Xalgo2002_gr_12.gif]

Q5: pour améliorer la complexité de l'algorithme, on va garder trace des indices des valeurs optimales.

gain1[a_] := 
Module[
        {gc = 0, indMax = 0, indMin = 0, nveauMin = 0},
   Do[If[a[i] > a[indMax], gc = a[indMax = i] - a[indMin]];
      If[a[i] - a[nveauMin] > gc,
            gc = a[indMax = i] - a[indMin = nveauMin]];
      If[a[i] < a[indMin], nveauMin = i]; ,
            {i, 1, n - 1}]; gc]
            
gain1[a]
[Graphics:Images/Xalgo2002_gr_13.gif]

Q7 (heureusement qu'on ne demande plus un temps linéaire !)
La solution la plus lisible utilise une coupure des fonctions précédentes, en les appliquant aux deux sous-tableaux obtenus en coupant [Graphics:Images/Xalgo2002_gr_14.gif] au point [Graphics:Images/Xalgo2002_gr_15.gif] et en optimisant la somme des deux par itération sur [Graphics:Images/Xalgo2002_gr_16.gif].
Pour cela, on réécrit la procédure [Graphics:Images/Xalgo2002_gr_17.gif] pour y faire figurer les dates extrêmes des transactions possibles.

gainCourtTerme[a_, début_, fin_] := 

  Module[{gc = début, indMax = début, indMin = début, nveauMin = début},
   Do[If[a[i] > a[indMax], gc = a[indMax = i] - a[indMin]];
      If[a[i] - a[nveauMin] > gc,
            gc = a[indMax = i] - a[indMin = nveauMin]];
      If[a[i] < a[indMin], nveauMin = i]; ,
    {i, début + 1, fin - 1}];
    gc]
gain2[a_] := Module[{essai, top = 0}, 

   Do[essai = gainCourtTerme[a, 0, k]
            + gainCourtTerme[a, k, n - 1];
      If[essai > top, top = essai], {k, 1, n - 1}];
            top]
            
gain2[a]
[Graphics:Images/Xalgo2002_gr_18.gif]

Q8: Idem en moins lisible

gct[a_, début_, fin_] := Module[{gc = 
début, indMax = début, indMin = début, 

    nveauMin = début},
   Do[If[a[i] > a[indMax], gc = a[indMax = i] - a[indMin]];
      If[a[i] - a[nveauMin] > gc,
        gc = a[indMax = i] - a[indMin = nveauMin]];
      If[a[i] < a[indMin], nveauMin = i]; ,
        {i, début + 1, fin - 1}];
    {gc, indMin, indMax}]
        
gain2[a_] := Module[{essai, coord, bid1, bid2, top = 0},
   Do[essai =     First[bid1 = gct[a, 0, k]] +
                First[bid2 = gct[a, k, n - 1]];
      If[essai > top, top = essai;
        coord = {bid1[[2]], bid1[[3]], bid2[[2]], bid2[[3]]}],
                {k, 1, n - 1}];
                {top, coord}]
                
gain2[a]
[Graphics:Images/Xalgo2002_gr_19.gif]

Voici une version plus idiosyncrasique où l'on adresse une liste par le numéro de ses éléments… ce qui permet de passer la liste en argument.

gct[a_List, début_, fin_] := 

Module[
    {gc = début, indMax = début, indMin = début, nveauMin = début},
   Do[If[a[[i]] > a[[indMax]],
        gc = a[[indMax = i]] - a[[indMin]]];
      If[a[[i]] - a[[nveauMin]] > gc,
        gc = a[[indMax = i]] - a[[indMin = nveauMin]]];
      If[a[[i]] < a[[indMin]], nveauMin = i],
   {i, début + 1, fin}];
    {gc, indMin, indMax}]
    
gain2[a_] := Module[
    {essai, coord, bid1, bid2, top = 0, n = Length[a]},
   Do[essai = First[bid1 = gct[a, 1, k]] +
              First[bid2 = gct[a, k, n]];
      If[essai > top, top = essai;
             coord = {bid1[[2]], bid1[[3]],bid2[[2]],bid2[[3]]}
        ],
    {k, 1, n - 1}];
    {top, coord}]
    
gct[{5, 12, 3, 6, 9, 14, 8, 20, 6, 17, 10, 11}, 1, 12]
[Graphics:Images/Xalgo2002_gr_20.gif]
[Graphics:Images/Xalgo2002_gr_21.gif]
[Graphics:Images/Xalgo2002_gr_22.gif]


Converted by Mathematica      November 30, 2002