巡回乱数/src

  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

 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
-
|
|
|
|
|
!
 
 
 
 
 
 
 
 

;=====================================================================
;   力ずく法による巡回乱数の実装
;                                                         for HSP 3.0a
;   2005/11/11                                           witten by kz3
;=====================================================================
 
#define RNDMAX 10
#define FALSE   0
#define TRUE    1
 
    dim record, RNDMAX
    reccnt = 0
    randomize
 
*play
    repeat
        wait 1
        n = rnd(RNDMAX)
        if record.n = TRUE: continue
        mes n
        record(n) = TRUE
        reccnt++
        if reccnt = RNDMAX{
            repeat RNDMAX
                record.cnt = FALSE
            loop
            reccnt = 0
            break
        }
    loop
 
*click_accept
    wait 1
    stick key
    if key ! 256: goto *click_accept
    cls
    goto *play

  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

 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
-
|
|
!
 
 
 
 
 
 
 
 
 
 
 

;=====================================================================
;   追い出し法による巡回乱数の実装例
;                                                         for HSP 3.0a
;   2005/11/11                                          written by kz3
;=====================================================================
 
#define RNDMAX 10
#define FALSE   0
#define TRUE    1
 
    dim record, RNDMAX
    dim rndtbl, RNDMAX
    repeat RNDMAX
        rndtbl.cnt = cnt
    loop
    prnd = RNDMAX
    repcnt = 0
    randomize
 
*play
    repeat
        wait 1
        n = rnd(prnd)
        mes rndtbl.n
        prnd--
        if prnd=0{
            prnd = RNDMAX
            break
        }
        swap = rndtbl.n
        rndtbl.n = rndtbl.prnd
        rndtbl.prnd = swap
    loop
 
*click_accept
    wait 1
    stick key
    if key ! 256: goto *click_accept
    cls
    goto *play

  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

 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
-
|
|
|
|
|
|
|
|
-
|
|
!
 
 
 
 
 
-
|
|
!
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 

// 巡回乱数 シャッフル法
// [変数の説明]
//   numRnd ... 乱数の範囲。戻り値は0〜(numRnd - 1)の範囲に収まる。
//   tblRnd ... 出力予定の数値を格納するテーブル。
//   iCount ... 出力すべき要素のインデックス。次回rsRnd実行時、tblRnd(iCount)が出力される。
 
#module RoundRandomShuffle numRnd, tblRnd, iCount
 
//  テーブルをシャッフルする内部命令
#modfunc _rsShuffle local r, local tmp
    logmes str(numRnd)
    repeat numRnd
        r = rnd(numRnd)
        tmp = tblRnd(cnt)
        tblRnd(cnt) = tblRnd(r)
        tblRnd(r) = tmp
    loop
    return
 
//  テーブルを作成。
#modinit int p1
    if p1 >= 1 {
        numRnd = p1
        iCount = 0
        dim tblRnd, numRnd
        repeat numRnd
            tblRnd(cnt) = cnt
        loop
        _rsShuffle thismod
        return 0
    } else {
        logmes "newmodのパラメータが異常です。"
        return -1
    }
 
// テーブルから乱数を取り出す関数
#modfunc _rsRnd local result
    result = tblRnd(iCount)
    iCount++
    if iCount == numRnd {
        iCount = 0
        _rsShuffle thismod
    }
    return result
#defcfunc rsRnd var p1
    _rsRnd p1
    return stat
 
// 乱数の範囲(= テーブルの要素数)を返す関数
#modfunc _rsGetNum
    return numRnd
#defcfunc rsGetNum var p1
    _rsGetNum p1
    return stat
 
#global
 
//  newmodでテーブルを作成。第2パラメータにモジュール名を、第3パラメータに乱数の範囲を指定。
    newmod v, RoundRandomShuffle, 10
    newmod v, RoundRandomShuffle, 5
    newmod v, RoundRandomShuffle, 3
    onclick goto *ClickAccept
 
*ClickAccept
    redraw 0
    color 255, 255, 255 : boxf
    color
    foreach v
        pos cnt * 100, 0
        c = cnt
        repeat rsGetNum(v(c))
            mes rsRnd(v(c))
        loop
    loop
    redraw 1
    stop