aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Family Day update

Browse source
This commit is contained in:
Ingy döt Net 2020-02-17 23:21:07 -08:00
parent aac6731f2c
commit 9ad63ea473
2442 changed files with 39761 additions and 8255 deletions
Download patch file Download diff file Expand all files Collapse all files

18
Task/Sorting-algorithms-Cocktail-sort/Factor/sorting-algorithms-cocktail-sort-1.factor Normal file
View file

@ -0,0 +1,18 @@
USING: kernel locals math math.ranges sequences ;
:: cocktail-sort! ( seq -- seq' )
f :> swapped! ! bind false to mutable lexical variable 'swapped'. This must be done outside both while quotations so it is in scope of both.
[ swapped ] [ ! is swapped true? Then execute body quotation. 'do' executes body quotation before predicate on first pass.
f swapped! ! set swapped to false
seq length 2 - [| i | ! for each i in 0 to seq length - 2 do
i i 1 + [ seq nth ] bi@ > ! is element at index i greater than element at index i + 1?
[ i i 1 + seq exchange t swapped! ] when ! if so, swap them and set swapped to true
] each-integer
swapped [ ! skip to end of loop if swapped is false
seq length 2 - 0 [a,b] [| i | ! for each i in seq length - 2 to 0 do
i i 1 + [ seq nth ] bi@ > ! is element at index i greater than element at index i + 1?
[ i i 1 + seq exchange t swapped! ] when ! if so, swap them and set swapped to true
] each
] when
] do while
seq ; ! return the sequence

21
Task/Sorting-algorithms-Cocktail-sort/Factor/sorting-algorithms-cocktail-sort-2.factor Normal file
View file

@ -0,0 +1,21 @@
USING: fry kernel math math.ranges namespaces sequences ;
SYMBOL: swapped?
: dupd+ ( m obj -- m n obj ) [ dup 1 + ] dip ;
: 2nth ( n seq -- elt1 elt2 ) dupd+ [ nth ] curry bi@ ;
: ?exchange ( n seq -- )
2dup 2nth > [ dupd+ exchange swapped? on ] [ 2drop ] if ;
: cocktail-pass ( seq forward? -- )
'[ length 2 - 0 _ [ swap ] when [a,b] ] [ ] bi
[ ?exchange ] curry each ;
: (cocktail-sort!) ( seq -- seq' )
swapped? off dup t cocktail-pass
swapped? get [ dup f cocktail-pass ] when ;
: cocktail-sort! ( seq -- seq' )
[ swapped? get ] [ (cocktail-sort!) ] do while ;