tasks a-s

Task/Permutations-Derangements/Tcl/permutations-derangements-1.tcl

@@ -0,0 +1,37 @@
+package require Tcl 8.5;		# for arbitrary-precision integers
+package require struct::list;		# for permutation enumerator
+
+proc derangements lst {
+    # Special case
+    if {![llength $lst]} {return {{}}}
+    set result {}
+    for {set perm [struct::list firstperm $lst]} {[llength $perm]} \
+	    {set perm [struct::list nextperm $perm]} {
+	set skip 0
+	foreach a $lst b $perm {
+	    if {[set skip [string equal $a $b]]} break
+	}
+	if {!$skip} {lappend result $perm}
+    }
+    return $result
+}
+
+proc deranged1to n {
+    for {set i 1;set r {}} {$i <= $n} {incr i} {lappend r $i}
+    return [derangements $r]
+}
+
+proc countDeranged1to n {
+    llength [deranged1to $n]
+}
+
+proc subfact n {
+    if {$n == 0} {return 1}
+    if {$n == 1} {return 0}
+    set o 1
+    set s 0
+    for {set i 1} {$i < $n} {incr i} {
+	set s [expr {$i * ($o + [set o $s])}]
+    }
+    return $s
+}

Task/Permutations-Derangements/Tcl/permutations-derangements-2.tcl

@@ -0,0 +1,11 @@
+foreach d [deranged1to 4] {
+    puts "derangement of 1..4: $d"
+}
+
+puts "\n\tcounted\tcalculated"
+for {set i 0} {$i <= 9} {incr i} {
+    puts "!$i\t[countDeranged1to $i]\t[subfact $i]"
+}
+
+# Stretch goal
+puts "\n!20 = [subfact 20]"