Discussion :

[Nemerle]

Salut, je propose le petit jeu suivant (fô bien se marrer en août...): j'ai dix millions de float, et je souhaite en extraire la 1000ième valeur la plus élevée.

Qui donnera l'algo le + rapide?

[Nebulix]

A ma grande honte, je ne sais plus où j'ai trouvé çà
Numerical Recipes vraisemblablement
(apa est un tableau de single)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
 
function select(k,n:integer;var apa:asing):single;
var i,j:integer;
 
procedure xch(l,m:integer);
var x:single;
begin
x:=apa[l];apa[l]:=apa[m];apa[m]:=x;
end;
 
begin
l:=1;h:=n;
repeat
i:=l;j:=h;
mid:=(l+h) div 2;
a:=apa[mid];
repeat
while apa[i]< a do inc(i);
while apa[j]> a do dec(j);
if j>i then xch(i,j);
until j<=i;
if i<k then l:=i;
if i >k then h:=i;
until i=k;
select:=a;
end;

[Nemerle]

ce code ne me semble pas correct...

[pseudocode]

Sans plus d'info sur la distribution des valeurs, la structure de données et le stockage, je dirais nth_element

[thinkbig]

Sur une distribution aléatoire, je doute que l’on puisse dire que tel ou tel algorithme est le plus rapide, cela dépondra des cas. NON ?

[Invité]

ci-joint 3 algos (passage d'un tableau de valeurs non ordonnées) et une fonction de test/comparaison en VBA :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
 
'API pour calcul temps
Private Declare Function GetTickCount Lib "kernel32" () As Long
 
Public Function RunKthTests()
   On Error GoTo catch
   Const cLenArr As Long = 10 ^ 6     'Nombre d'éléments
   Const cKth As Long = 10 ^ 3        'position de l'élément à récupérer : doit être >= 1 et <= cLenArr
   Const cMaxVal As Double = 10 ^ 5   'Valeur maxi des éléments
 
   Dim arr() As Double, arrsave() As Double, Res As Double
   Dim i As Long, t0 As Long, t1 As Long
 
   Randomize
   ReDim arr(1 To cLenArr)
   ReDim arrsave(1 To cLenArr)
   For i = 1 To cLenArr
      arr(i) = Rnd * cMaxVal
      arrsave(i) = arr(i)
   Next i
 
   Debug.Print "go!"
 
   t0 = GetTickCount
   Res = QuickSelect(arr, cLenArr, cKth)
   t1 = GetTickCount
   Debug.Print "QuickSelect   ", (t1 - t0) & " ms", Res
   'tableau non modifié par QuickSelect
 
   t0 = GetTickCount
   Res = SelectSmallest(cKth, cLenArr, arr)
   t1 = GetTickCount
   Debug.Print "SelectSmallest", (t1 - t0) & " ms", Res
 
   arr = arrsave 'restaure le tableau d'origine
   t0 = GetTickCount
   Res = findElementAtRank(arr, 1, cLenArr, cKth)
   t1 = GetTickCount
   Debug.Print "findElemAtRank", (t1 - t0) & " ms", Res
 
   Exit Function
catch:
   Debug.Print Err.Number, Err.Description
End Function
 
'Numerical Recipes In C - second edition - page 342
'Algo non récursif, tableau modifié
Private Function SelectSmallest(ByVal k As Long, ByVal n As Long, ByRef arr() As Double) As Double
   Dim i As Long, ir As Long, j As Long, l As Long, mid As Long, l1 As Long
   Dim a As Double, temp As Double
   l = 1: l1 = 2: ir = n
   While True
      If ir <= l1 Then
         If ir = l1 And arr(ir) < arr(l) Then temp = arr(l): arr(l) = arr(ir): arr(ir) = temp
         SelectSmallest = arr(k): Exit Function
      Else
         mid = (l + ir) \ 2
         temp = arr(l1): arr(l1) = arr(mid): arr(mid) = temp
         If arr(l1) > arr(ir) Then temp = arr(l1): arr(l1) = arr(ir): arr(ir) = temp
         If arr(l) > arr(ir) Then temp = arr(l): arr(l) = arr(ir): arr(ir) = temp
         If arr(l1) > arr(l) Then temp = arr(l1): arr(l1) = arr(l): arr(l) = temp
         i = l1: j = ir: a = arr(l)
         Do While True
            Do: i = i + 1: Loop While arr(i) < a
            Do: j = j - 1: Loop While arr(j) > a
            If j < i Then Exit Do
            temp = arr(i): arr(i) = arr(j): arr(j) = temp
         Loop
         arr(l) = arr(j)
         arr(j) = a
         If j >= k Then ir = j - 1
         If j <= k Then l = i: l1 = i + 1
      End If
   Wend
End Function
 
'http://www.rawkam.com/?p=870
'Algo récursif, tableau modifié
Public Function findElementAtRank(ByRef arr() As Double, ByVal low As Long, ByVal high As Long, ByVal rank As Long) As Double
   Dim pivot As Long, l As Long, h As Long, temp As Double, valPivot As Double
   pivot = low: l = low: h = high
   If l <= h Then
      valPivot = arr(pivot)
      While l < h
         While arr(l) <= valPivot: l = l + 1: Wend
         While arr(h) > valPivot: h = h - 1: Wend
         If l < h Then temp = arr(l): arr(l) = arr(h): arr(h) = temp
      Wend
      arr(pivot) = arr(h): arr(h) = valPivot
   End If
   If rank < h Then
      findElementAtRank = findElementAtRank(arr, low, h - 1, rank)
   ElseIf rank > h Then
      findElementAtRank = findElementAtRank(arr, h + 1, high, rank)
   Else: findElementAtRank = arr(h): End If
End Function
 
'http://pine.cs.yale.edu/pinewiki/QuickSelect
'Algo récursif, consomme mémoire, tableau non modifié
Public Function QuickSelect(ByRef arr() As Double, ByVal n As Long, ByVal k As Long) As Double
   Dim se As Long, le As Long, i As Long
   Dim pivot As Double, ase() As Double, ale() As Double
   pivot = arr(Int(Rnd * n) + 1)   'Autre pivot ? pivot = arr((n + 1) \ 2)
   ReDim ase(1 To n)
   ReDim ale(1 To n)
   For i = 1 To n
      If arr(i) < pivot Then
         se = se + 1
         ase(se) = arr(i)
      ElseIf arr(i) > pivot Then
         le = le + 1
         ale(le) = arr(i)
      End If
   Next i
   If k <= se Then
      Erase ale   'free mem
      QuickSelect = QuickSelect(ase, se, k)
   ElseIf k > n - le Then
      Erase ase   'free mem
      QuickSelect = QuickSelect(ale, le, k - n + le)
   Else: QuickSelect = pivot: End If
End Function

Pour démarrer le code :
* ouvrir un nouveau document Excel
* Alt+F11 pour ouvrir l'éditeur de code VBA
* Menu Insertion -> Module
* copier coller le code
* Ctrl+G pour afficher la fenêtre d'execution qui contiendra les résultats
* Placer le curseur dans le code de la fonction <RunKthTests()>
* F5 pour démarrer la fonction des tests

Robert

[Nebulix]

ce code ne me semble pas correct...

Pourtant il marche ...

[Nemerle]

Pourtant il marche ...

sur un jeu test, l'algo implémenté reste bloqué avec les mêmes i,j au bout de 100 passes....

[Andnotor]

J'essayerais en testant indépendamment chaque élément du double (le signe, l'exposant et la mantisse). Chaque élément étant traité comme un entier

[Nemerle]

ci-joint 3 algos
...
Robert

Robert, respect! Code nickel, et le SelectSmallest est vraiment impressionnant! J'avais construit en direct un algo, mais comme d'hab' celui des numerical recipes me bat à plat de couture, presque 10 fois plus rapide!

[Invité]

bonjour,

J'avais construit en direct un algo, mais comme d'hab' celui des numerical recipes me bat à plat de couture

Tu as plus de mérite que moi d'avoir essayé d'écrire un algo, je n'ai fait qu'ouvrir mon petit livre rouge...

a priori c'est l'algo de NR est le plus rapide d'après ce benchmark

Cordialement,

Robert