Skip to content

Instantly share code, notes, and snippets.

@Veedrac
Last active December 26, 2015 17:38
Show Gist options
  • Save Veedrac/7188035 to your computer and use it in GitHub Desktop.
Save Veedrac/7188035 to your computer and use it in GitHub Desktop.
(* The permutation method I talked about from last time *)
fun allWithOneRemovedStateful [] ys = []
| allWithOneRemovedStateful (x::xs) ys =
(x, xs @ ys) :: allWithOneRemovedStateful xs (x::ys);
(* Dude, I do this painfully often. Is there any way
of avoiding this, given my dislike for pseudo-random
extra state arguments? *)
fun allWithOneRemoved xs = allWithOneRemovedStateful xs [];
fun prepend x y = x::y
fun permutations [] = [[]]
| permutations xs = List.concat (
(* Get the permutations for all Vector.sublists and put the value
removed back on the head of each permutaton. *)
map (fn (elem, rest) => map (prepend elem) (permutations rest))
(allWithOneRemoved xs)
);
(* Potentially with a proper double-ended queue and clever referencing, the
append could be made O(1), in which case this would be less inefficient.
After all, though, I didn't manage to improve upon the original.
I'm still working on the iterator version with vectors and mutation.
Here's a *start*, for part of one iteration of Shimon Even's algorithm.
It's very much a subsystem, not a permuter.
An outer iterator should run step, keeping track of whether the head
element is actively moving and if it's not doing the search for the
new tempoary head. This will keep it amortized O(1). *)
datatype Direction = left | still | right;
fun step index direction vector =
let val offset = if direction = left then ~1 else 1
val target = index + offset
val index_v = ! (Vector.sub (vector, index))
val target_v = ! (Vector.sub (vector, target))
in Vector.sub (vector, index) := target_v;
Vector.sub (vector, target) := index_v;
if (#2 index_v < #2 (! (Vector.sub (vector, target + offset))))
orelse (#2 index_v = 0)
orelse (#2 index_v = Vector.length vector)
then (Vector.sub (vector, target) := (still, #2 target_v); false)
else true
end;
(* The actual work. *)
(* 5.1 *)
(* This is obviously quadratic time as each extractSmallestR call
takes O(n) from traversing the list, and is called O(n) times. *)
(* 5.2 *)
fun extractSmallestR accum active [] = (active, accum)
| extractSmallestR accum active (x::xs) =
(* Two comarisons is probably no slower than one when compared to the list allocation. *)
extractSmallestR ((Int.max (active, x))::accum) (Int.min (active, x)) xs;
fun extractSmallest [] = raise Match
| extractSmallest (x::xs) = extractSmallestR [] x xs;
fun selectionSort [] = []
| selectionSort lst =
let val (smallest, rest) = extractSmallest lst
in smallest :: (selectionSort rest)
end;
(* Alternatively, Inspired by (but not copied from) the internets *)
fun extractSmallest [] = raise Match
| extractSmallest (x::xs) = foldl
(fn (x, (active, rest)) =>
(Int.min(active, x), Int.max(active, x)::rest)
) (x, []) xs;
fun selectionSort [] = []
| selectionSort lst =
let val (smallest, rest) = extractSmallest lst
in smallest :: (selectionSort rest)
end;
(* 5.3 *)
(* This is obviously quadratic time as each bubbleOnce call takes O(n) from
traversing the list, and is called at worst O(n) times.
This is known because each call can only move an item one place, and an
item can be displaced by up to n-1 places. *)
(* 5.4 *)
fun bubbleOnceR hasbubbled (x::y::rest) =
let val (hasbubbled, bubbledRest) = bubbleOnceR hasbubbled ((Int.max (x, y))::rest)
in (x > y orelse hasbubbled, (Int.min (x, y))::bubbledRest)
end
| bubbleOnceR hasbubbled lst = (hasbubbled, lst);
val bubbleOnce = bubbleOnceR false;
fun bubbleSort lst =
let val (hasbubbled, lst') = bubbleOnce lst
in (if hasbubbled then bubbleSort lst' else lst')
end;
(* And again, implementing the dynamic length cropping. *)
fun bubbleOnceToNR hasbubbled 0 lst = (hasbubbled, lst)
| bubbleOnceToNR hasbubbled n (x::y::rest) =
let val (hasbubbled, bubbledRest) = bubbleOnceToNR hasbubbled (n-1) ((Int.max (x, y))::rest)
in (x > y orelse hasbubbled, (Int.min (x, y))::bubbledRest)
end
| bubbleOnceToNR hasbubbled n lst = (hasbubbled, lst);
val bubbleOnceToN = bubbleOnceToNR false;
fun bubbleSortR 0 lst = lst
| bubbleSortR n lst =
let val (hasbubbled, lst') = bubbleOnceToN n lst
in (if hasbubbled then bubbleSortR (n-1) lst' else lst')
end;
fun bubbleSort' lst = bubbleSortR (length lst) lst;
(* 6.1 *)
datatype Weekday = Monday | Tuesday | Wednesday | Thursday | Friday | Saturday | Sunday;
(* Personally this is of marginal use; a calendar app would much rather work on integer
forms under modulo and then use a mapping from said integers to strings, which can
be used for display.
Constants might be of use; in a language with classes you might rightly be tempted
to make a Weekday a subclass of the integers, or an integer ABC. This would help
especially during debugging.
An advantage of the Weekday datatype is that you are restricted to the 7 choices and
there isn't the false equivalence of a day to a number. However, I imagine the
ability of a date program to store types relationally (so that Wednesday and Thursday
are adjacent) far outweighs this, especially when dealing with the already-difficult
timezone problems.
It could well be OK to use this datatype in conjunction with a record type, but it's
a bit of an annoying abstraction.
(Also handwritten.) *)
(* 6.2 *)
datatype 'a tree = Lf | Br of ('a * 'a tree * 'a tree);
fun treeSum Lf = 0
| treeSum (Br (head, left, right)) = head + treeSum left + treeSum right;
(* 6.4 *)
datatype Expression = Number of real
| Variable of string
| Negation of Expression
| Sum of Expression * Expression
| Product of Expression * Expression;
(* 6.5 *)
exception NameError string;
fun evaluate (Number n) = n
| evaluate (Variable v) = raise NameError v
| evaluate (Negation E) = ~ (evaluate E)
| evaluate (Sum (E1, E2)) = evaluate E1 + evaluate E2
| evaluate (Product (E1, E2)) = evaluate E1 * evaluate E2;
infix ++;
infix **;
val ## = Number;
val %% = Variable;
val ~~ = Negation;
val ++ = Sum;
val ** = Product;
evaluate (
Negation (
Sum (
Number 34.0,
Product (
Number 76.0,
Number 2.0
)
)
)
);
evaluate (~~ (##34.0 ++ (##76.0 ** ##2.0)));
~ (34.0 + (76.0 * 2.0));
(* 7.2 *)
datatype 'a tree = Lf | Br of ('a * 'a tree * 'a tree);
exception Subscript;
exception Collision;
fun insert (Lf, 1, w) = Br (w, Lf, Lf)
| insert (Lf, _, w) = raise Subscript
| insert (_, 1, w) = raise Collision
| insert (Br (v, t1, t2), k, w) =
if k mod 2 = 0
then Br (v, insert (t1, k div 2, w), t2)
else Br (v, t1, insert (t2, k div 2, w));
(* 7.5 *)
fun delete Lf k = raise Subscript
| delete (Br (v, Lf, Lf)) 1 = Lf
| delete (Br (v, t1, t2)) 1 = raise Subscript
| delete (Br (v, t1, t2)) k =
if k mod 2 = 0
then Br (v, delete t1 (k div 2), t2)
else Br (v, t1, delete t2 (k div 2));
(* 7.8 *)
fun hdArray Lf = raise Subscript
| hdArray (Br (v, _, _)) = v;
fun tlArray Lf = raise Subscript
| tlArray (Br (v, Lf, Lf)) = Lf
| tlArray (Br (v, t1, t2)) = Br (hdArray t1, t2, tlArray t1);
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment