September 2017 Update

This commit is contained in:
Ingy döt Net 2017-09-23 10:01:46 +02:00
parent bba7bfd280
commit ba8067c3b7
14570 changed files with 153136 additions and 63871 deletions

View file

@ -1,11 +1,21 @@
import Data.List
import Control.Arrow
import Control.Monad
import Data.List (permutations, inits)
derangements = filter (and . zipWith (/=) [1..] ). permutations
topswop = ((uncurry (++). first reverse).). splitAt
topswopIter = takeWhile((/=1).head). iterate (topswop =<< head)
swops = map (length. topswopIter). derangements
import Control.Arrow (first)
derangements :: [Int] -> [[Int]]
derangements = (filter . (and .) . zipWith (/=)) <*> permutations
topswop :: Int -> [a] -> [a]
topswop = ((uncurry (++) . first reverse) .) . splitAt
topswopIter :: [Int] -> [[Int]]
topswopIter = takeWhile ((/= 1) . head) . iterate (topswop =<< head)
swops :: [Int] -> [Int]
swops = fmap (length . topswopIter) . derangements
topSwops :: [Int] -> [(Int, Int)]
topSwops = zip [1..]. map (maximum. (0:). swops). tail. inits
topSwops = zip [1 ..] . fmap (maximum . (0 :) . swops) . tail . inits
main :: IO ()
main = mapM_ print $ take 10 $ topSwops [1 ..]

View file

@ -0,0 +1,35 @@
// version 1.1.2
val best = IntArray(32)
fun trySwaps(deck: IntArray, f: Int, d: Int, n: Int) {
if (d > best[n]) best[n] = d
for (i in n - 1 downTo 0) {
if (deck[i] == -1 || deck[i] == i) break
if (d + best[i] <= best[n]) return
}
val deck2 = deck.copyOf()
for (i in 1 until n) {
val k = 1 shl i
if (deck2[i] == -1) {
if ((f and k) != 0) continue
}
else if (deck2[i] != i) continue
deck2[0] = i
for (j in i - 1 downTo 0) deck2[i - j] = deck[j]
trySwaps(deck2, f or k, d + 1, n)
}
}
fun topswops(n: Int): Int {
require(n > 0 && n < best.size)
best[n] = 0
val deck0 = IntArray(n + 1)
for (i in 1 until n) deck0[i] = -1
trySwaps(deck0, 1, 0, n)
return best[n]
}
fun main(args: Array<String>) {
for (i in 1..10) println("${"%2d".format(i)} : ${topswops(i)}")
}

View file

@ -1,41 +1,38 @@
/*REXX pgm gens N decks of numbered cards and finds the maximum "swops".*/
parse arg things .; if things=='' then things=10; thingsX= things>9
/*REXX program generates N decks of numbered cards and finds the maximum "swops". */
parse arg things .; if things=='' then things=10
do n=1 for things; #=deckSets(n,n) /*create "decks".*/
mx= n\==1 /*handle case of a one-card deck.*/
do i=1 for #
mx=max(mx,swops(!.i))
end /*i*/
say ' maximum swops for a deck of' right(n,2) ' cards is' right(mx,4)
do n=1 for things; #=decks(n, n) /*create a (things) number of "decks". */
mx= n\==1 /*handle the case of a one-card deck.*/
do i=1 for #; p=swops(!.i) /*compute the SWOPS for this iteration.*/
if p>mx then mx=p /*This a new maximum? Use a new max. */
end /*i*/
say ' maximum swops for a deck of' right(n,2) ' cards is' right(mx,4)
end /*n*/
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────DECKSETS subroutine─────────────────*/
deckSets: procedure expose !. /*X things taken Y at a time.*/
parse arg x,y,,$ @.; #=0; call .deckset 1 /*set $ & @. to null.*/
return # /*return # permutations (decks).*/
.deckset: procedure expose @. x y $ # !.; parse arg ?
if ?>y then do; _=@.1; do j=2 to y; _=_ @.j; end /*j*/; #=#+1; !.#=_
end
else do
?m=?-1 /*used in the FOR for faster DO.*/
if ?==1 then qs=2 /*¬ use 1-swops that start with 1*/
else do
qs=1
if @.1==? then qs=2 /*skip 1-swops: 3 x 1 x */
end
do q=qs to x /*build permutation recursively. */
do k=1 for ?m; if @.k==q then iterate q; end /*k*/
@.?=q; call .deckset(?+1)
end /*q*/
end
return
/*──────────────────────────────────SWOPS subroutine────────────────────*/
swops: parse arg z; do _=1; t=word(z,1)
if word(z,t)==1 then return _
if thingsX then do h=10 to things
z=changestr(h,z,d2x(h))
end /*h*/
z=reverse(subword(z,1,t)) subword(z,t+1)
if thingsX then do d=10 to things
z=changestr(d2x(d),z,d)
end /*_*/
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
decks: procedure expose !.; parse arg x,y,,$ @. /* X things taken Y at a time. */
#=0; call .decks 1 /* [↑] initialize $ & @. to null.*/
return # /*return number of permutations (decks)*/
.decks: procedure expose !. @. x y $ #; parse arg ?
if ?>y then do; _=@.1; do j=2 for y-1; _=_ @.j; end /*j*/; #=#+1; !.#=_
end
else do; qm=?-1
if ?==1 then qs=2 /*don't use 1-swops that start with 1 */
else if @.1==? then qs=2 /*skip the 1-swops: 3 x 1 x ···*/
else qs=1
do q=qs to x /*build the permutations recursively. */
do k=1 for qm; if @.k==q then iterate q
end /*k*/
@.?=q; call .decks ? + 1
end /*q*/
end
return
/*──────────────────────────────────────────────────────────────────────────────────────*/
swops: parse arg z; do u=1; parse var z t .; if length(t)==2 then t=x2d(t)
if word(z, t)==1 then return u /*found unity at T. */
do h=10 to things; if pos(h, z)==0 then iterate
z=changestr(h, z, d2x(h) ) /* [↑] any H's in Z ? */
/* [↑] hexify decimal H */
end /*h*/
z=reverse(subword(z, 1, t)) subword(z, t+1)
end /*u*/

View file

@ -0,0 +1,10 @@
fcn topswops(n){
flip:=fcn(xa){
if (not xa[0]) return(0);
xa.reverse(0,xa[0]+1); // inplace, ~4x faster than making new lists
return(1 + self.fcn(xa));
};
(0).pump(n,List):Utils.Helpers.permute(_).pump(List,"copy",flip).reduce("max");
}
foreach n in ([1 .. 10]){ println(n, ": ", topswops(n)) }