Download code

Jump to: navigation, search

Back to Sierpinski_triangle_(OCaml)

Download for Windows: single file, zip

Download for UNIX: single file, zip, tar.gz, tar.bz2

cellular.ml

 1 (* The authors of this work have released all rights to it and placed it
 2 in the public domain under the Creative Commons CC0 1.0 waiver
 3 (http://creativecommons.org/publicdomain/zero/1.0/).
 4 
 5 THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
 6 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
 7 MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
 8 IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
 9 CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
10 TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
11 SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
12 
13 Retrieved from: http://en.literateprograms.org/Sierpinski_triangle_(OCaml)?oldid=13640
14 *)
15 
16 type empty_full = E | F 
17 
18 let char_of_ef = function
19    E -> ' '
20  | F -> '@'
21 type 'a space = 'a list
22 type 'a rule = ('a * 'a * 'a) -> 'a
23 type 'a cellular = 'a rule * 'a
24 let space : empty_full space =
25   let blanks = Array.to_list (Array.make 32 E) in
26   blanks @ F :: blanks
27 let rule : empty_full rule = function
28    F,E,E
29  | E,F,E
30  | E,E,F
31  | E,F,F
32  | F,E,F
33  | F,F,E -> F
34  | _     -> E
35 let sier : empty_full cellular =
36   rule, E
37 let next_gen (rule,def:'a cellular) (s:'a space) : 'a space =
38   let rec next_gen_aux = function
39      a::b::c::xs -> rule (a, b, c) :: next_gen_aux (b::c::xs)
40    | _           -> []
41   in
42     next_gen_aux (def :: s @ [def])
43 let run_sierpinski (n:int) : unit =
44   let s = ref space in
45   for i = 1 to n do
46     List.iter print_char (List.map char_of_ef !s);
47     print_newline ();
48     s := next_gen sier !s
49   done


hijacker
hijacker
hijacker
hijacker