如何在Tcl中实现高效的{1,2,…,n}集合排列算法？

你的原代码性能瓶颈很明确：每次用lsearch做线性查找判断元素是否已存在，随着列表长度增加，查找耗时呈线性增长，整体时间复杂度达O(n²)，n越大效率越低，比如n=1e5时完全没法用。

最适合这个场景的高效方案是Fisher-Yates洗牌算法，时间复杂度O(n)，空间复杂度O(n)，无需重复检查元素，一次遍历就能完成随机排列，大n下性能碾压原方法。

实现代码 #

proc permu {n} {
    # 生成初始有序列表 {1,2,...,n}
    set list [lrepeat $n 0]
    for {set i 0} {$i < $n} {incr i} {
        lset list $i [expr {$i + 1}]
    }
    # Fisher-Yates 洗牌核心逻辑
    for {set i [expr {$n - 1}]} {$i > 0} {incr i -1} {
        # 生成0到i之间的随机索引
        set j [expr {int(rand() * ($i + 1))}]
        # 交换i和j位置的元素
        set temp [lindex $list $i]
        lset list $i [lindex $list $j]
        lset list $j $temp
    }
    return $list
}

为什么这个方法高效？ #

• 初始列表仅需一次循环生成，无冗余操作
• 洗牌过程中每个元素仅被处理一次，不用反复生成随机数并检查是否已存在
• 交换操作是O(1)的列表操作，Tcl的lset和lindex对列表访问效率很高

实际测试中，n=1e5时几乎瞬间就能出结果，完全不会有原方法数分钟的等待。

额外优化：用数组替代列表（可选） #

如果n特别大（比如1e6以上），用数组处理会比列表更高效，因为Tcl数组的元素访问是O(1)的，能避免列表的内部结构开销：

proc permu_array {n} {
    # 初始化数组
    array set arr {}
    for {set i 1} {$i <= $n} {incr i} {
        set arr($i) $i
    }
    # Fisher-Yates 洗牌
    for {set i $n} {$i > 1} {incr i -1} {
        set j [expr {1 + int(rand() * $i)}]
        # 交换数组元素
        set temp $arr($i)
        set arr($i) $arr($j)
        set arr($j) $temp
    }
    # 把数组转为列表返回
    return [array get arr]
}

不过对于大多数场景，列表版本的Fisher-Yates已经足够高效。

内容的提问来源于stack exchange，提问作者Theoretical Physics