Sorting algorithms/Insertion sort: Difference between revisions
→{{header|AutoHotkey}}
(added ZX BASIC insertion sort Subroutine) |
|||
Line 856:
<pre>1 2 3 4 5 6 7 8 9</pre>
=={{header|ATS}}==
===For arrays whose elements must not be of linear type===
<lang ATS>#include "share/atspre_staload.hats"
(*------------------------------------------------------------------*)
(* Interface *)
extern fn {a : t@ype} (* The "less than" template. *)
insertion_sort$lt : (a, a) -<> bool (* Arguments by value. *)
extern fn {a : t@ype}
insertion_sort
{n : int}
(arr : &array (a, n) >> _,
n : size_t n)
:<!wrt> void
(*------------------------------------------------------------------*)
(* Implementation *)
implement {a}
insertion_sort {n} (arr, n) =
let
macdef lt = insertion_sort$lt<a>
fun
sort {i : int | 1 <= i; i <= n}
.<n - i>.
(arr : &array (a, n) >> _,
i : size_t i)
:<!wrt> void =
if i <> n then
let
fun
find_new_position
{j : nat | j <= i}
.<j>.
(arr : &array (a, n) >> _,
elem : a,
j : size_t j)
:<> [j : nat | j <= i] size_t j =
if j = i2sz 0 then
j
else if ~(elem \lt arr[pred j]) then
j
else
find_new_position (arr, elem, pred j)
val j = find_new_position (arr, arr[i], i)
in
if j < i then
array_subcirculate<a> (arr, j, i);
sort (arr, succ i)
end
prval () = lemma_array_param arr
in
if n <> i2sz 0 then
sort (arr, i2sz 1)
end
(*------------------------------------------------------------------*)
implement
insertion_sort$lt<int> (x, y) =
x < y
implement
main0 () =
let
#define SIZE 30
var i : [i : nat] int i
var arr : array (int, SIZE)
in
array_initize_elt<int> (arr, i2sz SIZE, 0);
for (i := 0; i < SIZE; i := succ i)
arr[i] := $extfcall (int, "rand") % 10;
for (i := 0; i < SIZE; i := succ i)
print! (" ", arr[i]);
println! ();
insertion_sort<int> (arr, i2sz SIZE);
for (i := 0; i < SIZE; i := succ i)
print! (" ", arr[i]);
println! ()
end</lang>
===For arrays whose elements may be of linear type===
<lang ATS>#include "share/atspre_staload.hats"
(*------------------------------------------------------------------*)
(* Interface *)
extern fn {a : vt@ype} (* The "less than" template. *)
insertion_sort$lt : (&a, &a) -<> bool (* Arguments by reference. *)
extern fn {a : vt@ype}
insertion_sort
{n : int}
(arr : &array (a, n) >> _,
n : size_t n)
:<!wrt> void
(*------------------------------------------------------------------*)
(* Implementation *)
implement {a}
insertion_sort {n} (arr, n) =
let
macdef lt = insertion_sort$lt<a>
fun
sort {i : int | 1 <= i; i <= n}
{p_arr : addr}
.<n - i>.
(pf_arr : !array_v (a, p_arr, n) >> _ |
p_arr : ptr p_arr,
i : size_t i)
:<!wrt> void =
if i <> n then
let
val pi = ptr_add<a> (p_arr, i)
fun
find_new_position
{j : nat | j <= i}
.<j>.
(pf_left : !array_v (a, p_arr, j) >> _,
pf_i : !a @ (p_arr + (i * sizeof a)) |
j : size_t j)
:<> [j : nat | j <= i] size_t j =
if j = i2sz 0 then
j
else
let
prval @(pf_left1, pf_k) = array_v_unextend pf_left
val k = pred j
val pk = ptr_add<a> (p_arr, k)
in
if ~((!pi) \lt (!pk)) then
let
prval () = pf_left :=
array_v_extend (pf_left1, pf_k)
in
j
end
else
let
val new_pos =
find_new_position (pf_left1, pf_i | k)
prval () = pf_left :=
array_v_extend (pf_left1, pf_k)
in
new_pos
end
end
prval @(pf_left, pf_right) =
array_v_split {a} {p_arr} {n} {i} pf_arr
prval @(pf_i, pf_rest) = array_v_uncons pf_right
val j = find_new_position (pf_left, pf_i | i)
prval () = pf_arr :=
array_v_unsplit (pf_left, array_v_cons (pf_i, pf_rest))
in
if j < i then
array_subcirculate<a> (!p_arr, j, i);
sort (pf_arr | p_arr, succ i)
end
prval () = lemma_array_param arr
in
if n <> i2sz 0 then
sort (view@ arr | addr@ arr, i2sz 1)
end
(*------------------------------------------------------------------*)
(* The demonstration converts random numbers to linear strings, then
sorts the elements by their first character. Thus here is a simple
demonstration that the sort can handle elements of linear type, and
also that the sort is stable. *)
implement
main0 () =
let
implement
insertion_sort$lt<Strptr1> (x, y) =
let
val sx = $UNSAFE.castvwtp1{string} x
and sy = $UNSAFE.castvwtp1{string} y
val cx = $effmask_all $UNSAFE.string_get_at (sx, 0)
and cy = $effmask_all $UNSAFE.string_get_at (sy, 0)
in
cx < cy
end
implement
array_initize$init<Strptr1> (i, x) =
let
#define BUFSIZE 10
var buffer : array (char, BUFSIZE)
val () = array_initize_elt<char> (buffer, i2sz BUFSIZE, '\0')
val _ = $extfcall (int, "snprintf", addr@ buffer,
i2sz BUFSIZE, "%d",
$extfcall (int, "rand") % 100)
val () = buffer[BUFSIZE - 1] := '\0'
in
x := string0_copy ($UNSAFE.cast{string} buffer)
end
implement
array_uninitize$clear<Strptr1> (i, x) =
strptr_free x
#define SIZE 30
val @(pf_arr, pfgc_arr | p_arr) =
array_ptr_alloc<Strptr1> (i2sz SIZE)
macdef arr = !p_arr
var i : [i : nat] int i
in
array_initize<Strptr1> (arr, i2sz SIZE);
for (i := 0; i < SIZE; i := succ i)
let
val p = ptr_add<Strptr1> (p_arr, i)
val s = $UNSAFE.ptr0_get<string> p
in
print! (" ", s)
end;
println! ();
insertion_sort<Strptr1> (arr, i2sz SIZE);
for (i := 0; i < SIZE; i := succ i)
let
val p = ptr_add<Strptr1> (p_arr, i)
val s = $UNSAFE.ptr0_get<string> p
in
print! (" ", s)
end;
println! ();
array_uninitize<Strptr1> (arr, i2sz SIZE);
array_ptr_free (pf_arr, pfgc_arr | p_arr)
end</lang>
=={{header|AutoHotkey}}==
| |||