mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-18 19:03:45 +00:00
9b6390b17e
extras/curs/curs.m:
extras/curs/curs.panel.m:
Make panel a separate submodule of curs, not a nested submodule.
extras/base64/base64.m:
extras/curses/mcurses.basics.m:
extras/curses/mcurses.m:
extras/curses/mcurses.misc.m:
extras/curses/mcurses.user.m:
extras/gator/evolve.m:
extras/gator/genotype.m:
extras/gator/phenotype.m:
extras/gator/tausworthe3.m:
extras/monte/dots.m:
extras/monte/geom.m:
extras/monte/hg.m:
extras/monte/monte.m:
extras/monte/rnd.m:
extras/moose/grammar.m:
extras/moose/moose.m:
extras/mopenssl/mopenssl.m:
extras/net/echo.m:
extras/net/errno.m:
extras/net/getaddrinfo.m:
extras/net/net.m:
extras/net/netdb.m:
extras/net/sockets.m:
extras/net/streams.m:
extras/net/tcp.m:
extras/net/test_lookups.m:
extras/net/types.m:
extras/odbc/odbc.m:
extras/odbc/odbc_test.m:
extras/references/README:
extras/references/reference.m:
extras/references/scoped_update.m:
extras/solver_types/library/any.m:
extras/solver_types/library/any_array.m:
extras/solver_types/library/any_assoc_list.m:
extras/solver_types/library/any_list.m:
extras/solver_types/library/any_map.m:
extras/solver_types/library/any_tree234.m:
extras/solver_types/library/any_util.m:
extras/trail/trail.m:
extras/trailed_update/samples/interpreter.m:
extras/trailed_update/samples/vqueens.m:
extras/trailed_update/tests/var_test.m:
extras/trailed_update/tr_array.m:
extras/trailed_update/tr_store.m:
extras/trailed_update/trailed_update.m:
extras/trailed_update/unsafe.m:
extras/trailed_update/var.m:
Bring programming style up to date.
81 lines
2.4 KiB
Mathematica
81 lines
2.4 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 2010 The University of Melbourne.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module monte.
|
|
|
|
:- interface.
|
|
|
|
:- import_module float.
|
|
:- import_module int.
|
|
|
|
:- type box
|
|
---> box(
|
|
xmin :: float,
|
|
ymin :: float,
|
|
zmin :: float,
|
|
xmax :: float,
|
|
ymax :: float,
|
|
zmax :: float
|
|
).
|
|
|
|
:- type shape == pred(float, float, float).
|
|
:- inst shape == (pred(in, in, in) is semidet).
|
|
|
|
:- type precision == int.
|
|
|
|
:- type volume == float.
|
|
|
|
:- pred monte(box::in, shape::in(shape), precision::in, volume::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module rnd.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
monte(Box, Shape, Precision, Volume) :-
|
|
rnd.init(17, Rnd0),
|
|
monte_outer_loop(Box, Shape, Precision, Rnd0, 0, Hits),
|
|
Prop = float(Hits) / float(Precision),
|
|
BoxVolume =
|
|
(Box ^ xmax - Box ^ xmin) *
|
|
(Box ^ ymax - Box ^ ymin) *
|
|
(Box ^ zmax - Box ^ zmin),
|
|
Volume = BoxVolume * Prop.
|
|
|
|
:- pred monte_outer_loop(box::in, shape::in(shape), int::in, rnd::in,
|
|
int::in, int::out) is det.
|
|
|
|
monte_outer_loop(Box, Shape, N, !.Rnd, !Hits) :-
|
|
( if N > 10000 then
|
|
monte_inner_loop(Box, Shape, 10000, !Rnd, !Hits),
|
|
monte_outer_loop(Box, Shape, N - 10000, !.Rnd, !Hits)
|
|
else
|
|
monte_inner_loop(Box, Shape, N, !.Rnd, _, !Hits)
|
|
).
|
|
|
|
:- pred monte_inner_loop(box::in, shape::in(shape), int::in,
|
|
rnd::in, rnd::out, int::in, int::out) is det.
|
|
|
|
monte_inner_loop(Box, Shape, N, !Rnd, !Hits) :-
|
|
( if N > 0 then
|
|
frange(Box ^ xmin, Box ^ xmax, X, !Rnd),
|
|
frange(Box ^ ymin, Box ^ ymax, Y, !Rnd),
|
|
frange(Box ^ zmin, Box ^ zmax, Z, !Rnd),
|
|
( if call(Shape, X, Y, Z) then
|
|
!:Hits = !.Hits + 1
|
|
else
|
|
true
|
|
),
|
|
monte_inner_loop(Box, Shape, N - 1, !Rnd, !Hits)
|
|
else
|
|
true
|
|
).
|