English: A. Initailization ------------------------- kSeed2 = kSeed FOR J = 40 TO 1 STEP -1 ' Fill shuffle array k = kSeed \ kq1 kSeed = ka1 * (kSeed - k * kq1) - k * ir1 IF kSeed < 0 THEN kSeed = kSeed + km1 IF J <= 32 THEN kShuffle(J) = kSeed NEXT J k1 = kShuffle(1) '-Pseudo-Random Sample Generator: B. Continuation and Scaling --------------- FOR I = 1 TO MaxSamp ' Generate sample '-- L'Ecuyer Portable PRNG Algorithm with Bays-Durham shuffle -- k = kSeed \ kq1 kSeed = ka1 * (kSeed - k * kq1) - k * ir1 IF kSeed < 0 THEN kSeed = kSeed + km1  k = kSeed2 \ kq2 kSeed2 = ka2 * (kSeed2 - k * kq2) - k * ir2 IF kSeed2 < 0 THEN kSeed2 = kSeed2 + km2  i1 = INT(32# * k1 / km1) + 1 k1 = kShuffle(i1) - kSeed2 kShuffle(i1) = kSeed IF (k1 < 1) THEN k1 = k1 + kmm1 '--------------------------------------------------------------- u = k1 / km1 'scale over range 0 to 1 exclusive iLotx = INT(u * iLotSize) + 1 'scale over range 1 to lot size IF iLot(iLotx) = iFalse THEN ' if new, unique value, include in sample array iLot(iLotx) = iTrue: iSamp(I) = iLotx ELSE ' if repeated value, discard and try again I = I - 1 END IF NEXT I '-Sort each Sample Segment -------------------------------------------------- ' Multi-Segment Shell Sort IF ST$ <> "Q" THEN 'exclude sequential sampling FOR J = 1 TO iMult iBase = (J - 1) * iSampSize iMid = iSampSize \ 2 DO WHILE iMid > 0 iBound = iBase + iSampSize - iMid DO iFlag = iBase FOR I = iBase + 1 TO iBound IF iSamp(I) > iSamp(I + iMid) THEN SWAP iSamp(I), iSamp(I + iMid) iFlag = I END IF NEXT I iBound = iFlag - iMid LOOP WHILE iFlag <> iBase iMid = iMid \ 2 LOOP NEXT J END IF Category:
French: B. Suite et graduation ---------- FOR I = 1 TO MaxSamp ' Générez de l'échantillon '-- Algorithme GNPA portative de L'Ecuyer avec brouiller de Bays-Durham -- k = kSeed \ kq1 kSeed = ka1 * (kSeed - k * kq1) - k * ir1 IF kSeed < 0 THEN kSeed = kSeed + km1  k = kSeed2 \ kq2 kSeed2 = ka2 * (kSeed2 - k * kq2) - k * ir2 IF kSeed2 < 0 THEN kSeed2 = kSeed2 + km2  i1 = INT(32# * k1 / km1) + 1 k1 = kShuffle(i1) - kSeed2 kShuffle(i1) = kSeed IF (k1 < 1) THEN k1 = k1 + kmm1 '--------------------------------------------------------------- u = k1 / km1 'traduisez sur l'échelle de 0 à 1 exclu iLotx = INT(u * iLotSize) + 1 'traduisez sur l'échelle de 1 à la taille 'du lot IF iLot(iLotx) = iFalse THEN ' si la valeur est nouvelle et unique, incluez dans la série ' d'échantillon iLot(iLotx) = iTrue: iSamp(I) = iLotx ELSE ' si la valeur est répétée, jetez-la et essayez encore I = I - 1 END IF NEXT I '-Trier chaque segment d’échantillon ---------------------------------------- ' Algorithme de tri de Shell (multi-segment) IF ST$ <> "P" THEN 'excluez l'échantillonnage progressif FOR J = 1 TO iMult iBase = (J - 1) * iSampSize iMid = iSampSize \ 2 DO WHILE iMid > 0 iBound = iBase + iSampSize - iMid DO iFlag = iBase FOR I = iBase + 1 TO iBound IF iSamp(I) > iSamp(I + iMid) THEN SWAP iSamp(I), iSamp(I + iMid) iFlag = I END IF NEXT I iBound = iFlag - iMid LOOP WHILE iFlag <> iBase iMid = iMid \ 2 LOOP NEXT J END IF '-Écrire des résultats au fichier ------------------------------------------- OPEN oFile$ FOR APPEND AS #1 PRINT #1, RSP$ PRINT #1, "Date/heure: "; DT$ PRINT #1, "Val. de départ 1:"; kS2k PRINT #1, "Val. de départ 2:"; kSeed1 PRINT #1, "Numéro du lot: "; LotNo$ PRINT #1, "ID d’opérateur: "; OpID$ PRINT #1, "Type d’échant.: "; STL$ PRINT #1, "Taille du lot: "; iLotSize sMult$ = STR$(iMult) IF ST$ = "P" THEN PRINT #1, "Taille max. d’échantillon:"; MaxSamp ELSE PRINT #1, "Taille d’échantillon: "; iSampSize; PRINT #1, "x" + sMult$ END IF PRINT #1, "" FOR J = 1 TO iMult S$ = STR$(J) PRINT #1, "Échantillon" + S$ + " de" + sMult$ iBase = (J - 1) * iSampSize FOR I = iBase + 1 TO iBase + iSampSize PRINT #1, LTRIM$(STR$(iSamp(I))) NEXT I PRINT #1, "" NEXT J CLOSE #1 PRINT :