Back to dada's perl lab
|
|
Mercury |
Back to the Win32 Shootout Back to dada's perl lab |
| All Source For mercury |
|---|
| Ackermann's Function |
%% $Id: ackermann.mercury,v 1.3 2001/05/13 01:22:35 doug Exp $
%% http://www.bagley.org/~doug/shootout/
:- module mytest.
:- interface.
:- import_module io.
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
:- implementation.
:- func ack(int, int) = int.
:- mode ack(in, in) = out is det.
:- import_module string, list, int.
:- pred mytest(int, io__state, io__state).
:- mode mytest(in, di, uo) is det.
ack(M, N) = R :-
( if M = 0 then
R = N + 1
else if N = 0 then
R = ack(M - 1, 1)
else
R = ack(M - 1, ack(M, N - 1))
).
mytest(Num) -->
io__write_string("Ack(3,"),
io__write_int(Num),
io__write_string("): "),
io__write_int(ack(3,Num)),
io__write_string("\n").
main -->
io__command_line_arguments(Args),
( if { Args = [] } then
mytest(1)
else if { Args = [Arg|_] } then
( if { string__to_int(Arg, N), N > 0 } then
mytest(N)
else
mytest(1)
)
).
|
| Array Access |
%% $Id: ary3.mercury,v 1.1 2001/05/31 02:27:48 doug Exp $
%% http://www.bagley.org/~doug/shootout/
%% based on some code from Ralph Becket
:- module mytest.
:- interface.
:- import_module io.
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
:- implementation.
:- import_module array, int, list, string, require.
main -->
io__command_line_arguments(ArgV),
( { ArgV = [], N = 1 }
; { ArgV = [Arg], N = string__det_to_int(Arg) }
; { ArgV = [_,_|_], error("usage: arrayaccess [N]") }
),
{ X = some_naturals(0, array__init(N, 0)) },
{ Y = add_arrays_n(1000, N-1, X, array__init(N, 0)) },
io__write_int(array__lookup(Y, 0)),
io__write_string(" "),
io__write_int(array__lookup(Y, N - 1)),
io__nl.
:- func some_naturals(int, array(int)) = array(int).
:- mode some_naturals(in, array_di) = array_uo is det.
some_naturals(I, A) =
( if I =< array__max(A) then some_naturals(I + 1, array__set(A, I, I + 1))
else A ).
:- func add_array(int, array(int), array(int)) = array(int).
:- mode add_array(in, array_ui, array_di) = array_uo is det.
add_array(I, A, B) =
( if I < 0
then B
else add_array(I - 1, A, array__set(B, I, array__lookup(A, I) + array__lookup(B, I)))
).
:- func add_arrays_n(int, int, array(int), array(int)) = array(int).
:- mode add_arrays_n(in, in, array_ui, array_di) = array_uo is det.
add_arrays_n(N, Len, A, B) =
( if N > 0
then add_arrays_n(N - 1, Len, A, add_array(Len, A, B))
else B
).
|
| Fibonacci Numbers |
%% $Id: fibo.mercury,v 1.3 2001/05/13 01:22:35 doug Exp $
%% http://www.bagley.org/~doug/shootout/
:- module mytest.
:- interface.
:- import_module io.
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
:- implementation.
:- func fib(int) = int.
:- mode fib(in) = out is det.
:- import_module string, list, int.
:- pred mytest(int, io__state, io__state).
:- mode mytest(in, di, uo) is det.
fib(N) = R :-
( if N < 2 then
R = 1
else
R = fib(N-2) + fib(N-1)
).
mytest(Num) -->
io__write_int(fib(Num)), io__write_string("\n").
main -->
io__command_line_arguments(Args),
( if { Args = [] } then
mytest(1)
else if { Args = [Arg|_] } then
( if { string__to_int(Arg, N), N > 0 } then
mytest(N)
else
mytest(1)
)
).
|
| Hash (Associative Array) Access |
%% $Id: hash.mercury,v 1.1 2001/07/28 19:11:22 doug Exp $
%% http://www.bagley.org/~doug/shootout/
%% from Fergus Henderson
:- module mytest.
:- interface.
:- import_module io.
:- pred main(state::di, state::uo) is det.
:- implementation.
:- import_module string, hash_table, list, int.
main -->
io__command_line_arguments(Args),
{ N = (if Args = [Arg], to_int(Arg, N0) then N0 else 1) },
{ X = insert_values(1, N, hash_table__new(string_double_hash, 18, 0.33)) },
print(count(N, X, 0)), nl.
:- func insert_values(int, int, hash_table(string, int)) = hash_table(string, int).
:- mode insert_values(in, in, hash_table_di) = hash_table_uo.
insert_values(I, N, X0) =
(if I > N then X0
else insert_values(I + 1, N, X0^elem(int_to_base_string(I, 16)) := I)).
:- func count(int, hash_table(string, int), int) = int.
:- mode count(in, hash_table_ui, in) = out.
count(I, X, C0) =
(if I = 0 then C0
else count(I - 1, X,
(if search(X, int_to_string(I), _) then C0 + 1 else C0))).
|
| Heapsort |
% ---------------------------------------------------------------------------- %
% heapsort.m
% Ralph Becket <rbeck@microsoft.com>
% Tue Jan 9 14:18:19 GMT 2001
% vim: ts=4 sw=4 et tw=0 wm=0 ff=unix
%
% ---------------------------------------------------------------------------- %
:- module mytest.
:- interface.
:- import_module io.
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
:- implementation.
:- import_module float, int, array, random, list, string, require.
:- type heap == array(float).
main -->
io__command_line_arguments(ArgV),
( { ArgV = [], N = 1 }
; { ArgV = [Arg], N = string__det_to_int(Arg) }
; { ArgV = [_,_|_], error("usage: heapsort [N]") }
),
{ A = heapsort(N - 1, random_heap(0, seed, array__init(N, 0.0))) },
io__format("%.10f", [f(array__lookup(A, N - 1))]),
io__nl.
:- func random_heap(int, int, heap) = heap.
:- mode random_heap(in, in, array_di) = array_uo is det.
random_heap(I, S0, H0) = H :-
( if I =< array__max(H0) then
gen_random(R, S0, S),
H = random_heap(I + 1, S, up_heap(I, R, H0))
else
H = H0
).
:- func up_heap(int, float, heap) = heap.
:- mode up_heap(in, in, array_di) = array_uo is det.
up_heap(N, Y, H) =
( if 0 < N, X < Y then
up_heap(HalfN, Y, array__set(H, N, X))
else
array__set(H, N, Y)
)
:-
HalfN = N // 2,
X = array__lookup(H, HalfN).
:- func heapsort(int, heap) = heap.
:- mode heapsort(in, array_di) = array_uo is det.
heapsort(N, H) =
( if N = 0 then H else heapsort(N - 1, remove_greatest(N, H)) ).
:- func remove_greatest(int, heap) = heap.
:- mode remove_greatest(in, array_di) = array_uo is det.
remove_greatest(N, H) = down_heap(0, N - 1, Y, array__set(H, N, X)) :-
X = array__lookup(H, 0),
Y = array__lookup(H, N).
:- func down_heap(int, int, float, heap) = heap.
:- mode down_heap(in, in, in, array_di) = array_uo is det.
down_heap(I, N, X, H0) = H :-
L = I + I + 1,
R = L + 1,
( if N < L then
H = array__set(H0, I, X)
else
J = ( if R < N, array__lookup(H0, R) > array__lookup(H0, L) then R
else L ),
Y = array__lookup(H0, J),
( if X > Y then
H = array__set(H0, I, X)
else
H = down_heap(J, N, X, array__set(H0, I, Y))
)
).
:- pred gen_random(float, int, int).
:- mode gen_random(out, in, out) is det.
gen_random(R, S0, S) :-
S = (S0 * ia + ic) `mod` im,
R = float(S) / float(im).
:- func im = int. im = 139968.
:- func ia = int. ia = 3877.
:- func ic = int. ic = 29573.
:- func seed = int. seed = 42.
|
| Hello World |
%% $Id: hello.mercury,v 1.2 2001/06/18 01:13:58 doug Exp $
%% http://www.bagley.org/~doug/shootout/
:- module mytest.
:- interface.
:- import_module io.
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
main --> io__write_string("hello world\n").
|
| List Operations |
% ---------------------------------------------------------------------------- %
% lists.m
% Ralph Becket <rbeck@microsoft.com>
% Tue Jan 9 13:50:50 GMT 2001
% vim: ts=4 sw=4 et tw=0 wm=0 ff=unix
%
% NOTE: this is not really a fair test since the Mercury list
% library does not implement doubly-linked lists as the C and
% (presumably) Python versions do.
% ---------------------------------------------------------------------------- %
:- module mytest.
:- interface.
:- import_module io.
:- pred main(io__state, io__state).
:- mode main(di, uo) is cc_multi.
:- implementation.
:- import_module string, list, int, require, benchmarking.
main -->
io__command_line_arguments(ArgV),
( { ArgV = [], Repeats = 1 }
; { ArgV = [Arg], Repeats = string__det_to_int(Arg) }
; { ArgV = [_,_|_], error("usage: nestedloops [Repeats]") }
),
{ benchmarking__benchmark_det(test_list_ops, 0, N, Repeats, Time) },
io__format("%d\n", [i(N)]).
:- func size = int.
size = 10000.
:- pred test_list_ops(int, int).
:- mode test_list_ops(in, out) is det.
test_list_ops(_, N) :-
L1 = 1 `..` size, % Build [1, 2, ..., size].
copy(L1, L2), % Make a copy.
% Do a naive reverse.
L3 = list__foldl(func(X, L) = L ++ [X], L2, []),
% Now do a weird copy.
L4 = list__foldr(func(X, L) = L ++ [X], L3, []),
L5 = list__reverse(L1), % Standard reverse.
(
if list__det_head(L5) \= size then N = 0
else if L1 \= L2 then N = 0
else N = list__length(L4)
).
|
| Method Calls |
%% $Id: methcall.mercury,v 1.1 2001/07/28 22:15:46 doug Exp $
%% http://www.bagley.org/~doug/shootout/
%% from Fergus Henderson
% "This test uses a base class Toggle, which implements a simple boolean
% flip-flop device and a derived class NthToggle, which only flips every
% Nth time it is activated."
:- module mytest.
:- interface.
:- import_module io.
:- pred main(io__state::di, io__state::uo) is det.
:- implementation.
:- import_module bool, int, string, list.
% "The base Toggle class should define a boolean
% (or integer) field to hold a true/false value. It should define methods
% to access the value, and to activate the toggle (flip it's value)."
:- type toggle ---> toggle(toggle_value::bool).
:- typeclass toggle(T) where [
func value(T) = bool,
func 'value :='(T, bool) = T,
func activate(T) = T
].
:- instance toggle(toggle) where [
func(value/1) is toggle_value,
func('value :='/2) is 'toggle_value :=',
activate(toggle(yes)) = toggle(no),
activate(toggle(no)) = toggle(yes)
].
% "The derived NthToggle class should inherit the boolean field, and add a
% counter and limit field. It should override the activate method so that
% the boolean state is flipped after the activate method is called count
% times. The constructor for NthToggle should use the constructor for
% Toggle to inherit the boolean field and value() method."
% Mercury doesn't have any direct support for inheritence of fields,
% so we need to use composition instead.
:- type nth_toggle ---> nth_toggle(base::toggle, counter::int, limit::int).
:- func make_nth_toggle(bool, int) = nth_toggle.
make_nth_toggle(Val, Max) = nth_toggle(toggle(Val), 0, Max).
% If the nth_toggle class added its own methods, then we'd want to
% create a derived typeclass like this:
%
% :- typeclass nth_toggle(T) <= toggle(T) where [ ... ].
% :- instance nth_toggle(nth_toggle) where [ ... ].
%
% But nth_toggle doesn't add any new methods, so we don't need that.
% We just need to make it an instance of the base class,
% delegating the field accessors.
:- instance toggle(nth_toggle) where [
value(T) = T^base^value,
'value :='(T, V) = T^base^value := V,
(activate(T) = NewT :-
C = T^counter + 1,
(if C >= T^limit then
NewT = (T^counter := 0)^base := activate(T^base)
else
NewT = T^counter := C
))
].
main -->
io__command_line_arguments(Args),
{ N = (if Args = [Arg], to_int(Arg, N0) then N0 else 1) },
{ loop(N, yes, toggle(yes),
(pred(_V0::in, T0::in, V::out, T::out) is det :-
T = T0^activate, V = T^value),
Value1, _Toggle1) },
write_string(if Value1 = yes then "true" else "false"), nl,
{ loop(N, yes, make_nth_toggle(yes, 3),
(pred(_V0::in, T0::in, V::out, T::out) is det :-
T = T0^activate, V = T^value),
Value2, _Toggle2) },
write_string(if Value2 = yes then "true" else "false"), nl.
:- pred loop(int, T1, T2, pred(T1, T2, T1, T2), T1, T2).
:- mode loop(in, in, in, pred(in, in, out, out) is det, out, out) is det.
loop(N, V0, T0, P, V, T) :-
(if N = 0 then
V = V0, T = T0
else
P(V0, T0, V1, T1),
loop(N - 1, V1, T1, P, V, T)
).
% Alternatively, it can be written a little more elegantly as
%
% main -->
% io__command_line_arguments(Args),
% { N = (if Args = [Arg], to_int(Arg, N0) then N0 else 1) },
%
% { {Value1, _Toggle1} = repeat_n(N, {yes, toggle(yes)},
% (func({_V0, T0}) = {V, T} :- T = T0^activate, V = T^value)) },
% write_string(if Value1 = yes then "true" else "false"), nl,
%
% { {Value2, _Toggle2} = repeat_n(N, {yes, make_nth_toggle(yes, 3)},
% (func({_V0, T0}) = {V, T} :- T = T0^activate, V = T^value)) },
% write_string(if Value2 = yes then "true" else "false"), nl.
%
% :- func repeat_n(int, T, func(T) = T) = T.
% repeat_n(N, X, F) =
% (if N = 0 then X
% else repeat_n(N - 1, F(X), F)).
%
% but the earlier code above is a little more efficient.
|
| Nested Loops |
% ---------------------------------------------------------------------------- %
% nestedloop.m
% Ralph Becket <rbeck@microsoft.com>
% Tue Jan 9 13:36:26 GMT 2001
% vim: ts=4 sw=4 et tw=0 wm=0 ff=unix
%
% ---------------------------------------------------------------------------- %
:- module mytest.
:- interface.
:- import_module io.
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
:- implementation.
:- import_module list, int, std_util, string, require.
main -->
io__command_line_arguments(ArgV),
( { ArgV = [], N = 1 }
; { ArgV = [Arg], N = string__det_to_int(Arg) }
; { ArgV = [_,_|_], error("usage: nestedloop [N]") }
),
io__write_int(nested_loop(N)),
io__nl.
:- func nested_loop(int) = int.
nested_loop(N) =
loop(N, loop(N, loop(N, loop(N, loop(N, loop(N, plus(1)))))), 0).
:- func loop(int, func(int) = int, int) = int.
loop(I, Fn, X) = ( if I > 0 then loop(I - 1, Fn, Fn(X)) else X ).
|
| Object Instantiation |
%% $Id: objinst.mercury,v 1.1 2001/07/29 00:07:28 doug Exp $
%% http://www.bagley.org/~doug/shootout/
%% from Fergus Henderson
:- module mytest.
:- interface.
:- import_module io.
:- pred main(io__state::di, io__state::uo) is det.
:- implementation.
:- import_module bool, int, string, list.
:- type toggle ---> toggle(toggle_value::bool).
:- typeclass toggle(T) where [
func value(T) = bool,
func 'value :='(T, bool) = T,
func activate(T) = T
].
:- instance toggle(toggle) where [
func(value/1) is toggle_value,
func('value :='/2) is 'toggle_value :=',
activate(toggle(yes)) = toggle(no),
activate(toggle(no)) = toggle(yes)
].
:- type nth_toggle ---> nth_toggle(base::toggle, counter::int, limit::int).
:- func make_nth_toggle(bool, int) = nth_toggle.
make_nth_toggle(Val, Max) = nth_toggle(toggle(Val), 0, Max).
:- instance toggle(nth_toggle) where [
value(T) = T^base^value,
'value :='(T, V) = T^base^value := V,
(activate(T) = NewT :-
C = T^counter + 1,
(if C >= T^limit then
NewT = (T^counter := 0)^base := activate(T^base)
else
NewT = T^counter := C
))
].
main -->
io__command_line_arguments(Args),
{ N = (if Args = [Arg], to_int(Arg, N0) then N0 else 1) },
{ Toggle1 = toggle(yes) },
loop(5, (pred(T0::in, T::out, di, uo) is det -->
{ T = T0^activate },
write_string(if T^value = yes then "true" else "false"),
nl),
Toggle1, Toggle2),
loop(N, (pred(_T0::in, T::out, di, uo) is det -->
{ T = toggle(yes) }),
Toggle2, _Toggle3),
nl,
{ Toggle4 = make_nth_toggle(yes, 3) },
loop(8, (pred(T0::in, T::out, di, uo) is det -->
{ T = T0^activate },
write_string(if T^value = yes then "true" else "false"),
nl),
Toggle4, Toggle5),
loop(N, (pred(_T0::in, T::out, di, uo) is det -->
{ T = make_nth_toggle(yes, 3) }),
Toggle5, _Toggle6).
:- pred loop(int, pred(T1, T1, T2, T2), T1, T1, T2, T2).
:- mode loop(in, pred(in, out, di, uo) is det, in, out, di, uo) is det.
loop(N, P, X0, X) -->
(if { N = 0 } then
{ X = X0 }
else
P(X0, X1),
loop(N - 1, P, X1, X)
).
|
| Random Number Generator |
% ---------------------------------------------------------------------------- %
% random.m
% Ralph Becket <rbeck@microsoft.com>
% Tue Jan 9 14:18:19 GMT 2001
% vim: ts=4 sw=4 et tw=0 wm=0 ff=unix
% ---------------------------------------------------------------------------- %
:- module mytest.
:- interface.
:- import_module io.
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
:- implementation.
:- import_module float, int, list, string, require.
main -->
io__command_line_arguments(ArgV),
( { ArgV = [], N = 1 }
; { ArgV = [Arg], N = string__det_to_int(Arg) }
; { ArgV = [_,_|_], error("usage: random [N]") }
),
io__format("%.9f\n", [f(nth_random_no(N, seed))]).
:- func nth_random_no(int, int) = float.
nth_random_no(I, S0) = ( if I > 1 then nth_random_no(I - 1, S) else R ) :-
gen_random(100.0, R, S0, S).
:- pred gen_random(float, float, int, int).
:- mode gen_random(in, out, in, out) is det.
gen_random(Max, R, S0, S) :-
S = (S0 * ia + ic) `rem` im,
R = Max * float(S) / float(im).
:- func im = int. im = 139968.
:- func ia = int. ia = 3877.
:- func ic = int. ic = 29573.
:- func seed = int. seed = 42.
|
| Reverse a File |
% ---------------------------------------------------------------------------- %
% reversefile.m
% Ralph Becket <rbeck@microsoft.com>
% Tue Jan 9 11:39:27 GMT 2001
% vim: ts=4 sw=4 et tw=0 wm=0 ff=unix
%
% ---------------------------------------------------------------------------- %
:- module mytest.
:- interface.
:- import_module io.
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
:- implementation.
:- import_module string, list, require.
main -->
read_file_reversed([], ReversedLines),
io__write_list(ReversedLines, "", io__write_string).
:- pred read_file_reversed(list(string), list(string), io__state, io__state).
:- mode read_file_reversed(in, out, di, uo) is det.
read_file_reversed(RLs0, RLs) -->
io__read_line_as_string(Result),
( { Result = ok(Line) }, read_file_reversed([Line | RLs0], RLs)
; { Result = eof }, { RLs = RLs0 }
; { Result = error(ErrNo) }, { error(io__error_message(ErrNo)) }
).
|
| Sieve of Erathostenes |
% ---------------------------------------------------------------------------- %
% sieve.m
% Ralph Becket <rbeck@microsoft.com>
% Mon Jan 8 14:23:22 GMT 2001
% vim: ts=4 sw=4 et tw=0 wm=0 ff=unix
%
% Eratosthenes' Sieve - counts the number of primes in 2..8192
%
% ---------------------------------------------------------------------------- %
:- module mytest.
:- interface.
:- import_module io.
:- pred main(io__state, io__state).
:- mode main(di, uo) is cc_multi.
:- implementation.
:- import_module int, bool, array, string, list, require, benchmarking.
main -->
io__command_line_arguments(ArgV),
( { ArgV = [], Repeats = 1 }
; { ArgV = [Arg], Repeats = string__det_to_int(Arg) }
; { ArgV = [_,_|_], error("usage: sieve [NumIterations]") }
),
{ P = ( pred(Sz::in, N::out) is det :- N = count_primes(Sz) ) },
{ benchmarking__benchmark_det(P, 8192, Count, Repeats, Time) },
io__format("Count: %d\n", [i(Count)]).
:- func count_primes(int) = int.
count_primes(Size) = sieve_and_count(2, array__init(Size, yes), 0).
:- func sieve_and_count(int, array(bool), int) = int.
:- mode sieve_and_count(in, array_di, in) = out is det.
sieve_and_count(I, A, N) =
( if I > array__max(A) then N
else if array__lookup(A, I) = no then sieve_and_count(I + 1, A, N)
else sieve_and_count(I + 1, filter_multiples(I + I, I, A), N + 1)
).
:- func filter_multiples(int, int, array(bool)) = array(bool).
:- mode filter_multiples(in, in, array_di) = array_uo is det.
filter_multiples(I, P, A) =
( if I > array__max(A)
then A
else filter_multiples(I + P, P, array__set(A, I, no))
).
|
| Spell Checker |
% ---------------------------------------------------------------------------- %
% spellcheck.m
% Ralph Becket <rbeck@microsoft.com>
% Tue Jan 9 16:43:59 GMT 2001
% vim: ts=4 sw=4 et tw=0 wm=0 ff=unix
%
% ---------------------------------------------------------------------------- %
:- module mytest.
:- interface.
:- import_module io.
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
:- implementation.
:- import_module map, int, list, string, require, std_util, char.
:- type dict == map(string, unit).
main -->
io__see("Usr.Dict.Words", Res),
( { Res = ok }, read_dictionary(map__init, Dict)
; { Res = error(ErrNo) }, { error(io__error_message(ErrNo)) }
),
io__seen,
find_errors(Dict).
:- pred read_dictionary(dict, dict, io__state, io__state).
:- mode read_dictionary(in, out, di, uo) is det.
read_dictionary(D0, D) -->
io__read_line_as_string(Result),
(
{ Result = ok(Line) },
{ Words = string__words(char__is_whitespace, Line) },
{ D1 = list__foldl(func(W, M) = M ^ elem(W) := unit, Words, D0) },
read_dictionary(D1, D)
;
{ Result = eof },
{ D = D0 }
;
{ Result = error(ErrNo) },
{ error(io__error_message(ErrNo)) }
).
:- pred find_errors(dict, io__state, io__state).
:- mode find_errors(in, di, uo) is det.
find_errors(D) -->
io__read_line_as_string(Result),
(
{ Result = ok(Line) },
{ Words = string__words(char__is_whitespace, Line) },
list__foldl(
( pred(S::in, di, uo) is det -->
( if { map__contains(D, S) }
then []
else io__write_string(S), io__nl
)
),
Words
),
find_errors(D)
;
{ Result = eof }
;
{ Result = error(ErrNo) },
{ error(io__error_message(ErrNo)) }
).
|
| Statistical Moments |
%% $Id: moments.mercury,v 1.1 2001/07/29 15:25:39 doug Exp $
%% http://www.bagley.org/~doug/shootout/
%% from Fergus Henderson
:- module mytest.
:- interface.
:- import_module io.
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
:- implementation.
:- import_module array, string, float, math, int, list, require.
main -->
io__read_file_as_string(_Res, Contents),
{ Lines = string__words((pred('\n'::in) is semidet), Contents) },
{ Count = length(Lines) },
{ array__init(Count, 0.0, Array0) },
{ count_and_sum(Lines, 0, 0.0, Array0, _Count2, Sum, Array) },
{ Mean = Sum / float(Count) },
process(0, Count, Mean, 0.0, 0.0, 0.0, 0.0, Array).
:- pred count_and_sum(list(string), int, float, array(float),
int, float, array(float)).
:- mode count_and_sum(in, in, in, array_di, out, out, array_uo) is det.
count_and_sum([], Count, Sum, Array, Count, Sum, Array).
count_and_sum([L|Ls], Count0, Sum0, Array0, Count, Sum, Array) :-
(if string__to_float(L, V) then Val = V else error("float conversion")),
count_and_sum(Ls, Count0 + 1, Sum0 + Val, Array0^elem(Count0) := Val,
Count, Sum, Array).
:- pred process(int, int, float, float, float, float, float, array(float),
io__state, io__state).
:- mode process(in, in, in, in, in, in, in, array_di, di, uo) is det.
process(I, Count, Mean,
SumAbsDeviations, SumVariance, SumSkew, SumKurtosis, Array0) -->
(if { I < Count } then
{ Val = Array0 ^ elem(I) },
{ Dev = Val - Mean },
{ Dev2 = Dev * Dev },
{ Dev3 = Dev2 * Dev },
{ Dev4 = Dev2 * Dev2 },
process(I + 1, Count, Mean, SumAbsDeviations + abs(Dev),
SumVariance + Dev2, SumSkew + Dev3,
SumKurtosis + Dev4, Array0)
else
{
AverageDeviation = SumAbsDeviations / float(Count),
Variance = SumVariance / float(Count - 1),
StandardDeviation = sqrt(Variance),
(if Variance \= 0.0 then
Skew = SumSkew / (float(Count) * Variance *
StandardDeviation),
Kurtosis = (SumKurtosis / (float(Count) *
Variance * Variance)) - 3.0
else
Skew = 0.0,
Kurtosis = 0.0
),
Array = sort(Array0),
Mid = (Count//2),
Median = (if Count rem 2 = 1 then Array^elem(Mid)
else (Array^elem(Mid) + Array^elem(Mid - 1)) / 2.0)
},
format("n: %d\n", [i(Count)]),
format("median: %f\n", [f(Median)]),
format("mean: %f\n", [f(Mean)]),
format("average_deviation: %f\n", [f(AverageDeviation)]),
format("standard_deviation: %f\n", [f(StandardDeviation)]),
format("variance: %f\n", [f(Variance)]),
format("skew: %f\n", [f(Skew)]),
format("kurtosis: %f\n", [f(Kurtosis)])
).
|
| String Concatenation |
% ---------------------------------------------------------------------------- %
% stringconcat.m
% Ralph Becket <rbeck@microsoft.com>
% Tue Jan 9 15:56:12 GMT 2001
% vim: ts=4 sw=4 et tw=0 wm=0 ff=unix
%
% NOTE: The C version simply appends to the end of a preallocated
% buffer, doubling the buffer size when necessary. Not what I would strictly
% call string concatenation.
%
% ---------------------------------------------------------------------------- %
:- module mytest.
:- interface.
:- import_module io.
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
:- implementation.
:- import_module string, int, list, require.
main -->
io__command_line_arguments(ArgV),
( { ArgV = [], N = 1 }
; { ArgV = [Arg], N = string__det_to_int(Arg) }
; { ArgV = [_,_|_], error("usage: nestedloops [N]") }
),
io__write_int(string__length(hellos(N, ""))),
io__nl.
:- func hellos(int, string) = string.
hellos(I, S) = ( if I > 0 then hellos(I - 1, S ++ "hello\n") else S ).
|
| Sum a Column of Integers |
%% $Id: sumcol.mercury,v 1.3 2001/05/13 01:22:35 doug Exp $
%% http://www.bagley.org/~doug/shootout/
:- module mytest.
:- interface.
:- import_module io.
:- pred main(io__state :: di, io__state :: uo) is det.
:- implementation.
:- import_module string, int.
main -->
io__read_line_as_string(IOResult),
sumcol(IOResult, 0).
:- pred sumcol(io__result(string)::in, int::in, io__state::di, io__state::uo) is det.
sumcol(IOResult, Sum) -->
( { IOResult = ok(LineIn) },
{ chomp(LineIn, Line) },
io__read_line_as_string(NewIOResult),
( if { string__to_int(Line, N) } then
sumcol(NewIOResult, Sum + N)
else
sumcol(NewIOResult, Sum)
)
; { IOResult = eof },
io__write_int(Sum),
io__write_string("\n")
; { IOResult = error(_Error) },
io__write_string("Error reading file!")
).
:- pred chomp(string::in, string::out) is det.
chomp(InStr, OutStr) :-
( if string__remove_suffix(InStr, "\n", NewStr) then
OutStr = NewStr
else
OutStr = InStr
).
|
| Word Frequency Count |
% ---------------------------------------------------------------------------- %
% wordfreq.m
% Ralph Becket <rbeck@microsoft.com>
% Tue Jan 9 15:56:12 GMT 2001
% vim: ts=4 sw=4 et tw=0 wm=0 ff=unix
%
% ---------------------------------------------------------------------------- %
:- module mytest.
:- interface.
:- import_module io.
:- pred main(io__state, io__state).
:- mode main(di, uo) is det.
:- implementation.
:- import_module string, int, list, require, std_util, char, map.
main -->
count_word_freqs(map__init, FreqMap),
{ X = list__sort(list__map(func(K-V) = V-K, map__to_assoc_list(FreqMap))) },
{ Y = list__reverse(X) },
io__write_list(Y, "\n", write_freq_word),
io__nl.
:- pred count_word_freqs(map(string,int),map(string,int),io__state,io__state).
:- mode count_word_freqs(in, out, di, uo) is det.
count_word_freqs(FreqMap0, FreqMap) -->
io__read_line_as_string(Result),
(
{ Result = ok(Line) },
{ Words = string__words(isnt(char__is_alpha),string__to_lower(Line)) },
{ Update =
( func(S, FM) =
( if map__search(FM, S, N)
then FM ^ elem(S) := N + 1
else FM ^ elem(S) := 1
)
)
},
{ FreqMap1 = list__foldl(Update, Words, FreqMap0) },
count_word_freqs(FreqMap1, FreqMap)
;
{ Result = eof },
{ FreqMap = FreqMap0 }
;
{ Result = error(ErrNo) },
{ error(io__error_message(ErrNo)) }
).
:- pred write_freq_word(pair(int, string), io__state, io__state).
:- mode write_freq_word(in, di, uo) is det.
write_freq_word(Freq - Word) -->
io__format("%7d\t%s", [i(Freq), s(Word)]).
|