' ******************************************
' * TRI d'un FICHIER RANDOM (ACCES DIRECT) *
' ******************************************
' - - ->  C:\CLAUDIE\TRIFICH\TRI!F!R.BAS
' Ecrit par SFLPMEA le 10/09/2006
    OPTION BASE 1: DEFSTR A-Z: CLOSE
    SCREEN 12: WINDOW SCREEN (1, 1)-(640, 480): CLS
    DIM N.Alpha AS STRING * 12
    ON ERROR GOTO XXX.ERREUR
    Etape% = 1: MKDIR "C:\ACLAUDIE": MKDIR "C:\ACLAUDIE\TRIFICH"
    Etape% = 2: KILL "C:\ACLAUDIE\TRIFICH\FICHIER.RND"
    Etape% = 0
    Maxi& = 2147483647: Enr = "º>" + SPACE$(12) + "<º"
    GOSUB GS01.OPEN
    RANDOMIZE TIMER * 100
' *** Cr‚ation d'un Fichier de base
    LOCATE 2, 2: COLOR 11
    PRINT "Cr‚ation de 2.000 Enregistrements al‚atoires en :";
    Debut! = TIMER
    FOR N1& = 1 TO 1999
        Nombre& = RND * Maxi&: GOSUB GS01.ECRITURE
    NEXT N1&
    Nombre& = Maxi&: N1& = 2000
    GOSUB GS01.ECRITURE
    LOCATE 2, 53: PRINT USING "####.### secondes"; TIMER - Debut!
    LOCATE 3, 10: COLOR 14: PRINT "(Fichier de 16 x 2000 = 32.000 octets)";
    Debut! = TIMER
    LOCATE 5, 2: COLOR 11: PRINT "TRI du Fichier en : ";
    GOSUB GS25.TRI
    LOCATE 5, 23: PRINT USING "#####.### secondes"; TIMER - Debut!
    LOCATE 6, 10: COLOR 15: PRINT USING "(######### Echanges)"; Echange&
' ***
    LOCATE 8, 2: COLOR 11: PRINT "Ajout d'un SEUL Enregistrement de valeur 1"
    Debut! = TIMER
    Nombre& = 1&: N1& = 2001: GOSUB GS01.ECRITURE
    LOCATE 9, 2: COLOR 11: PRINT "TRI du Fichier en : ";
    GOSUB GS25.TRI
    LOCATE 9, 23: PRINT USING "#####.### secondes"; TIMER - Debut!
    LOCATE 10, 10: COLOR 15: PRINT USING "(######### Echanges)"; Echange&
' ***
    LOCATE 12, 2: COLOR 11
    PRINT "Ajout de 20 Enregistrements de valeur al‚atoire";
    RANDOMIZE TIMER * 100
    FOR N1& = 2002 TO 2021
        Nombre& = RND * Maxi&: GOSUB GS01.ECRITURE
    NEXT N1&
    Debut! = TIMER
    LOCATE 13, 2: COLOR 11: PRINT "TRI du Nouveau Fichier en : ";
    GOSUB GS25.TRI
    LOCATE 13, 30: PRINT USING "#####.### secondes"; TIMER - Debut!
    LOCATE 14, 10: COLOR 15: PRINT USING "(######### Echanges)"; Echange&;

' *** Bouclette d'ajouts d'UN enregistrement al‚atoire
' *** et nouveau tri aprŠs chacun d'eux
    RANDOMIZE TIMER * 100
    ' *** ATTENTION, le SEEK(1) donne des RESULTATS 'IDIOTS'
    ' *** Il donne la position du pointeur. Or, aprŠs un tri, o— est-il ?
    AJOUT = "UN": Debut2! = TIMER: En.Plus% = 10000 ' **** Modifiable
    FOR ZOE% = 1 TO En.Plus%
        Debut! = TIMER: N1& = LOF(1) / 16 + 1
        Nombre& = RND * Maxi&: LOCATE 17, 10: COLOR 11
        PRINT USING "Enregistrement cr‚‚ : #####/#####/#####"; ZOE%; En.Plus%; N1&
        GOSUB GS01.ECRITURE
        Debut! = TIMER
        LOCATE 18, 10: COLOR 11: PRINT "TRI du Nouveau Fichier en : ";
        GOSUB GS25.TRI
        Duree! = TIMER - Debut!
        LOCATE 18, 40: COLOR 15: PRINT USING "#####.### secondes "; Duree!;
        IF Duree! > 1! THEN BEEP
        LOCATE 19, 10: PRINT USING "(######### Echanges)"; Echange&;
    NEXT ZOE%
    Duree2! = TIMER - Debut2!: Moyenne! = Duree2! / En.Plus%
    LOCATE 21, 10: COLOR 12
    PRINT USING "##### Ajouts tri‚s avec dur‚e moyenne #.###"; En.Plus%; Moyenne!
' *** Controle du tri
    LOCATE 23, 10: COLOR 10: PRINT " CONTROLE du TRI du FICHIER : "
    CLOSE : GOSUB GS01.OPEN: Nb.Enr& = LOF(1) / 16
    N1& = 1: GOSUB GS01.LECTURE: N.Precedent& = Nombre&
    FOR N1& = 1 TO Nb.Enr&
        LOCATE 23, 41: PRINT USING "######"; N1&
        GOSUB GS01.LECTURE: IF Nombre& < N.Precedent& THEN BEEP: BEEP
        N.Precedent& = Nombre&
    NEXT N1&
    COLOR 15: END

GS01.OPEN: OPEN "C:\ACLAUDIE\TRIFICH\FICHIER.RND" FOR RANDOM AS #1 LEN = 16
    FIELD #1, 16 AS Enregistrement: RETURN
GS01.LECTURE: GET #1, N1&
    Nombre& = VAL(MID$(Enregistrement, 4, 11)): RETURN
GS01.ECRITURE: RSET N.Alpha = STR$(Nombre&): MID$(Enr, 3) = N.Alpha
    LSET Enregistrement = Enr: PUT #1, N1&: RETURN

GS25.TRI: ' ***** TRI FICHIER
    Indic% = 0: Num.E& = 0: Echange& = 0
    Nbre.Enregistrements& = LOF(1) / 16
    IF AJOUT = "UN" THEN Num.E& = LOF(1) / 16 - 1
GS25A: IF Indic% = 1 THEN Num.E& = Num.E1&: Indic% = 0
    Num.E& = Num.E& + 1
    IF Num.E& > Nbre.Enregistrements& GOTO GS25C
    IF Num.E& = 1 GOTO GS25A
GS25B: Num.Pr& = Num.E& - 1
    IF Num.Pr& = 0 THEN GOTO GS25C
    N1& = Num.E&: GOSUB GS01.LECTURE: N.Act& = Nombre&
    N1& = Num.Pr&: GOSUB GS01.LECTURE: Nombre.Pr& = Nombre&
    IF Nombre& <= N.Act& GOTO GS25A
    ' *** Permutation n‚cessaire
    N1& = Num.E&: Nombre& = Nombre.Pr&: GOSUB GS01.ECRITURE
    N1& = Num.Pr&: Nombre& = N.Act&: GOSUB GS01.ECRITURE
    Echange& = Echange& + 1
    IF Num.Pr& = 1 THEN
        GOTO GS25A
    ELSE
        IF Indic% = 0 THEN Num.E1& = Num.E&: Indic% = 1
    END IF
    Num.E& = Num.E& - 1: GOTO GS25B
GS25C: RETURN

XXX.ERREUR:
    SELECT CASE Etape%
        CASE 1: IF ERR = 75 THEN RESUME NEXT
        CASE 2: IF ERR = 53 THEN RESUME NEXT
        CASE ELSE: Message = "ERREUR PROGRAMME " + STR$(ERR)
            Message = Message + " ?? VOIR PROGRAMMEUR (Pressez une Touche)"
            LOCATE 30, 10: COLOR 12: PRINT Message
            SLEEP: COLOR 15: END
    END SELECT