├── .gitignore
├── .travis-ci.sh
├── .travis.yml
├── LICENSE
├── Makefile
├── README.md
├── dune-project
├── notebooks
└── rs-library-tutorial.ipynb
├── reedsolomon.opam
├── src
├── codec.ml
├── codec.mli
├── dune
├── galois.ml
├── galois.mli
├── iter.ml
├── iter.mli
├── matrix.ml
├── matrix.mli
├── ops.ml
├── ops.mli
├── poly.ml
└── poly.mli
├── test
├── dune
└── test_iter.ml
└── webdemo
├── dune
└── rswebdemo.ml
/.gitignore:
--------------------------------------------------------------------------------
1 | *~
2 | _build
3 | .*.swp
4 | *.js
5 | *.byte
6 | .merlin
7 | *.install
8 |
--------------------------------------------------------------------------------
/.travis-ci.sh:
--------------------------------------------------------------------------------
1 | # Edit this for your own project dependencies
2 | OPAM_DEPENDS="ocamlfind"
3 |
4 | # install OCaml + OPAM
5 | case "$OCAML_VERSION,$OPAM_VERSION" in
6 | 3.12.1,1.0.0) ppa=avsm/ocaml312+opam10 ;;
7 | 3.12.1,1.1.0) ppa=avsm/ocaml312+opam11 ;;
8 | 4.00.1,1.0.0) ppa=avsm/ocaml40+opam10 ;;
9 | 4.00.1,1.1.0) ppa=avsm/ocaml40+opam11 ;;
10 | 4.01.0,1.0.0) ppa=avsm/ocaml41+opam10 ;;
11 | 4.01.0,1.1.0) ppa=avsm/ocaml41+opam11 ;;
12 | *) echo Unknown $OCAML_VERSION,$OPAM_VERSION; exit 1 ;;
13 | esac
14 |
15 | echo "yes" | sudo add-apt-repository ppa:$ppa
16 | sudo apt-get update -qq
17 | sudo apt-get install -qq ocaml ocaml-native-compilers camlp4-extra opam
18 | export OPAMYES=1
19 | opam init
20 | opam install ${OPAM_DEPENDS}
21 | eval `opam config env`
22 |
23 | # Test
24 | make
25 |
--------------------------------------------------------------------------------
/.travis.yml:
--------------------------------------------------------------------------------
1 | language: c
2 | script: bash -ex .travis-ci.sh
3 | env:
4 | - OCAML_VERSION=4.01.0 OPAM_VERSION=1.1.0
5 |
--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
1 | The MIT License (MIT)
2 |
3 | Copyright (c) 2014 MicroJamJar Ltd.
4 |
5 | Permission is hereby granted, free of charge, to any person obtaining a copy of
6 | this software and associated documentation files (the "Software"), to deal in
7 | the Software without restriction, including without limitation the rights to
8 | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
9 | the Software, and to permit persons to whom the Software is furnished to do so,
10 | subject to the following conditions:
11 |
12 | The above copyright notice and this permission notice shall be included in all
13 | copies or substantial portions of the Software.
14 |
15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
17 | FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
18 | COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
19 | IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
20 | CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
21 |
--------------------------------------------------------------------------------
/Makefile:
--------------------------------------------------------------------------------
1 | .PHONY: clean all install uninstall rswebdemo
2 |
3 | all:
4 | jbuilder build @install
5 |
6 | install: all
7 | jbuilder install
8 |
9 | uninstall:
10 | jbuilder uninstall
11 |
12 | rswebdemo: all
13 | jbuilder build webdemo/rswebdemo.bc.js
14 |
15 | test: all
16 | jbuilder build test/test_iter.exe
17 | ./_build/default/test/test_iter.exe
18 |
19 | clean:
20 | rm -fr _build
21 | find . -name "*~" | xargs rm
22 |
23 |
--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
1 | reedsolomon
2 | ===========
3 |
4 | [](https://travis-ci.org/ujamjar/reedsolomon)
5 |
6 | Reed-Solomon Error Correction CODEC in OCaml.
7 |
8 | The code in the modules Poly, Matrix and Codec is pretty abstract and
9 | not very efficient, however, it implements a few different options
10 | for decoding Reed-Solomon codes (Peterson, Euclid and Berlekamp-Massey)
11 | and both error and erasure correction.
12 |
13 | A much faster, error correction only, implementation is
14 | provided in the Iter module (not blazingly fast, but not too bad).
15 |
16 | ```
17 | open Reedsolomon.Iter
18 |
19 | (* code parameters *)
20 | let param =
21 | {
22 | m = 8;
23 | k = 239;
24 | t = 8;
25 | n = 255;
26 | b = 0;
27 | prim_poly = 285;
28 | prim_elt = 2;
29 | }
30 |
31 | (* construct rs codec *)
32 | let rs = Reedsolomon.Iter.init param
33 |
34 | (* construct parity from data
35 |
36 | Array.length data = param.k
37 | Array.length parity = param.t * 2 *)
38 | let () = rs.encode data parity
39 |
40 | (* message to send
41 |
42 | Array.length message = param.n *)
43 | let message = Array.concat [ data; parity ]
44 |
45 | (* decode the received and potentially err'd message
46 |
47 | Array.length received = param.n
48 | Array.length corrected = param.n *)
49 | let n_corrections = rs.decode received corrected
50 | ```
51 |
52 |
--------------------------------------------------------------------------------
/dune-project:
--------------------------------------------------------------------------------
1 | (lang dune 1.2)
2 |
--------------------------------------------------------------------------------
/notebooks/rs-library-tutorial.ipynb:
--------------------------------------------------------------------------------
1 | {"metadata":{"name":"","language":"ocaml"},"worksheets":[{"cells":[{"metadata":{},"cell_type":"heading","source":"Reed-solomon CODEC","level":1},{"metadata":{},"cell_type":"markdown","source":"This notebook will describe a Reed-Solomon CODEC library for OCaml."},{"metadata":{},"cell_type":"heading","source":"Building","level":2},{"metadata":{},"cell_type":"markdown","source":"```bash\n$ make\n$ make install\n```"},{"metadata":{},"cell_type":"heading","source":"Library structure","level":2},{"metadata":{},"cell_type":"markdown","source":"* `Ops` - interface for basic mathematical operations.\n* `Poly, Matrix` - polynomial and matrix operations\n* `Galois` - galois field arithmetic operations, including extension fields\n* `Rs` - high level Reed-Solomon CODEC implementation"},{"metadata":{},"cell_type":"heading","source":"Using the library","level":2},{"metadata":{},"input":"#require \"reedsolomon,iocaml.notebook\"","cell_type":"code","prompt_number":1,"outputs":[{"output_type":"stream","text":"\tCamlp4 Parsing version 4.01.0\n\n","stream":"stdout"},{"output_type":"stream","text":"/home/andyman/.opam/4.01.0-test/lib/reedsolomon: added to search path\n/home/andyman/.opam/4.01.0-test/lib/reedsolomon/reedsolomon.cma: loaded\n","stream":"stderr"},{"output_type":"stream","text":"/home/andyman/.opam/4.01.0-test/lib/iocaml: added to search path\n","stream":"stderr"}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"markdown","source":"The `Rs` module defines a few pre-built standards. For now we will use `BBCTest` which describes the RS code from this excellent [whitepaper](http://www.bbc.co.uk/rd/publications/whitepaper031)."},{"metadata":{},"input":"module X = Rs.BBCTest","cell_type":"code","prompt_number":2,"outputs":[{"output_type":"pyout","prompt_number":2,"html":"module X :\n sig\n module Gp : sig val pp : int val pe : int end\n module G :\n sig\n type t = int\n val zero : t\n val one : t\n val ( +: ) : t -> t -> t\n val ( -: ) : t -> t -> t\n val to_string : t -> string\n val alpha : t\n val n_elems : int\n val log : t -> int\n val antilog : int -> t\n val ( *: ) : t -> t -> t\n val ( /: ) : t -> t -> t\n val ( **: ) : t -> int -> t\n val inv : t -> t\n end\n module Rp : sig val k : int val t : int val b : int end\n module R :\n sig\n type elt = int\n module M :\n sig\n type t = elt\n type matrix = t array array\n val rows : matrix -> int\n val cols : matrix -> int\n val init : int -> int -> (int -> int -> t) -> matrix\n val create : int -> int -> matrix\n val copy : matrix -> matrix\n val identity : int -> matrix\n val transpose : matrix -> matrix\n val map : (t -> t) -> matrix -> matrix\n val map2 : (t -> t -> t) -> matrix -> matrix -> matrix\n val row_vector : t array -> matrix\n val col_vector : t array -> matrix\n val ( >> ) : matrix -> matrix -> matrix\n val ( ^^ ) : matrix -> matrix -> matrix\n val sub : int -> int -> int -> int -> matrix -> matrix\n val ( +: ) : matrix -> matrix -> matrix\n val ( -: ) : matrix -> matrix -> matrix\n val ( *: ) : matrix -> matrix -> matrix\n val ( *:. ) : matrix -> t -> matrix\n val minor : int -> int -> matrix -> matrix\n val det : matrix -> t\n val adjoint_inverse : matrix -> t * matrix\n val gauss_jordan : matrix -> matrix\n val gauss_jordan_inverse : matrix -> matrix\n module Row :\n sig\n val swap : int -> int -> int -> matrix\n val mult : int -> int -> t -> matrix\n val madd : int -> int -> int -> t -> matrix\n end\n end\n module R :\n sig\n type elt = elt\n type t = elt array\n val degree : t -> int\n val zero : t\n val one : t\n val x : t\n val to_poly : elt array -> t\n val of_poly : t -> elt array\n val copy : t -> t\n type poly_format =\n Rs.BBCTest.R.R.poly_format = {\n coef : elt -> string;\n indet : int -> string;\n }\n val poly_format : poly_format\n val string_format : bool -> poly_format -> int -> elt -> string\n val to_string :\n ?down:bool -> ?str:(int -> elt -> string) -> t -> string\n val trim : t -> t\n val slice : t -> int -> t\n val ( +: ) : t -> t -> t\n val ( -: ) : t -> t -> t\n val ( *: ) : t -> t -> t\n val ( /: ) : t -> t -> t * t\n val ( *:. ) : t -> elt -> t\n val ( /:. ) : t -> elt -> t\n val ( ^: ) : t -> int -> t\n val ( **: ) : t -> int -> t\n val ext_gcd : t -> t -> t * t\n val eval : t -> elt -> elt\n end\n type poly = R.t\n type loc = int\n val root : int -> elt\n val generator : poly\n val xn : int -> poly\n val x2t : poly\n val parity : poly -> poly\n val encode : poly -> poly\n val horner : poly -> elt -> elt\n val syndromes : poly -> poly\n val key_equations : poly -> int -> M.matrix * M.matrix\n val solve_key_equations : M.matrix * M.matrix -> M.matrix\n val peterson : poly -> poly\n val euclid_inner : poly * poly -> poly * poly -> poly * poly\n val euclid : ?norm:bool -> ?lim:int -> poly -> poly * poly\n val berlekamp_massey_iter :\n poly -> int -> poly * poly * int -> poly * poly * int\n val berlekamp_massey : poly -> poly\n module Sarwate :\n sig\n val iBM : poly -> poly\n val riBM : poly -> poly * poly\n val rriBM : poly -> poly * poly\n val forney : poly -> poly -> loc -> elt\n end\n val chien : poly -> loc list\n val error_location : loc -> int\n val error_magnitude : int -> poly -> poly -> poly\n val deriv : poly -> poly\n val forney : poly -> poly -> loc -> elt\n val error : elt list -> loc list -> poly\n val correct : poly -> poly -> poly\n val decode_euclid : poly -> poly\n val decode_berlekamp_massey : poly -> poly\n val decode_peterson : poly -> poly\n val decode : poly -> poly\n val erasure_locator : int list -> poly\n val zero_erasures : poly -> int list -> poly\n val error_and_erasure :\n elt list -> loc list -> elt list -> loc list -> poly\n val decode_erasures_euclid : poly -> int list -> poly\n val decode_erasures : poly -> int list -> poly\n val decode_errors_and_erasures_euclid : poly -> int list -> poly\n val decode_errors_and_erasures_berlekamp_massey :\n poly -> int list -> poly\n val decode_errors_and_erasures : poly -> int list -> poly\n end\n end\n","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"markdown","source":"There are 4 modules defined therein;\n\n* `Gp` - parameters for the Galois field\n* `G` - Galois field implementation\n* `Rp` - parameters for the RS CODEC\n* `R` - Reed-Solomon CODEC implemention\n\nLets look at some of those parameters."},{"metadata":{},"input":"let pp, pe = X.Gp.pp, X.Gp.pe","cell_type":"code","prompt_number":3,"outputs":[{"output_type":"pyout","prompt_number":3,"html":"val pp : int = 19\nval pe : int = 2\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"markdown","source":"* pp - primtive polynomial of galois field\n* pe - primtive element of galois field"},{"metadata":{},"input":"let k, t = X.Rp.k, X.Rp.t\nlet n = k + (2*t)","cell_type":"code","prompt_number":4,"outputs":[{"output_type":"pyout","prompt_number":4,"html":"val k : int = 11\nval t : int = 2\n
","metadata":{}},{"output_type":"pyout","prompt_number":4,"html":"val n : int = 15\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"markdown","source":"* `k` - number of symbols in a message\n* `t` - error correction capability\n* `n` - code word size"},{"metadata":{},"cell_type":"heading","source":"Galois field elements","level":2},{"metadata":{},"input":"let number_of_field_elements = X.G.n_elems","cell_type":"code","prompt_number":5,"outputs":[{"output_type":"pyout","prompt_number":5,"html":"val number_of_field_elements : int = 16\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"markdown","source":"This tells us something about the Galois field - specifically that it has 16 elements. They are represented by integers in the range 0 to 15.\n\nWe can do arithmetic operations over the field using the functions in `X.G`. "},{"metadata":{},"input":"(* utility function to display a html table *)\nlet table rows cols f =\n let tag x s = \"<\" ^ x ^ \">\" ^ s ^ \"\" in\n let concat x s = s |> Array.map (tag x) |> Array.to_list |> String.concat \"\" in\n let init n x f = Array.init n f |> concat x in\n Iocaml.display \"text/html\" \n (\"\" ^ (init rows \"tr\" (fun row -> init cols \"td\" (f row))) ^ \"
\")","cell_type":"code","prompt_number":6,"outputs":[{"output_type":"pyout","prompt_number":6,"html":"val table : int -> int -> (int -> int -> string) -> unit = <fun>\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"input":"table 16 16 (fun i j -> X.G.(to_string (i +: j)))","cell_type":"code","prompt_number":7,"outputs":[{"output_type":"display_data","html":"| 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
| 1 | 0 | 3 | 2 | 5 | 4 | 7 | 6 | 9 | 8 | 11 | 10 | 13 | 12 | 15 | 14 |
| 2 | 3 | 0 | 1 | 6 | 7 | 4 | 5 | 10 | 11 | 8 | 9 | 14 | 15 | 12 | 13 |
| 3 | 2 | 1 | 0 | 7 | 6 | 5 | 4 | 11 | 10 | 9 | 8 | 15 | 14 | 13 | 12 |
| 4 | 5 | 6 | 7 | 0 | 1 | 2 | 3 | 12 | 13 | 14 | 15 | 8 | 9 | 10 | 11 |
| 5 | 4 | 7 | 6 | 1 | 0 | 3 | 2 | 13 | 12 | 15 | 14 | 9 | 8 | 11 | 10 |
| 6 | 7 | 4 | 5 | 2 | 3 | 0 | 1 | 14 | 15 | 12 | 13 | 10 | 11 | 8 | 9 |
| 7 | 6 | 5 | 4 | 3 | 2 | 1 | 0 | 15 | 14 | 13 | 12 | 11 | 10 | 9 | 8 |
| 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 |
| 9 | 8 | 11 | 10 | 13 | 12 | 15 | 14 | 1 | 0 | 3 | 2 | 5 | 4 | 7 | 6 |
| 10 | 11 | 8 | 9 | 14 | 15 | 12 | 13 | 2 | 3 | 0 | 1 | 6 | 7 | 4 | 5 |
| 11 | 10 | 9 | 8 | 15 | 14 | 13 | 12 | 3 | 2 | 1 | 0 | 7 | 6 | 5 | 4 |
| 12 | 13 | 14 | 15 | 8 | 9 | 10 | 11 | 4 | 5 | 6 | 7 | 0 | 1 | 2 | 3 |
| 13 | 12 | 15 | 14 | 9 | 8 | 11 | 10 | 5 | 4 | 7 | 6 | 1 | 0 | 3 | 2 |
| 14 | 15 | 12 | 13 | 10 | 11 | 8 | 9 | 6 | 7 | 4 | 5 | 2 | 3 | 0 | 1 |
| 15 | 14 | 13 | 12 | 11 | 10 | 9 | 8 | 7 | 6 | 5 | 4 | 3 | 2 | 1 | 0 |
","metadata":{}},{"output_type":"pyout","prompt_number":7,"html":"- : unit = ()\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"input":"table 16 16 (fun i j -> X.G.(to_string (i *: j)))","cell_type":"code","prompt_number":8,"outputs":[{"output_type":"display_data","html":"| 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
| 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | 11 | 12 | 13 | 14 | 15 |
| 0 | 2 | 4 | 6 | 8 | 10 | 12 | 14 | 3 | 1 | 7 | 5 | 11 | 9 | 15 | 13 |
| 0 | 3 | 6 | 5 | 12 | 15 | 10 | 9 | 11 | 8 | 13 | 14 | 7 | 4 | 1 | 2 |
| 0 | 4 | 8 | 12 | 3 | 7 | 11 | 15 | 6 | 2 | 14 | 10 | 5 | 1 | 13 | 9 |
| 0 | 5 | 10 | 15 | 7 | 2 | 13 | 8 | 14 | 11 | 4 | 1 | 9 | 12 | 3 | 6 |
| 0 | 6 | 12 | 10 | 11 | 13 | 7 | 1 | 5 | 3 | 9 | 15 | 14 | 8 | 2 | 4 |
| 0 | 7 | 14 | 9 | 15 | 8 | 1 | 6 | 13 | 10 | 3 | 4 | 2 | 5 | 12 | 11 |
| 0 | 8 | 3 | 11 | 6 | 14 | 5 | 13 | 12 | 4 | 15 | 7 | 10 | 2 | 9 | 1 |
| 0 | 9 | 1 | 8 | 2 | 11 | 3 | 10 | 4 | 13 | 5 | 12 | 6 | 15 | 7 | 14 |
| 0 | 10 | 7 | 13 | 14 | 4 | 9 | 3 | 15 | 5 | 8 | 2 | 1 | 11 | 6 | 12 |
| 0 | 11 | 5 | 14 | 10 | 1 | 15 | 4 | 7 | 12 | 2 | 9 | 13 | 6 | 8 | 3 |
| 0 | 12 | 11 | 7 | 5 | 9 | 14 | 2 | 10 | 6 | 1 | 13 | 15 | 3 | 4 | 8 |
| 0 | 13 | 9 | 4 | 1 | 12 | 8 | 5 | 2 | 15 | 11 | 6 | 3 | 14 | 10 | 7 |
| 0 | 14 | 15 | 1 | 13 | 3 | 2 | 12 | 9 | 7 | 6 | 8 | 4 | 10 | 11 | 5 |
| 0 | 15 | 13 | 2 | 9 | 6 | 4 | 11 | 1 | 14 | 12 | 3 | 8 | 7 | 5 | 10 |
","metadata":{}},{"output_type":"pyout","prompt_number":8,"html":"- : unit = ()\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"input":"table 1 16 (fun _ i -> X.G.(to_string (inv i)))","cell_type":"code","prompt_number":9,"outputs":[{"output_type":"display_data","html":"","metadata":{}},{"output_type":"pyout","prompt_number":9,"html":"- : unit = ()\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"heading","source":"Polynomials","level":2},{"metadata":{},"cell_type":"markdown","source":"The `Poly` module represents polynomials as arrays of coefficients. The coefficient type is generic and provided as an argument to the Poly.Make functor.\n\nThe indices of the array give the power of the indeterminate. For example"},{"metadata":{},"input":"module IPoly = Poly.Make(Ops.Int)","cell_type":"code","prompt_number":10,"outputs":[{"output_type":"pyout","prompt_number":10,"html":"module IPoly :\n sig\n type elt = Ops.Int.t\n type t = Ops.Int.t array\n val degree : t -> int\n val zero : t\n val one : t\n val x : t\n val to_poly : elt array -> t\n val of_poly : t -> elt array\n val copy : t -> t\n type poly_format =\n Poly.Make(Ops.Int).poly_format = {\n coef : elt -> string;\n indet : int -> string;\n }\n val poly_format : poly_format\n val string_format : bool -> poly_format -> int -> elt -> string\n val to_string : ?down:bool -> ?str:(int -> elt -> string) -> t -> string\n val trim : t -> t\n val slice : t -> int -> t\n val ( +: ) : t -> t -> t\n val ( -: ) : t -> t -> t\n val ( *: ) : t -> t -> t\n val ( /: ) : t -> t -> t * t\n val ( *:. ) : t -> elt -> t\n val ( /:. ) : t -> elt -> t\n val ( ^: ) : t -> int -> t\n val ( **: ) : t -> int -> t\n val ext_gcd : t -> t -> t * t\n val eval : t -> elt -> elt\n end\n","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"input":"(* display poly *)\nlet display_poly poly = \n (* modifiy printing a little to suit mathjax *)\n let str = X.R.R.(string_format true \n { poly_format with \n indet = function 0 -> \"\" | 1 -> \"x\" | _ as n -> \"x^{\" ^ string_of_int n ^ \"}\"; }) in\n Iocaml.display \"text/html\" (\"$$\" ^ X.R.R.to_string ~str:str poly ^ \"$$\")","cell_type":"code","prompt_number":11,"outputs":[{"output_type":"pyout","prompt_number":11,"html":"val display_poly : X.R.R.t -> unit = <fun>\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"input":"let f,g = [| 7; 3 |], [| 4; 0; 2 |]","cell_type":"code","prompt_number":12,"outputs":[{"output_type":"pyout","prompt_number":12,"html":"val f : int array = [|7; 3|]\nval g : int array = [|4; 0; 2|]\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"input":"display_poly f;;\ndisplay_poly g;;","cell_type":"code","prompt_number":13,"outputs":[{"output_type":"display_data","html":"$$3.x + 7$$","metadata":{}},{"output_type":"display_data","html":"$$2.x^{2} + 4$$","metadata":{}},{"output_type":"pyout","prompt_number":13,"html":"- : unit = ()\n
","metadata":{}},{"output_type":"pyout","prompt_number":13,"html":"- : unit = ()\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"input":"display_poly IPoly.(f *: g)","cell_type":"code","prompt_number":14,"outputs":[{"output_type":"display_data","html":"$$6.x^{3} + 14.x^{2} + 12.x + 28$$","metadata":{}},{"output_type":"pyout","prompt_number":14,"html":"- : unit = ()\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"heading","source":"More on Galois fields","level":2},{"metadata":{},"cell_type":"markdown","source":"The `Galois` module is actually quite general and can implement the fields in different ways. Indeed the integer representation above is actually derived from a lower level version based on polynomials over GF2."},{"metadata":{},"input":"table 2 2 (fun i j -> Galois.Primitive.GF2.(to_string (i +: j)));;\ntable 2 2 (fun i j -> Galois.Primitive.GF2.(to_string (i *: j)));;","cell_type":"code","prompt_number":15,"outputs":[{"output_type":"display_data","html":"","metadata":{}},{"output_type":"display_data","html":"","metadata":{}},{"output_type":"pyout","prompt_number":15,"html":"- : unit = ()\n
","metadata":{}},{"output_type":"pyout","prompt_number":15,"html":"- : unit = ()\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"input":"module GFPoly = Galois.Extension.Make(struct \n module Poly = Poly.Make(Galois.Primitive.GF2)\n let pp = [| 1; 1; 0; 0; 1 |]\nend)","cell_type":"code","prompt_number":16,"outputs":[{"output_type":"pyout","prompt_number":16,"html":"module GFPoly :\n sig\n type t = Galois.Primitive.GF2.t array\n val zero : t\n val one : t\n val ( +: ) : t -> t -> t\n val ( -: ) : t -> t -> t\n val ( *: ) : t -> t -> t\n val ( /: ) : t -> t -> t\n val to_string : t -> string\n end\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"markdown","source":"Using this representation we can see the underlying structure of $GF(2^4)$ fields as polynomials."},{"metadata":{},"input":"let x : GFPoly.t = [|0; 1; 0; 0|]","cell_type":"code","prompt_number":17,"outputs":[{"output_type":"pyout","prompt_number":17,"html":"val x : GFPoly.t = [|0; 1; 0; 0|]\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"input":"GFPoly.to_string x","cell_type":"code","prompt_number":18,"outputs":[{"output_type":"pyout","prompt_number":18,"html":"- : string = "x"\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"input":"GFPoly.(to_string (x *: x))","cell_type":"code","prompt_number":19,"outputs":[{"output_type":"pyout","prompt_number":19,"html":"- : string = "x^2"\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"input":"let rec pow = GFPoly.(function\n | 0 -> one\n | 1 -> x\n | _ as n -> x *: pow (n-1))","cell_type":"code","prompt_number":20,"outputs":[{"output_type":"pyout","prompt_number":20,"html":"val pow : int -> GFPoly.t = <fun>\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"input":"table 15 3 (fun i -> function \n | 0 -> \"$x^{\" ^ string_of_int i ^ \"}$\"\n | 1 -> \"$\" ^ GFPoly.to_string (pow i) ^ \"$\"\n | _ -> X.G.(to_string (X.Gp.pe **: i)))","cell_type":"code","prompt_number":21,"outputs":[{"output_type":"display_data","html":"| $x^{0}$ | $1$ | 1 |
| $x^{1}$ | $x$ | 2 |
| $x^{2}$ | $x^2$ | 4 |
| $x^{3}$ | $x^3$ | 8 |
| $x^{4}$ | $x + 1$ | 3 |
| $x^{5}$ | $x^2 + x$ | 6 |
| $x^{6}$ | $x^3 + x^2$ | 12 |
| $x^{7}$ | $x^3 + x + 1$ | 11 |
| $x^{8}$ | $x^2 + 1$ | 5 |
| $x^{9}$ | $x^3 + x$ | 10 |
| $x^{10}$ | $x^2 + x + 1$ | 7 |
| $x^{11}$ | $x^3 + x^2 + x$ | 14 |
| $x^{12}$ | $x^3 + x^2 + x + 1$ | 15 |
| $x^{13}$ | $x^3 + x^2 + 1$ | 13 |
| $x^{14}$ | $x^3 + 1$ | 9 |
","metadata":{}},{"output_type":"pyout","prompt_number":21,"html":"- : unit = ()\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"heading","source":"Encoding","level":2},{"metadata":{},"cell_type":"markdown","source":"The encoding process takes a **message** of **k** symbols and produces a **codeword** of **n** symbols."},{"metadata":{},"input":"let message = [| 11; 10; 9; 8; 7; 6; 5; 4; 3; 2; 1 |]\nlet () = display_poly message","cell_type":"code","prompt_number":22,"outputs":[{"output_type":"display_data","html":"$$x^{10} + 2.x^{9} + 3.x^{8} + 4.x^{7} + 5.x^{6} + 6.x^{5} + 7.x^{4} + 8.x^{3} + 9.x^{2} + 10.x + 11$$","metadata":{}},{"output_type":"pyout","prompt_number":22,"html":"val message : int array = [|11; 10; 9; 8; 7; 6; 5; 4; 3; 2; 1|]\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"input":"let codeword = X.R.encode message\nlet () = display_poly codeword","cell_type":"code","prompt_number":23,"outputs":[{"output_type":"display_data","html":"$$x^{14} + 2.x^{13} + 3.x^{12} + 4.x^{11} + 5.x^{10} + 6.x^{9} + 7.x^{8} + 8.x^{7} + 9.x^{6} + 10.x^{5} + 11.x^{4} + 3.x^{3} + 3.x^{2} + 12.x + 12$$","metadata":{}},{"output_type":"pyout","prompt_number":23,"html":"val codeword : X.R.poly = [|12; 12; 3; 3; 11; 10; 9; 8; 7; 6; 5; 4; 3; 2; 1|]\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"markdown","source":"The encoding process is rather simple \n\n$$codeword = message.x^{2t} + (message.x^{2t} \\mod generator)$$\n\nWe can implement it in a few lines of polynomial arithmetic."},{"metadata":{},"input":"let myencode message = \n let open X.R.R in\n let (%:) a b = snd (a /: b) in (* mod; the remainder of division *)\n let message = message *: (x **: (2*t)) in (* shift message *)\n message +: (message %: X.R.generator)","cell_type":"code","prompt_number":24,"outputs":[{"output_type":"pyout","prompt_number":24,"html":"val myencode : X.R.R.t -> X.R.R.t = <fun>\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"input":"let mycodeword = myencode message\nlet () = display_poly mycodeword","cell_type":"code","prompt_number":25,"outputs":[{"output_type":"display_data","html":"$$x^{14} + 2.x^{13} + 3.x^{12} + 4.x^{11} + 5.x^{10} + 6.x^{9} + 7.x^{8} + 8.x^{7} + 9.x^{6} + 10.x^{5} + 11.x^{4} + 3.x^{3} + 3.x^{2} + 12.x + 12$$","metadata":{}},{"output_type":"pyout","prompt_number":25,"html":"val mycodeword : X.R.R.t =\n [|12; 12; 3; 3; 11; 10; 9; 8; 7; 6; 5; 4; 3; 2; 1|]\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"markdown","source":"It is worth noting that the RS encoder is systematic - that is the orginal message is included in the code word. The symbols added by the encoder are known as parity symbols."},{"metadata":{},"cell_type":"heading","source":"Errors","level":2},{"metadata":{},"cell_type":"markdown","source":"During transmission or storage the codeword may become corrupted by some errors.\n\n$$received = codeword + errors$$\n\nIt is the purpose of the Reed-Solomon decoder to calculate the error polynomial from the received polynomial then\n\n$$corrected = received - errors$$\n\nFor a codeword with $2t$ parity symbols the Reed-Solomon decoder will be able to correct upto $t$ symbol errors."},{"metadata":{},"input":"let error = [| 0; 0; 2; 0; 0; 0; 0; 0; 0; 13; 0; 0; 0; 0; 0 |]\nlet () = display_poly error","cell_type":"code","prompt_number":26,"outputs":[{"output_type":"display_data","html":"$$13.x^{9} + 2.x^{2}$$","metadata":{}},{"output_type":"pyout","prompt_number":26,"html":"val error : int array = [|0; 0; 2; 0; 0; 0; 0; 0; 0; 13; 0; 0; 0; 0; 0|]\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"input":"let received = X.R.R.(codeword +: error)\nlet () = display_poly received","cell_type":"code","prompt_number":27,"outputs":[{"output_type":"display_data","html":"$$x^{14} + 2.x^{13} + 3.x^{12} + 4.x^{11} + 5.x^{10} + 11.x^{9} + 7.x^{8} + 8.x^{7} + 9.x^{6} + 10.x^{5} + 11.x^{4} + 3.x^{3} + x^{2} + 12.x + 12$$","metadata":{}},{"output_type":"pyout","prompt_number":27,"html":"val received : X.R.R.t = [|12; 12; 1; 3; 11; 10; 9; 8; 7; 11; 5; 4; 3; 2; 1|]\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"heading","source":"Decoding","level":2},{"metadata":{},"cell_type":"markdown","source":"We start by running the decoder on our example."},{"metadata":{},"input":"let corrected = X.R.decode received\nlet () = display_poly corrected\nlet okay = corrected = codeword","cell_type":"code","prompt_number":28,"outputs":[{"output_type":"display_data","html":"$$x^{14} + 2.x^{13} + 3.x^{12} + 4.x^{11} + 5.x^{10} + 6.x^{9} + 7.x^{8} + 8.x^{7} + 9.x^{6} + 10.x^{5} + 11.x^{4} + 3.x^{3} + 3.x^{2} + 12.x + 12$$","metadata":{}},{"output_type":"pyout","prompt_number":28,"html":"val corrected : X.R.poly =\n [|12; 12; 3; 3; 11; 10; 9; 8; 7; 6; 5; 4; 3; 2; 1|]\n
","metadata":{}},{"output_type":"pyout","prompt_number":28,"html":"val okay : bool = true\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"markdown","source":"As we see the decoder has taken the (corrupt) received poly and recovered the original codeword.\n\nAlthough I shall avoid a technical description of the maths involved in decoding (if you're interested check out that BBC white paper), I will show how the decoder is put together from the functions in the `Rs` module.\n\nThe first step is to calculate the syndrome vector. This is done by evalulating the received polynomial (here we use horners method) at each of the roots of the generator polynomial (of which there are $2t$)."},{"metadata":{},"input":"let syndromes = Array.init (2*t) X.R.(fun i -> horner received (root i))","cell_type":"code","prompt_number":29,"outputs":[{"output_type":"pyout","prompt_number":29,"html":"val syndromes : X.R.elt array = [|15; 3; 4; 12|]\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"markdown","source":"Because the roots of the generator are also the roots of the codeword, if any of these values are non-zero then we know there are errors to be corrected, as is the case here.\n\nWe now have a choice on how we will solve the key equations - Petersons' method (matrix inversion), Berlekamp-Massey (black magic) or Euclids algorithm (polynomial factorisation). We'll choose the later as it's easiest to understand, though implementations of all methods are provided. From the syndromes this will produce the error locator and error evaluator polynomials."},{"metadata":{},"input":"let v, l = X.R.euclid syndromes","cell_type":"code","prompt_number":30,"outputs":[{"output_type":"pyout","prompt_number":30,"html":"val v : X.R.poly = [|14; 3|]\nval l : X.R.poly = [|9; 7; 7|]\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"markdown","source":"Chien search finds the error locations."},{"metadata":{},"input":"let el = X.R.chien l\nlet el' = List.map X.R.error_location el (* compute actual locations *)","cell_type":"code","prompt_number":31,"outputs":[{"output_type":"pyout","prompt_number":31,"html":"val el : X.R.loc list = [6; 13]\n
","metadata":{}},{"output_type":"pyout","prompt_number":31,"html":"val el' : int list = [9; 2]\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"markdown","source":"Forneys algorithm solves for the error values."},{"metadata":{},"input":"let ev = List.map (X.R.forney v l) el","cell_type":"code","prompt_number":32,"outputs":[{"output_type":"pyout","prompt_number":32,"html":"val ev : X.R.elt list = [13; 2]\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"markdown","source":"Using `el` and `ev` we form the error polynomial"},{"metadata":{},"input":"let e = X.R.error ev el","cell_type":"code","prompt_number":33,"outputs":[{"output_type":"pyout","prompt_number":33,"html":"val e : X.R.poly = [|0; 0; 2; 0; 0; 0; 0; 0; 0; 13|]\n
","metadata":{}}],"language":"python","collapsed":false},{"metadata":{},"cell_type":"markdown","source":"And finally it can be added to the received polynomial to form the corrected polynomial."},{"metadata":{},"input":"let corrected = X.R.R.(received +: e)\nlet () = display_poly corrected","cell_type":"code","prompt_number":34,"outputs":[{"output_type":"display_data","html":"$$x^{14} + 2.x^{13} + 3.x^{12} + 4.x^{11} + 5.x^{10} + 6.x^{9} + 7.x^{8} + 8.x^{7} + 9.x^{6} + 10.x^{5} + 11.x^{4} + 3.x^{3} + 3.x^{2} + 12.x + 12$$","metadata":{}},{"output_type":"pyout","prompt_number":34,"html":"val corrected : X.R.R.t = [|12; 12; 3; 3; 11; 10; 9; 8; 7; 6; 5; 4; 3; 2; 1|]\n
","metadata":{}}],"language":"python","collapsed":false}],"metadata":{}}],"nbformat":3,"nbformat_minor":0}
--------------------------------------------------------------------------------
/reedsolomon.opam:
--------------------------------------------------------------------------------
1 | opam-version: "2.0"
2 | name: "reedsolomon"
3 | maintainer: "Andy Ray "
4 | authors: "Andy Ray "
5 | homepage: "https://github.com/ujamjar/reedsolomon"
6 | bug-reports: "https://github.com/ujamjar/reedsolomon/issues"
7 | dev-repo: "git+https://github.com/ujamjar/reedsolomon.git"
8 | doc: "https://github.com/ujamjar/reedsolomon"
9 | license: "MIT"
10 | synopsis: "Reed-Solomon Error Correction CODEC"
11 | description: "Reed-Solomon Error Coorection CODEC libaray."
12 |
13 | build: [
14 | ["dune" "build" "-p" name "-j" jobs]
15 | ]
16 |
17 | depends: [
18 | "ocaml" {>= "4.02.0"}
19 | "dune" {build}
20 | ]
21 | url {
22 | src: "https://github.com/ujamjar/reedsolomon/archive/v0.3.tar.gz"
23 | checksum: "md5=d59a4bf6c65ec034e39685bad037eb4f"
24 | }
25 |
--------------------------------------------------------------------------------
/src/codec.ml:
--------------------------------------------------------------------------------
1 | (*
2 | * reedsolomon - error correction CODEC
3 | *
4 | * (c) 2014 MicroJamJar Ltd
5 | *
6 | * Author(s): andy.ray@ujamjar.com
7 | * Description:
8 | *
9 | *)
10 |
11 | module type RsParams =
12 | sig
13 | val k : int
14 | val t : int
15 | val b : int
16 | end
17 |
18 | module type RsPoly = sig
19 |
20 | type elt
21 |
22 | module M : (Matrix.S with type t = elt)
23 | module R : (Poly.S with type t = elt array and type elt = elt)
24 |
25 | type poly = R.t
26 | type loc = int
27 |
28 | val root : int -> elt
29 | val generator : poly
30 | val xn : int -> poly
31 | val x2t : poly
32 | val parity : poly -> poly
33 | val encode : poly -> poly
34 |
35 | val horner : poly -> elt -> elt
36 | val syndromes : poly -> poly
37 |
38 | val key_equations : poly -> int -> M.matrix * M.matrix
39 | val solve_key_equations : M.matrix * M.matrix -> M.matrix
40 | val peterson : poly -> poly
41 |
42 | val euclid_inner : (poly * poly) -> (poly * poly) -> (poly * poly)
43 | val euclid : ?norm:bool -> ?lim:int -> poly -> poly * poly
44 |
45 | val berlekamp_massey_iter :
46 | poly -> int -> (poly * poly * int) -> (poly * poly * int)
47 | val berlekamp_massey : poly -> poly
48 |
49 | module Sarwate : sig
50 | val iBM : poly -> poly
51 | val riBM : poly -> poly * poly
52 | val rriBM : poly -> poly * poly
53 | val forney : poly -> poly -> (loc -> elt)
54 | end
55 |
56 | val chien : poly -> loc list
57 | val error_location : loc -> int
58 |
59 | val error_magnitude : int -> poly -> poly -> poly
60 | val deriv : poly -> poly
61 | val forney : poly -> poly -> (loc -> elt)
62 |
63 | val error : elt list -> loc list -> poly
64 |
65 | val correct : poly -> poly -> poly
66 |
67 | val decode_euclid : poly -> poly
68 | val decode_berlekamp_massey : poly -> poly
69 | val decode_peterson : poly -> poly
70 | val decode : poly -> poly
71 |
72 | val erasure_locator : int list -> poly
73 | val zero_erasures : poly -> int list -> poly
74 | val error_and_erasure : elt list -> loc list -> elt list -> loc list -> poly
75 |
76 | val decode_erasures_euclid : poly -> int list -> poly
77 | val decode_erasures : poly -> int list -> poly
78 |
79 | val decode_errors_and_erasures_euclid : poly -> int list -> poly
80 | (*val decode_errors_and_erasures_berlekamp_massey : poly -> int list -> poly*)
81 | val decode_errors_and_erasures : poly -> int list -> poly
82 | end
83 |
84 | module MakePoly(G : Galois.Table.Ops)(P : RsParams) = struct
85 |
86 | type elt = G.t
87 |
88 | module M = Matrix.Make(G)
89 | module R = Poly.Make(G)
90 |
91 | type poly = R.t
92 | type loc = int
93 |
94 | let root i = G.(alpha **: (P.b + i))
95 |
96 | let generator =
97 | let roots =
98 | Array.init (2*P.t)
99 | (fun i -> [| root i; G.one |])
100 | in
101 | List.fold_left (fun p' p -> R.(p' *: p)) R.one (Array.to_list roots)
102 |
103 | let xn n = R.(one ^: n)
104 |
105 | let x2t = xn (2 * P.t)
106 |
107 | let parity d = R.(snd ((d *: x2t) /: generator))
108 |
109 | let encode d = R.(trim ((d *: x2t) +: parity d))
110 |
111 | let horner p a =
112 | let p = List.rev (Array.to_list p) in
113 | List.fold_left G.(fun acc x -> (acc *: a) +: x) G.zero p
114 |
115 | let syndromes r = Array.init (2*P.t) (fun i -> horner r (root i))
116 |
117 | let key_equations s v =
118 | M.init v v (fun r c -> s.(v-(c+1)+r)),
119 | M.init v 1 (fun r c -> s.(v+r))
120 |
121 | (* K.L = S => K^-1.S = L, iff det(S) <> 0 *)
122 | let solve_key_equations (k,s) =
123 | let k' = M.gauss_jordan_inverse k in
124 | M.(k' *: s)
125 |
126 | let peterson s =
127 | let rec p v =
128 | if v = 0 then R.zero
129 | else
130 | let km, kv = key_equations s v in
131 | (* rather than check the determinant (which is VERY slow),
132 | * invert the matrix, then check it actually worked *)
133 | let km' = M.gauss_jordan_inverse km in
134 | if M.(km' *: km = identity v) then
135 | let v = M.(km' *: kv) in
136 | Array.init (M.rows v + 1) (fun i ->
137 | if i=0 then G.one else v.(i-1).(0))
138 | else
139 | p (v-1)
140 | in
141 | p P.t
142 |
143 | let euclid_inner (r0,r1) (s0,s1) =
144 | let q,r = R.(r1 /: r0) in
145 | let s = R.(s1 -: (q *: s0)) in
146 | r, s
147 |
148 | (* calculate error locator and value polys using extended gcd *)
149 | let euclid ?(norm=false) ?(lim=P.t) s =
150 | let open R in
151 | let rec f (r0,r1) (s0,s1) =
152 | if degree r0 < lim then r0,s0
153 | else
154 | let r, s = euclid_inner (r0,r1) (s0,s1) in
155 | f (r,r0) (s,s0)
156 | in
157 | let v, l = f (R.trim s,x2t) (one,zero) in
158 | if norm then
159 | let inv' = G.( one /: l.(0) ) in
160 | Array.map G.(( *: ) inv') v,
161 | Array.map G.(( *: ) inv') l
162 | else
163 | v, l
164 |
165 | let berlekamp_massey_iter s k (n,c,l) =
166 | let get a n = if n >= Array.length a then G.zero else a.(n) in
167 | let rec e i v =
168 | if i>l then v else e (i+1) G.(v +: (get n i *: get s (k-1-i)))
169 | in
170 | let e = e 1 s.(k-1) in
171 | let n, c, l =
172 | if e = G.zero then
173 | n,c,l
174 | else
175 | let n' = R.(n +: (c *:. e)) in
176 | let c, l =
177 | if 2*l < k then R.(n /:. e), k-l else c, l
178 | in
179 | n', c, l
180 | in
181 | n, R.(c ^: 1), l
182 |
183 | (* calculate error locator poly using the berlekamp-massey algorithm *)
184 | let berlekamp_massey s =
185 | let one, x = R.(one, one ^: 1) in
186 | let rec f k (n,c,l as x) =
187 | if k > 2*P.t then n
188 | else
189 | let x = berlekamp_massey_iter s k x in
190 | f (k+1) x
191 | in
192 | f 1 (one, x, 0)
193 |
194 | let deriv l =
195 | (* set even powers to 0 *)
196 | let l = Array.init (Array.length l) (fun i ->
197 | if i mod 2 = 0 then G.zero else l.(i)) in
198 | (* divide by x *)
199 | Array.init (Array.length l - 1) (fun i -> l.(i+1))
200 |
201 | module Sarwate = struct
202 |
203 | let t = P.t
204 |
205 | let get a i =
206 | if i < 0 then G.zero
207 | else if i >= Array.length a then G.zero
208 | else a.(i)
209 | let foldi f z n =
210 | let acc = ref z in
211 | for i=0 to n-1 do
212 | acc := f !acc i
213 | done;
214 | !acc
215 | let iteri a f =
216 | for i=0 to Array.length a - 1 do
217 | a.(i) <- f i
218 | done
219 | let copy t f =
220 | for i=0 to Array.length t - 1 do
221 | t.(i) <- f.(i)
222 | done
223 | let shiftup a b =
224 | for i=Array.length a - 1 downto 0 do
225 | a.(i) <- get a (i-1)
226 | done
227 | let shiftdown a b =
228 | for i=0 to Array.length a - 1 do
229 | a.(i) <- get b (i+1)
230 | done
231 |
232 | let iBM =
233 | let z,o = G.zero, G.one in
234 | let lambda = Array.make (t+1) z in
235 | let lambda' = Array.make (t+1) z in
236 | let b = Array.make (t+1) z in
237 | let k = ref 0 in
238 | let gamma = ref o in
239 | let delta = ref z in
240 |
241 | let init () =
242 | let f i = if i=0 then o else z in
243 | iteri lambda f;
244 | iteri b f;
245 | k := 0;
246 | gamma := o;
247 | delta := z;
248 | in
249 |
250 | let iter s =
251 | let update_delta r d i = G.(d +: (get s (r-i) *: lambda.(i))) in
252 | let update_lambda i =
253 | G.((!gamma *: lambda.(i)) -: (!delta *: get b (i-1)))
254 | in
255 | for r=0 to 2*t-1 do
256 | (* step 1 *)
257 | delta := foldi (update_delta r) z (t+1);
258 | (* step 2 *)
259 | copy lambda' lambda;
260 | iteri lambda update_lambda;
261 | (* step 3 *)
262 | if !delta <> z && !k >= 0 then begin
263 | copy b lambda'; (* previous lambda *)
264 | gamma := !delta;
265 | k := - !k - 1
266 | end else begin
267 | shiftup b b;
268 | gamma := !gamma;
269 | k := !k + 1
270 | end;
271 | done
272 | (* XXX step 4 *)
273 | in
274 |
275 | (fun s ->
276 | init ();
277 | iter s;
278 | Array.init (t+1) (fun i -> lambda.(i)))
279 |
280 | let riBM =
281 | let z,o = G.zero, G.one in
282 | let lambda = Array.make (t+1) z in
283 | let lambda' = Array.make (t+1) z in
284 | let b = Array.make (t+1) z in
285 | let delta = Array.make (2*t) z in
286 | let delta' = Array.make (2*t) z in
287 | let theta = Array.make (2*t) z in
288 | let gamma = ref o in
289 | let k = ref 0 in
290 |
291 | let init s =
292 | let f i = if i=0 then o else z in
293 | iteri lambda f;
294 | iteri b f;
295 | copy delta s;
296 | copy theta s;
297 | gamma := o;
298 | k := 0;
299 | in
300 |
301 | let iter () =
302 | let update_lambda i =
303 | G.((!gamma *: lambda.(i)) -: (delta'.(0) *: get b (i-1)))
304 | in
305 | let update_delta i =
306 | G.((!gamma *: get delta' (i+1)) -: (delta'.(0) *: theta.(i)))
307 | in
308 | for r=0 to 2*t-1 do
309 | (* step 1 *)
310 | copy lambda' lambda;
311 | copy delta' delta;
312 | iteri lambda update_lambda;
313 | iteri delta update_delta;
314 | (* step 2 *)
315 | if delta'.(0) <> z && !k >= 0 then begin
316 | copy b lambda'; (* previous lambda *)
317 | shiftdown theta delta';
318 | gamma := delta'.(0);
319 | k := - !k - 1
320 | end else begin
321 | shiftup b b;
322 | (*copy theta theta;
323 | gamma := !gamma;*)
324 | k := !k + 1
325 | end;
326 | done
327 | in
328 |
329 | (fun s ->
330 | init s;
331 | iter ();
332 | Array.init t (fun i -> delta.(i)),
333 | Array.init (t+1) (fun i -> lambda.(i)))
334 |
335 | let rriBM =
336 | let z,o = G.zero, G.one in
337 | let delta = Array.make (3*t+1) z in
338 | let delta' = Array.make (3*t+1) z in
339 | let theta = Array.make (3*t+1) z in
340 | let gamma = ref o in
341 | let k = ref 0 in
342 |
343 | let init s =
344 | let f i =
345 | if i<2*t then s.(i)
346 | else if i=3*t then o
347 | else z
348 | in
349 | iteri delta f;
350 | copy theta delta;
351 | gamma := o;
352 | k := 0;
353 | in
354 |
355 | let iter () =
356 | let update_delta i =
357 | G.((!gamma *: get delta' (i+1)) -: (delta'.(0) *: theta.(i)))
358 | in
359 | for i=0 to 2*t-1 do
360 | (* step 1 *)
361 | copy delta' delta;
362 | iteri delta update_delta;
363 | (* step 2 *)
364 | if delta'.(0) <> z && !k >= 0 then begin
365 | shiftdown theta delta';
366 | gamma := delta'.(0);
367 | k := - !k - 1
368 | end else begin
369 | (*copy theta theta;
370 | gamma := !gamma;*)
371 | k := !k + 1
372 | end;
373 | done
374 | in
375 |
376 | (fun s ->
377 | init s;
378 | iter ();
379 | Array.init t (fun i -> delta.(i)),
380 | Array.init (t+1) (fun i -> delta.(t+i)))
381 |
382 | let forney v l =
383 | let l' = deriv l in
384 | (fun x' ->
385 | let x' = G.antilog x' in
386 | let x = G.(x' **: (P.b+(2*P.t)-1)) in
387 | G.(x *: (horner v x' /: horner l' x')))
388 |
389 | end
390 |
391 | let chien l =
392 | let rec f n =
393 | if n = (G.n_elems-1) then []
394 | else
395 | if horner l (G.antilog n) = G.zero then
396 | n :: f (n+1)
397 | else
398 | f (n+1)
399 | in
400 | f 0
401 |
402 | let error_location n = G.(log (inv (antilog n)))
403 |
404 | let error_magnitude v l s =
405 | let get a n = if n >= Array.length a then G.zero else a.(n) in
406 | Array.init v (fun i ->
407 | let a = Array.init (i+1) (fun j -> G.(get s j *: get l (i-j))) in
408 | Array.fold_left G.(+:) G.zero a)
409 |
410 | let forney v l =
411 | let l' = deriv l in
412 | (fun x' ->
413 | let x' = G.antilog x' in
414 | let x = G.(x' **: (P.b-1)) in
415 | G.(x *: (horner v x' /: horner l' x')))
416 |
417 | let error v l =
418 | let x = List.map2 (fun a b -> error_location a,b) l v in
419 | let n = P.k + P.t*2 in
420 | R.to_poly (Array.init n (fun i -> try List.assoc i x with _ -> G.zero))
421 |
422 | let correct r e = R.(r +: e)
423 |
424 | (* error correction *)
425 |
426 | let decode_euclid r =
427 | let s = syndromes r in
428 | if Array.fold_left (fun b s -> b && s = G.zero) true s then r
429 | else
430 | let v, l = euclid s in
431 | let el = chien l in
432 | let ev = List.map (forney v l) el in
433 | let e = error ev el in
434 | correct r e
435 |
436 | let decode_berlekamp_massey r =
437 | let s = syndromes r in
438 | if Array.fold_left (fun b s -> b && s = G.zero) true s then r
439 | else
440 | let l = berlekamp_massey s in
441 | let el = chien l in
442 | let v = error_magnitude (List.length el) l s in
443 | let ev = List.map (forney v l) el in
444 | let e = error ev el in
445 | correct r e
446 |
447 | let decode_peterson r =
448 | let s = syndromes r in
449 | if Array.fold_left (fun b s -> b && s = G.zero) true s then r
450 | else
451 | let l = peterson s in
452 | let el = chien l in
453 | let v = error_magnitude (List.length el) l s in
454 | let ev = List.map (forney v l) el in
455 | let e = error ev el in
456 | correct r e
457 |
458 | let decode = decode_euclid
459 |
460 | (* erasure correction *)
461 |
462 | let erasure_locator y =
463 | let terms = List.map (fun y -> [| G.one; G.(alpha **: y) |]) y in
464 | List.fold_left (fun a x -> R.(a *: x)) R.one terms
465 |
466 | let zero_erasures r y =
467 | let r = Array.copy r in
468 | List.iter (fun y -> r.(y) <- G.zero) y;
469 | r
470 |
471 | let error_and_erasure ev el fv fl =
472 | let e = List.map2 (fun a b -> error_location a,b) el ev in
473 | let f = List.map2 (fun a b -> a,b) fl fv in
474 | let x = e @ f in
475 | let n = P.k + P.t*2 in
476 | R.to_poly (Array.init n (fun i -> try List.assoc i x with _ -> G.zero))
477 |
478 |
479 | let decode_erasures_euclid r y =
480 | if y = [] then r
481 | else
482 | let f = List.length y in
483 | let tau = erasure_locator y in
484 | let r = zero_erasures r y in
485 | let s = syndromes r in
486 | let xi = R.(slice (tau *: s) (2*P.t-1)) in
487 | let omega, lambda = euclid ~norm:true ~lim:(P.t + (f / 2) + 0) xi in
488 | let phi = R.(tau *: lambda) in
489 | let forney = forney omega phi in
490 | let fv = List.map forney
491 | (List.map (fun y -> G.(log (inv (alpha **: y)))) y)
492 | in
493 | let e = error_and_erasure [] [] fv y in
494 | correct r e
495 |
496 | let decode_erasures = decode_erasures_euclid
497 |
498 | let decode_errors_and_erasures_euclid r y =
499 | let f = List.length y in
500 | let tau = erasure_locator y in
501 | let r = zero_erasures r y in
502 | let s = syndromes r in
503 | let xi = R.(slice (tau *: s) (2*P.t-1)) in
504 | let omega, lambda = euclid ~norm:true ~lim:(P.t + (f / 2) + 0) xi in
505 | let el = chien lambda in
506 | let phi = R.(tau *: lambda) in
507 | let forney = forney omega phi in
508 | let ev = List.map forney el in
509 | let fv = List.map forney
510 | (List.map (fun y -> G.(log (inv (alpha **: y)))) y)
511 | in
512 | let e = error_and_erasure ev el fv y in
513 | correct r e
514 |
515 | let decode_errors_and_erasures_berlekamp_massey r y =
516 | (*let f = List.length y in*)
517 | let tau = erasure_locator y in
518 | let r = zero_erasures r y in
519 | let s = syndromes r in
520 | let xi = R.(slice (tau *: s) (2*P.t-1)) in
521 | (*let omega, lambda = euclid ~norm:true ~lim:(P.t + (f / 2) + 0) xi in*)
522 |
523 | let lambda = berlekamp_massey xi in
524 | let omega = R.(slice (lambda *: xi) (2*P.t-1)) in
525 |
526 | let el = chien lambda in
527 | let phi = R.(tau *: lambda) in
528 | let forney = forney omega phi in
529 | let ev = List.map forney el in
530 | let fv = List.map forney
531 | (List.map (fun y -> G.(log (inv (alpha **: y)))) y)
532 | in
533 | let e = error_and_erasure ev el fv y in
534 | correct r e
535 |
536 | let decode_errors_and_erasures = decode_errors_and_erasures_euclid
537 |
538 | end
539 |
540 | module type Standard = sig
541 | module Gp : Galois.Table.Params
542 | module G : Galois.Table.Ops with type t = int
543 | module Rp : RsParams
544 | module R : RsPoly with type elt = int
545 | end
546 |
547 | module MakeStandard(Gp : Galois.Table.Params)(Rp : RsParams) = struct
548 | module Gp = Gp
549 | module G = Galois.Table.MakeInt(Gp)
550 | module Rp = Rp
551 | module R = MakePoly(G)(Rp)
552 | end
553 |
554 | module BBCTest = MakeStandard
555 | (struct
556 | let pp = 19
557 | let pe = 2
558 | end)
559 | (struct
560 | let t = 2
561 | let k = 15 - (2*t)
562 | let b = 0
563 | end)
564 |
565 | module CCSDS = struct
566 |
567 | let dual_of_poly = [|
568 | 0x00;0x7b;0xaf;0xd4;0x99;0xe2;0x36;0x4d;
569 | 0xfa;0x81;0x55;0x2e;0x63;0x18;0xcc;0xb7;
570 | 0x86;0xfd;0x29;0x52;0x1f;0x64;0xb0;0xcb;
571 | 0x7c;0x07;0xd3;0xa8;0xe5;0x9e;0x4a;0x31;
572 | 0xec;0x97;0x43;0x38;0x75;0x0e;0xda;0xa1;
573 | 0x16;0x6d;0xb9;0xc2;0x8f;0xf4;0x20;0x5b;
574 | 0x6a;0x11;0xc5;0xbe;0xf3;0x88;0x5c;0x27;
575 | 0x90;0xeb;0x3f;0x44;0x09;0x72;0xa6;0xdd;
576 | 0xef;0x94;0x40;0x3b;0x76;0x0d;0xd9;0xa2;
577 | 0x15;0x6e;0xba;0xc1;0x8c;0xf7;0x23;0x58;
578 | 0x69;0x12;0xc6;0xbd;0xf0;0x8b;0x5f;0x24;
579 | 0x93;0xe8;0x3c;0x47;0x0a;0x71;0xa5;0xde;
580 | 0x03;0x78;0xac;0xd7;0x9a;0xe1;0x35;0x4e;
581 | 0xf9;0x82;0x56;0x2d;0x60;0x1b;0xcf;0xb4;
582 | 0x85;0xfe;0x2a;0x51;0x1c;0x67;0xb3;0xc8;
583 | 0x7f;0x04;0xd0;0xab;0xe6;0x9d;0x49;0x32;
584 | 0x8d;0xf6;0x22;0x59;0x14;0x6f;0xbb;0xc0;
585 | 0x77;0x0c;0xd8;0xa3;0xee;0x95;0x41;0x3a;
586 | 0x0b;0x70;0xa4;0xdf;0x92;0xe9;0x3d;0x46;
587 | 0xf1;0x8a;0x5e;0x25;0x68;0x13;0xc7;0xbc;
588 | 0x61;0x1a;0xce;0xb5;0xf8;0x83;0x57;0x2c;
589 | 0x9b;0xe0;0x34;0x4f;0x02;0x79;0xad;0xd6;
590 | 0xe7;0x9c;0x48;0x33;0x7e;0x05;0xd1;0xaa;
591 | 0x1d;0x66;0xb2;0xc9;0x84;0xff;0x2b;0x50;
592 | 0x62;0x19;0xcd;0xb6;0xfb;0x80;0x54;0x2f;
593 | 0x98;0xe3;0x37;0x4c;0x01;0x7a;0xae;0xd5;
594 | 0xe4;0x9f;0x4b;0x30;0x7d;0x06;0xd2;0xa9;
595 | 0x1e;0x65;0xb1;0xca;0x87;0xfc;0x28;0x53;
596 | 0x8e;0xf5;0x21;0x5a;0x17;0x6c;0xb8;0xc3;
597 | 0x74;0x0f;0xdb;0xa0;0xed;0x96;0x42;0x39;
598 | 0x08;0x73;0xa7;0xdc;0x91;0xea;0x3e;0x45;
599 | 0xf2;0x89;0x5d;0x26;0x6b;0x10;0xc4;0xbf;
600 | |]
601 |
602 | let poly_of_dual = [|
603 | 0x00;0xcc;0xac;0x60;0x79;0xb5;0xd5;0x19;
604 | 0xf0;0x3c;0x5c;0x90;0x89;0x45;0x25;0xe9;
605 | 0xfd;0x31;0x51;0x9d;0x84;0x48;0x28;0xe4;
606 | 0x0d;0xc1;0xa1;0x6d;0x74;0xb8;0xd8;0x14;
607 | 0x2e;0xe2;0x82;0x4e;0x57;0x9b;0xfb;0x37;
608 | 0xde;0x12;0x72;0xbe;0xa7;0x6b;0x0b;0xc7;
609 | 0xd3;0x1f;0x7f;0xb3;0xaa;0x66;0x06;0xca;
610 | 0x23;0xef;0x8f;0x43;0x5a;0x96;0xf6;0x3a;
611 | 0x42;0x8e;0xee;0x22;0x3b;0xf7;0x97;0x5b;
612 | 0xb2;0x7e;0x1e;0xd2;0xcb;0x07;0x67;0xab;
613 | 0xbf;0x73;0x13;0xdf;0xc6;0x0a;0x6a;0xa6;
614 | 0x4f;0x83;0xe3;0x2f;0x36;0xfa;0x9a;0x56;
615 | 0x6c;0xa0;0xc0;0x0c;0x15;0xd9;0xb9;0x75;
616 | 0x9c;0x50;0x30;0xfc;0xe5;0x29;0x49;0x85;
617 | 0x91;0x5d;0x3d;0xf1;0xe8;0x24;0x44;0x88;
618 | 0x61;0xad;0xcd;0x01;0x18;0xd4;0xb4;0x78;
619 | 0xc5;0x09;0x69;0xa5;0xbc;0x70;0x10;0xdc;
620 | 0x35;0xf9;0x99;0x55;0x4c;0x80;0xe0;0x2c;
621 | 0x38;0xf4;0x94;0x58;0x41;0x8d;0xed;0x21;
622 | 0xc8;0x04;0x64;0xa8;0xb1;0x7d;0x1d;0xd1;
623 | 0xeb;0x27;0x47;0x8b;0x92;0x5e;0x3e;0xf2;
624 | 0x1b;0xd7;0xb7;0x7b;0x62;0xae;0xce;0x02;
625 | 0x16;0xda;0xba;0x76;0x6f;0xa3;0xc3;0x0f;
626 | 0xe6;0x2a;0x4a;0x86;0x9f;0x53;0x33;0xff;
627 | 0x87;0x4b;0x2b;0xe7;0xfe;0x32;0x52;0x9e;
628 | 0x77;0xbb;0xdb;0x17;0x0e;0xc2;0xa2;0x6e;
629 | 0x7a;0xb6;0xd6;0x1a;0x03;0xcf;0xaf;0x63;
630 | 0x8a;0x46;0x26;0xea;0xf3;0x3f;0x5f;0x93;
631 | 0xa9;0x65;0x05;0xc9;0xd0;0x1c;0x7c;0xb0;
632 | 0x59;0x95;0xf5;0x39;0x20;0xec;0x8c;0x40;
633 | 0x54;0x98;0xf8;0x34;0x2d;0xe1;0x81;0x4d;
634 | 0xa4;0x68;0x08;0xc4;0xdd;0x11;0x71;0xbd;
635 | |]
636 |
637 | module Gp = struct
638 | let pp = 391
639 | let pe = 173
640 | end
641 |
642 | module Rs16' = MakeStandard(Gp)(struct
643 | let t = 16
644 | let k = 255-(2*t)
645 | let b = 128-t
646 | end)
647 |
648 | module Rs8' = MakeStandard(Gp)(struct
649 | let t = 8
650 | let k = 255-(2*t)
651 | let b = 128-t
652 | end)
653 |
654 | let dop = Array.map (Array.get dual_of_poly)
655 | let pod = Array.map (Array.get poly_of_dual)
656 | let (>>) f g x = g (f x)
657 |
658 | module Map(S : Standard) = struct
659 | module Gp = S.Gp
660 | module G = S.G
661 | module Rp = S.Rp
662 | module R = struct
663 | include S.R
664 | let parity = pod >> parity >> dop
665 | let encode = pod >> encode >> dop
666 | let decode = pod >> decode >> dop
667 | end
668 | end
669 |
670 | module Rs16 = Map(Rs16')
671 | module Rs8 = Map(Rs8')
672 |
673 | end
674 |
675 | module DVB = MakeStandard
676 | (struct
677 | let pp = 285
678 | let pe = 2
679 | end)
680 | (struct
681 | let t = 8
682 | let k = 188
683 | let b = 0
684 | end)
685 |
686 | module ATSC = MakeStandard
687 | (struct
688 | let pp = 285
689 | let pe = 2
690 | end)
691 | (struct
692 | let t = 10
693 | let k = 187
694 | let b = 0
695 | end)
696 |
697 | module G709 = MakeStandard
698 | (struct
699 | let pp = 285
700 | let pe = 2
701 | end)
702 | (struct
703 | let t = 8
704 | let k = 239
705 | let b = 0
706 | end)
707 |
708 |
--------------------------------------------------------------------------------
/src/codec.mli:
--------------------------------------------------------------------------------
1 | (*
2 | * reedsolomon - error correction CODEC
3 | *
4 | * (c) 2014 MicroJamJar Ltd
5 | *
6 | * Author(s): andy.ray@ujamjar.com
7 | * Description:
8 | *
9 | *)
10 |
11 | (** Configuration of a Reed-Solomon code *)
12 | module type RsParams =
13 | sig
14 | val k : int
15 | val t : int
16 | val b : int
17 | end
18 |
19 | (** RS encoding and decoding *)
20 | module type RsPoly = sig
21 |
22 | type elt
23 |
24 | module M : (Matrix.S with type t = elt)
25 | module R : (Poly.S with type t = elt array and type elt = elt)
26 |
27 | type poly = R.t
28 | type loc = int
29 |
30 | val root : int -> elt
31 | val generator : poly
32 | val xn : int -> poly
33 | val x2t : poly
34 | val parity : poly -> poly
35 | val encode : poly -> poly
36 |
37 | val horner : poly -> elt -> elt
38 | val syndromes : poly -> poly
39 |
40 | val key_equations : poly -> int -> M.matrix * M.matrix
41 | val solve_key_equations : M.matrix * M.matrix -> M.matrix
42 | val peterson : poly -> poly
43 |
44 | val euclid_inner : (poly * poly) -> (poly * poly) -> (poly * poly)
45 | val euclid : ?norm:bool -> ?lim:int -> poly -> poly * poly
46 |
47 | val berlekamp_massey_iter :
48 | poly -> int -> (poly * poly * int) -> (poly * poly * int)
49 | val berlekamp_massey : poly -> poly
50 |
51 | (** inversionless berlekamp massey algorithms.
52 |
53 | Based on the paper "High-speed architectures for
54 | Reed-Solomon decoders" Dilip V Sarwate, Naresh R Shanbhag *)
55 | module Sarwate : sig
56 | val iBM : poly -> poly
57 | val riBM : poly -> poly * poly
58 | val rriBM : poly -> poly * poly
59 | val forney : poly -> poly -> (loc -> elt)
60 | end
61 |
62 | val chien : poly -> loc list
63 | val error_location : loc -> int
64 |
65 | val error_magnitude : int -> poly -> poly -> poly
66 | val deriv : poly -> poly
67 | val forney : poly -> poly -> (loc -> elt)
68 |
69 | val error : elt list -> loc list -> poly
70 |
71 | val correct : poly -> poly -> poly
72 |
73 | val decode_euclid : poly -> poly
74 | val decode_berlekamp_massey : poly -> poly
75 | val decode_peterson : poly -> poly
76 | val decode : poly -> poly
77 |
78 | val erasure_locator : int list -> poly
79 | val zero_erasures : poly -> int list -> poly
80 | val error_and_erasure : elt list -> loc list -> elt list -> loc list -> poly
81 |
82 | val decode_erasures_euclid : poly -> int list -> poly
83 | val decode_erasures : poly -> int list -> poly
84 |
85 | val decode_errors_and_erasures_euclid : poly -> int list -> poly
86 | (* erasure decoding not working with berlekamp massey *)
87 | (*val decode_errors_and_erasures_berlekamp_massey : poly -> int list -> poly*)
88 | val decode_errors_and_erasures : poly -> int list -> poly
89 | end
90 |
91 | (** Create a Reed-Solomon code based on the given Galois field and code parameters *)
92 | module MakePoly(G : Galois.Table.Ops)(P : RsParams) :
93 | (RsPoly with type elt = G.t)
94 |
95 | (* some example RS CODECs in use *)
96 |
97 | module type Standard = sig
98 | module Gp : Galois.Table.Params
99 | module G : Galois.Table.Ops with type t = int
100 | module Rp : RsParams
101 | module R : RsPoly with type elt = int
102 | end
103 |
104 | module MakeStandard(Gp : Galois.Table.Params)(Rp : RsParams) : Standard
105 |
106 | (** Test code used in BBC white paper *)
107 | module BBCTest : Standard
108 |
109 | (** Consultative Committee for Space Data Systems *)
110 | module CCSDS : sig
111 | val dual_of_poly : int array
112 | val poly_of_dual : int array
113 | (** t=16 *)
114 | module Rs16 : Standard
115 | (** t=8 *)
116 | module Rs8 : Standard
117 | end
118 |
119 | (** Digital Video Broadcasting *)
120 | module DVB : Standard
121 |
122 | (** Advanced Television Systems Committee *)
123 | module ATSC : Standard
124 |
125 | (** Interfaces for the Optical Transport Network *)
126 | module G709 : Standard
127 |
128 |
129 |
--------------------------------------------------------------------------------
/src/dune:
--------------------------------------------------------------------------------
1 | (library
2 | (name reedsolomon)
3 | (flags (:standard -w -27-32-33-35-39-50))
4 | (public_name reedsolomon))
5 |
6 |
--------------------------------------------------------------------------------
/src/galois.ml:
--------------------------------------------------------------------------------
1 | (*
2 | * reedsolomon - error correction CODEC
3 | *
4 | * (c) 2014 MicroJamJar Ltd
5 | *
6 | * Author(s): andy.ray@ujamjar.com
7 | * Description:
8 | *
9 | *)
10 |
11 | module Primitive = struct
12 |
13 | module type GF_n = sig
14 | val n : int
15 | end
16 |
17 | (* GF(n) primitive finite field *)
18 | module GFN(GF_n : GF_n) = struct
19 | open GF_n
20 |
21 | type t = int
22 | let zero = 0
23 | let one = 1
24 | let (+:) a b = (a + b) mod n
25 | let (-:) a b = (a - b + n) mod n
26 | let ( *: ) a b = (a * b) mod n
27 |
28 | (* this builds a potentially huge table to construct
29 | * inverses. we could also use the ext_gcd algorithm.
30 | * see poly.ml *)
31 | let inv =
32 | let rec find x v =
33 | if v=0 then 0
34 | else if x=n then failwith "couldn't find inverse"
35 | else if v *: x = 1 then v
36 | else find (x+1) v
37 | in
38 | Array.init n (find 0)
39 |
40 | let ( /: ) a b = a *: inv.(b)
41 |
42 | let to_string = string_of_int
43 | end
44 |
45 | (* GF(2) *)
46 | module GF2 = struct
47 | type t = int
48 | let zero = 0
49 | let one = 1
50 | let (+:) = (lxor)
51 | let (-:) = (lxor)
52 | let ( *: ) = (land)
53 | let ( /: ) a b = a
54 | let to_string = string_of_int
55 | end
56 |
57 | end
58 |
59 | (* GF extension fields built from primitive fields and polynomials *)
60 | module Extension = struct
61 |
62 | module type Generator = sig
63 | (* polynomial with primitive field coefficients *)
64 | module Poly : Poly.S
65 | (* primitive polynomial *)
66 | val pp : Poly.t
67 | end
68 |
69 | module Make(G : Generator) = struct
70 | type t = G.Poly.t
71 | let zero = G.Poly.zero
72 | let one = G.Poly.one
73 | let (+:) = G.Poly.(+:)
74 | let (-:) = G.Poly.(-:)
75 | let ( *: ) a b = snd (G.Poly.((a *: b) /: G.pp))
76 | let ( /: ) a b =
77 | let _,b' = G.Poly.ext_gcd G.pp b in
78 | a *: b'
79 |
80 | let to_string = G.Poly.to_string ~down:true ~str:G.Poly.(string_format true poly_format)
81 | end
82 |
83 | end
84 |
85 | module GF2N = struct
86 |
87 | module Make(P : sig val pp : int array end) = Extension.Make(struct
88 | module Poly = Poly.Make(Primitive.GF2)
89 | let pp = P.pp
90 | end)
91 |
92 | (* list of primitive polynomials for various GF(2) extension fields *)
93 | let gf2_prim_polys =
94 | let mk_poly pp =
95 | Array.init (1 + (List.fold_left (fun a v -> max a v) 0 pp))
96 | (fun i -> if List.mem i pp then 1 else 0)
97 | in
98 | Array.map mk_poly
99 | [|
100 | []; (* 0 to 2 we dont have primitive polys listed *)
101 | [];
102 | [0;1;2]; (* wasnt in the table, but appears to be correct. *)
103 | [0;1;3];
104 | [0;1;4];
105 | [0;2;5];
106 | [0;1;6];
107 | [0;3;7];
108 | [0;2;3;4;8];
109 | [0;4;9];
110 | [0;3;10];
111 | [0;2;11];
112 | [0;1;4;6;12];
113 | [0;1;3;4;13];
114 | [0;1;6;10;14];
115 | [0;1;15];
116 | [0;1;3;12;16];
117 | [0;3;17];
118 | [0;7;18];
119 | [0;1;2;5;19];
120 | [0;3;20];
121 | [0;2;21];
122 | [0;1;22];
123 | [0;5;23];
124 | [0;1;2;7;24];
125 | |]
126 |
127 | end
128 |
129 | module Table = struct
130 |
131 | module type Generator = sig
132 | module Ops : Ops.OpsBase
133 | (* primitive element *)
134 | val alpha : Ops.t
135 | end
136 |
137 | module type Ops = sig
138 | include Ops.OpsBase
139 | val alpha : t
140 |
141 | val n_elems : int
142 |
143 | val log : t -> int
144 | val antilog : int -> t
145 |
146 | val ( *: ) : t -> t -> t
147 | val ( /: ) : t -> t -> t
148 | val ( **: ) : t -> int -> t
149 |
150 | val inv : t -> t
151 | end
152 |
153 | module Make(G : Generator) = struct
154 | include G.Ops
155 |
156 | module PM = Map.Make(struct
157 | type t = G.Ops.t
158 | let compare = compare
159 | end)
160 | module IM = Map.Make(struct
161 | type t = int
162 | let compare = compare
163 | end)
164 |
165 | let alpha = G.alpha
166 |
167 | (* map poly to corresponding power of alpha *)
168 | let pow_map =
169 | let rec f a n map =
170 | (* element already in map, so we are done *)
171 | try let _ = PM.find a map in map
172 | with
173 | (* add power to map *)
174 | | Not_found -> f (a *: alpha) (n+1) (PM.add a n map)
175 | (* some other problem *)
176 | | _ -> failwith "log_map exception"
177 | in
178 | f alpha 1 (PM.add one 0 PM.empty)
179 |
180 | (* map power of alpha to poly *)
181 | let ipow_map =
182 | PM.fold (fun k v m -> IM.add v k m) pow_map IM.empty
183 |
184 | let n_elems = PM.cardinal pow_map + 1
185 |
186 | let log a = PM.find a pow_map
187 | let antilog a = IM.find a ipow_map
188 |
189 | let ( *: ) a b =
190 | if a=zero || b = zero then zero
191 | else
192 | let a, b = log a, log b in
193 | antilog ((a+b) mod (n_elems-1))
194 |
195 | let (/:) a b =
196 | if a = zero || b = zero then zero
197 | (*else if b = zero then failwith "divide by zero"*)
198 | else
199 | let a, b = log a, log b in
200 | antilog ((a-b+n_elems-1) mod (n_elems-1))
201 |
202 | let inv a =
203 | if a = zero then zero (* cant invert *)
204 | else
205 | let a = log a in
206 | antilog ((n_elems-1-a) mod (n_elems-1))
207 |
208 | let rec ( **: ) a n =
209 | if a = zero then zero
210 | else if n < 0 then
211 | (inv a) **: (-n)
212 | else
213 | let a = log a in
214 | antilog ((a*n) mod (n_elems-1))
215 |
216 | end
217 |
218 | module Int(Ops : (Ops with type t = int array)) = struct
219 |
220 | type t = int
221 | let zero = 0
222 | let one = 1
223 | let (+:) = (lxor)
224 | let (-:) = (lxor)
225 | let to_string = string_of_int
226 |
227 | let n_elems = Ops.n_elems
228 |
229 | let to_int x =
230 | fst (List.fold_left
231 | (fun (a,p) x -> x*p+a,p*2) (0,1) (Array.to_list x))
232 |
233 | let to_poly x =
234 | let rec f v =
235 | if v = 0 then []
236 | else if v land 1 = 1 then
237 | 1 :: f (v lsr 1)
238 | else
239 | 0 :: f (v lsr 1)
240 | in
241 | if x=0 then [|0|]
242 | else Array.of_list (f x)
243 |
244 | let alpha = to_int Ops.alpha
245 |
246 | let mk_table min max f =
247 | let len = max - min + 1 in
248 | let a = Array.init len (fun i -> f (i+min)) in
249 | (fun i -> a.(i - min))
250 |
251 | let rec index i =
252 | if i < 0 then index (i+n_elems-1)
253 | else i mod (n_elems-1)
254 |
255 | let log' i =
256 | if i=0 then 0 else Ops.log (to_poly i)
257 | let log = mk_table 0 (n_elems-1) log'
258 |
259 | let antilog' i' =
260 | let i = index i' in
261 | to_int (Ops.antilog i)
262 | let antilog = mk_table (2-n_elems) (2*(n_elems-2)+1) antilog'
263 |
264 | let inv a =
265 | if a = 0 then 0
266 | else
267 | let a = log a in
268 | antilog (n_elems-1-a)
269 |
270 | let ( *: ) a b =
271 | if a=zero || b = zero then zero
272 | else
273 | let a, b = log a, log b in
274 | antilog (a+b)
275 |
276 | let (/:) a b =
277 | if a = zero || b = zero then zero
278 | (*else if b = zero then failwith "divide by zero"*)
279 | else
280 | let a, b = log a, log b in
281 | antilog (a-b)
282 |
283 | let rec ( **: ) a n =
284 | if n = 0 then one
285 | else if a = zero then zero
286 | else
287 | let n = index (log a * n) in
288 | antilog n
289 |
290 | end
291 |
292 | module type Params = sig
293 | val pp : int
294 | val pe : int
295 | end
296 |
297 | module Params(P : Params) = struct
298 | let mk_gf_param x =
299 | let rec f x =
300 | if x = 0 then []
301 | else
302 | (if x land 1 = 0 then 0 else 1) :: f (x lsr 1)
303 | in
304 | Array.of_list (f x)
305 | module Ops = Extension.Make(struct
306 | module Poly = Poly.Make(Primitive.GF2)
307 | let pp = mk_gf_param P.pp
308 | end)
309 | let alpha = mk_gf_param P.pe
310 | end
311 |
312 | module MakeInt(P : Params) = Int(Make(Params(P)))
313 |
314 | end
315 |
316 |
--------------------------------------------------------------------------------
/src/galois.mli:
--------------------------------------------------------------------------------
1 | (*
2 | * reedsolomon - error correction CODEC
3 | *
4 | * (c) 2014 MicroJamJar Ltd
5 | *
6 | * Author(s): andy.ray@ujamjar.com
7 | * Description:
8 | *
9 | *)
10 |
11 | (* primitive fields of type GF(n) where n is prime *)
12 | module Primitive : sig
13 | module type GF_n = sig
14 | val n : int
15 | end
16 | (* GF(n) primitive finite field *)
17 | module GFN(GF_n : GF_n) : (Ops.OpsBase with type t = int)
18 | (* GF(2) *)
19 | module GF2 : (Ops.OpsBase with type t = int)
20 | end
21 |
22 | (* GF(n^m) extension fields built from primitive fields and polynomials *)
23 | module Extension : sig
24 |
25 | module type Generator = sig
26 | module Poly : Poly.S
27 | (** polynomial with primitive field coefficients *)
28 | val pp : Poly.t
29 | (** primitive polynomial *)
30 | end
31 |
32 | (** make extension field *)
33 | module Make(G : Generator) : (Ops.OpsBase with type t = G.Poly.t)
34 |
35 | end
36 |
37 | (** convenience module for building GF(2^n) fields *)
38 | module GF2N : sig
39 |
40 | module Make(P : sig val pp : int array end) :
41 | (Ops.OpsBase with type t = int array)
42 |
43 | val gf2_prim_polys : int array array
44 | (* list of primitive polys for GF(2); 3..24 *)
45 |
46 | end
47 |
48 | module Table : sig
49 |
50 | module type Generator = sig
51 | module Ops : Ops.OpsBase
52 | val alpha : Ops.t
53 | (* primitive element *)
54 | end
55 |
56 | module type Ops = sig
57 | include Ops.OpsBase
58 |
59 | val alpha : t
60 | (** primitive element *)
61 |
62 | val n_elems : int
63 | (** number of elements in field *)
64 |
65 | val log : t -> int
66 | (** log x = b when alpha^b = x *)
67 |
68 | val antilog : int -> t
69 | (** inverse log *)
70 |
71 | val ( *: ) : t -> t -> t
72 | (** multiplication *)
73 |
74 | val ( /: ) : t -> t -> t
75 | (** division *)
76 |
77 | val ( **: ) : t -> int -> t
78 | (** power *)
79 |
80 | val inv : t -> t
81 | (** inverse *)
82 | end
83 |
84 | (** builds log/antilog table representation over any field representation *)
85 | module Make(G : Generator) : (Ops with type t = G.Ops.t)
86 |
87 | (** specialised representation using integers *)
88 | module Int(Ops : (Ops with type t = int array)) : (Ops with type t = int)
89 |
90 | (** simplified field specification using integers *)
91 | module type Params = sig
92 | val pp : int
93 | (** primitive polynomial (including leading power) *)
94 |
95 | val pe : int
96 | (** primitive element *)
97 | end
98 |
99 | module Params(P : Params) : (Generator with type Ops.t = int array)
100 |
101 | module MakeInt(P : Params) : (Ops with type t = int)
102 |
103 |
104 | end
105 |
106 |
--------------------------------------------------------------------------------
/src/iter.ml:
--------------------------------------------------------------------------------
1 | (*
2 | * reedsolomon - error correction CODEC
3 | *
4 | * (c) 2014 MicroJamJar Ltd
5 | *
6 | * Author(s): andy.ray@ujamjar.com
7 | * Description:
8 | *
9 | *)
10 |
11 | type rsparams = {
12 | m : int; (* bits per symbol *)
13 | k : int; (* message symbols *)
14 | t : int; (* correction capability, 2t=parity symbols *)
15 | n : int; (* codeword symbols *)
16 | b : int; (* starting root of generator *)
17 | prim_poly : int; (* primitive polynomial *)
18 | prim_elt : int; (* primitive element *)
19 | }
20 |
21 | type rspoly = int array
22 |
23 | let rspoly n = Array.make n 0
24 |
25 | let to_string =
26 | Array.fold_left
27 | (fun s x -> s ^ " " ^ string_of_int x)
28 | ""
29 |
30 | type rscodec = {
31 | params : rsparams;
32 | encode : rspoly -> rspoly -> unit;
33 | decode : rspoly -> rspoly -> int;
34 | }
35 |
36 | let init p =
37 |
38 | (* generate the reference implementation *)
39 | let module Gp = struct
40 | let pp = p.prim_poly
41 | let pe = p.prim_elt
42 | end in
43 | let module Rp = struct
44 | let t = p.t
45 | let k = p.k
46 | let b = p.b
47 | end in
48 | let module R = Codec.MakeStandard(Gp)(Rp) in
49 | let module G = R.G in
50 |
51 | (* array utilities *)
52 | let len = Array.length in
53 | let clear (a: int array) = for i=0 to len a - 1 do a.(i) <- 0 done in
54 | let get (a: int array) i = if i < 0 then G.zero else if i >= len a then G.zero else a.(i) in
55 | let iteri (a: int array) (f : int -> int) = for i=0 to len a - 1 do a.(i) <- f i done in
56 | let copy (t: int array) (f:int array) = for i=0 to len t - 1 do t.(i) <- f.(i) done in
57 | let shiftup (a: int array) (b: int array) = for i=len a - 1 downto 0 do a.(i) <- get a (i-1) done in
58 | let shiftdown (a: int array) (b: int array) = for i=0 to len a - 1 do a.(i) <- get b (i+1) done in
59 |
60 | let encode =
61 | let t2 = 2 * p.t in
62 | let generator = Array.init t2 (fun i -> R.R.generator.(t2-i-1)) in
63 | (fun message parity ->
64 | let k = len message in
65 | clear parity;
66 | for j=0 to k - 1 do
67 | let s = R.G.( message.(j) +: parity.(0) ) in
68 | for i=0 to t2 - 2 do
69 | parity.(i) <- R.G.((s *: generator.(i)) +: parity.(i+1))
70 | done;
71 | parity.(t2-1) <- R.G.(s *: generator.(t2-1))
72 | done
73 | )
74 | in
75 |
76 | let decode =
77 | let t2 = 2 * p.t in
78 |
79 | (* roots of the generator polynomial *)
80 | let roots = Array.init t2 (fun i -> R.R.root i) in
81 |
82 | (* syndromes *)
83 | let syndromes = rspoly t2 in
84 |
85 | (* horners rule for polynomial evaluation *)
86 | let acc = ref G.zero in
87 | let horner a p =
88 | acc := G.zero;
89 | for i=0 to Array.length p - 1 do
90 | acc := G.( (!acc *: a) +: p.(i) )
91 | done;
92 | !acc
93 | in
94 |
95 | let rhorner a p =
96 | acc := G.zero;
97 | for i=Array.length p-1 downto 0 do
98 | acc := G.( (!acc *: a) +: p.(i) )
99 | done;
100 | !acc
101 | in
102 |
103 | (* inversion-less berlekamp-massy *)
104 | let riBM =
105 | let t = p.t in
106 | let z,o = G.zero, G.one in
107 | let lambda = Array.make (t+1) z in
108 | let lambda' = Array.make (t+1) z in
109 | let b = Array.make (t+1) z in
110 | let delta = Array.make (2*t) z in
111 | let delta' = Array.make (2*t) z in
112 | let theta = Array.make (2*t) z in
113 | let gamma = ref o in
114 | let k = ref 0 in
115 |
116 | let init s =
117 | let f i = if i=0 then o else z in
118 | iteri lambda f;
119 | iteri b f;
120 | copy delta s;
121 | copy theta s;
122 | gamma := o;
123 | k := 0;
124 | in
125 |
126 | let iter () =
127 | let update_lambda i =
128 | G.((!gamma *: lambda.(i)) -: (delta'.(0) *: get b (i-1)))
129 | in
130 | let update_delta i =
131 | G.((!gamma *: get delta' (i+1)) -: (delta'.(0) *: theta.(i)))
132 | in
133 | for r=0 to 2*t-1 do (* this is systolic, so much data is 0 during
134 | part of the iteration *)
135 | (* step 1 *)
136 | copy lambda' lambda;
137 | copy delta' delta;
138 | iteri lambda update_lambda;
139 | iteri delta update_delta;
140 | (* step 2 *)
141 | if delta'.(0) <> z && !k >= 0 then begin
142 | copy b lambda'; (* previous lambda *)
143 | shiftdown theta delta';
144 | gamma := delta'.(0);
145 | k := - !k - 1
146 | end else begin
147 | shiftup b b;
148 | k := !k + 1
149 | end;
150 | done
151 | in
152 |
153 | (fun s d l ->
154 | init s;
155 | iter ();
156 | for i=0 to t-1 do d.(i) <- delta.(i) done;
157 | for i=0 to t do l.(i) <- lambda.(i) done)
158 | in
159 |
160 | let delta = rspoly p.t in
161 | let lambda = rspoly (p.t+1) in
162 | let lambda' = rspoly ((p.t+1)/2) in
163 |
164 | (* chien search *)
165 | let error_locs = rspoly p.t in
166 | let n_errors = ref 0 in
167 | let chien () =
168 | for n=0 to p.n-1 do
169 | if rhorner (G.antilog n) lambda = G.zero then begin
170 | error_locs.(!n_errors) <- n;
171 | incr n_errors;
172 | end
173 | done
174 | in
175 |
176 | let deriv () =
177 | for i=0 to ((p.t+1)/2)-1 do
178 | lambda'.(i) <- lambda.((i*2)+1)
179 | done
180 | in
181 |
182 | (* forney *)
183 | let error_magnitudes = rspoly p.t in
184 | let forney () =
185 | for i=0 to !n_errors-1 do
186 | let x' = G.antilog error_locs.(i) in
187 | let x = G.(x' **: (p.b+t2-1)) in
188 | let x2 = G.(x' **: 2) in
189 | error_magnitudes.(i) <- G.(x *: (rhorner x' delta /: rhorner x2 lambda'))
190 | done
191 | in
192 |
193 | let correct c =
194 | for i=0 to !n_errors-1 do
195 | let loc = error_locs.(i) in
196 | let loc = if loc = 0 then p.n-1 else loc-1 in
197 | let mag = error_magnitudes.(i) in
198 | c.(loc) <- G.(c.(loc) +: mag)
199 | done
200 | in
201 |
202 | (*let dump a =
203 | let open Printf in
204 | for i=0 to Array.length a - 1 do
205 | printf "%i " a.(i)
206 | done;
207 | printf "\n"
208 | in*)
209 |
210 | let ssum = ref G.zero in
211 | (fun received corrected ->
212 | n_errors := 0;
213 | ssum := G.zero;
214 | for i=0 to t2-1 do
215 | syndromes.(i) <- horner roots.(i) received;
216 | ssum := !ssum lor syndromes.(i)
217 | done;
218 | for i=0 to p.n-1 do
219 | corrected.(i) <- received.(i)
220 | done;
221 | if !ssum <> 0 then begin
222 | riBM syndromes delta lambda;
223 | chien ();
224 | deriv ();
225 | forney ();
226 | correct corrected
227 | end;
228 | !n_errors)
229 | in
230 |
231 | { params=p; encode; decode }
232 |
233 |
234 |
--------------------------------------------------------------------------------
/src/iter.mli:
--------------------------------------------------------------------------------
1 | (*
2 | * reedsolomon - error correction CODEC
3 | *
4 | * (c) 2014 MicroJamJar Ltd
5 | *
6 | * Author(s): andy.ray@ujamjar.com
7 | * Description:
8 | *
9 | *)
10 |
11 | type rsparams = {
12 | m : int; (* bits per symbol *)
13 | k : int; (* message symbols *)
14 | t : int; (* correction capability, 2t=parity symbols *)
15 | n : int; (* codeword symbols *)
16 | b : int; (* starting root of generator *)
17 | prim_poly : int; (* primitive polynomial *)
18 | prim_elt : int; (* primitive element *)
19 | }
20 |
21 | type rspoly = int array
22 |
23 | val rspoly : int -> rspoly
24 |
25 | type rscodec = {
26 | params : rsparams;
27 | encode : rspoly -> rspoly -> unit;
28 | decode : rspoly -> rspoly -> int;
29 | }
30 |
31 | val init : rsparams -> rscodec
32 |
33 |
--------------------------------------------------------------------------------
/src/matrix.ml:
--------------------------------------------------------------------------------
1 | (*
2 | * reedsolomon - error correction CODEC
3 | *
4 | * (c) 2014 MicroJamJar Ltd
5 | *
6 | * Author(s): andy.ray@ujamjar.com
7 | * Description:
8 | *
9 | *)
10 |
11 | (* some simple matrix routines for addition, multiplication etc *)
12 |
13 | module type S = sig
14 |
15 | type t
16 | type matrix = t array array
17 |
18 | (* size of matrix *)
19 | val rows : matrix -> int
20 | val cols : matrix -> int
21 |
22 | (*val print : ?c:out_channel -> (t -> string) -> int -> matrix -> unit*)
23 |
24 | (* construction of various matrices *)
25 | val init : int -> int -> (int -> int -> t) -> matrix
26 | val create : int -> int -> matrix
27 | val copy : matrix -> matrix
28 | val identity : int -> matrix
29 | val transpose : matrix -> matrix
30 | val map : (t -> t) -> matrix -> matrix
31 | val map2 : (t -> t -> t) -> matrix -> matrix -> matrix
32 |
33 | val row_vector : t array -> matrix
34 | val col_vector : t array -> matrix
35 |
36 | (* concatenate matrices *)
37 | val (>>) : matrix -> matrix -> matrix
38 | val (^^) : matrix -> matrix -> matrix
39 |
40 | (* select a sub matrix *)
41 | val sub : int -> int -> int -> int -> matrix -> matrix
42 |
43 | (* arithmetic *)
44 | val (+:) : matrix -> matrix -> matrix
45 | val (-:) : matrix -> matrix -> matrix
46 | val ( *: ) : matrix -> matrix -> matrix
47 | val ( *:. ) : matrix -> t -> matrix
48 |
49 | (* functions related to inverses *)
50 | val minor : int -> int -> matrix -> matrix
51 | val det : matrix -> t
52 | val adjoint_inverse : matrix -> t * matrix
53 |
54 | (* these functions require element division *)
55 | val gauss_jordan : matrix -> matrix
56 | val gauss_jordan_inverse : matrix -> matrix
57 |
58 | module Row : sig
59 | val swap : int -> int -> int -> matrix
60 | val mult : int -> int -> t -> matrix
61 | val madd : int -> int -> int -> t -> matrix
62 | end
63 |
64 | end
65 |
66 | module Make(Ops : Ops.OpsBase) = struct
67 |
68 | type t = Ops.t
69 |
70 | type matrix = t array array
71 |
72 | let rows m = Array.length m
73 | let cols m = Array.length m.(0)
74 |
75 | (*let print ?(c=stdout) conv width m =
76 | let open Printf in
77 | for row=0 to rows m - 1 do
78 | for col=0 to cols m - 1 do
79 | fprintf c "%*s " width (conv m.(row).(col))
80 | done;
81 | fprintf c "\n"
82 | done*)
83 |
84 | let init rows cols f = Array.init rows
85 | (fun r -> Array.init cols (fun c -> f r c))
86 |
87 | let create rows cols = init rows cols (fun _ _ -> Ops.zero)
88 |
89 | let copy m = init (rows m) (cols m) (fun r c -> m.(r).(c))
90 |
91 | let identity n = init n n (fun r c -> if r=c then Ops.one else Ops.zero)
92 |
93 | let transpose m = init (cols m) (rows m) (fun c r -> m.(r).(c))
94 |
95 | let map f m = init (rows m) (cols m) (fun r c -> f m.(r).(c))
96 | let map2 f m0 m1 = init (rows m0) (cols m1)
97 | (fun r c -> f m0.(r).(c) m1.(r).(c))
98 |
99 |
100 | let col_vector a = init (Array.length a) 1 (fun c _ -> a.(c))
101 | let row_vector a = init 1 (Array.length a) (fun _ r -> a.(r))
102 |
103 | let (>>) a b =
104 | assert (rows a = rows b);
105 | let ca, cb = cols a, cols b in
106 | init (rows a) (ca + cb) (fun row col ->
107 | if col < ca then a.(row).(col)
108 | else b.(row).(col - ca))
109 |
110 | let (^^) a b =
111 | assert (cols a = cols b);
112 | let ra, rb = rows a, rows b in
113 | init (ra + rb) (cols a) (fun row col ->
114 | if row < ra then a.(row).(col)
115 | else b.(row - ra).(col))
116 |
117 | let sub row_off col_off rows cols m =
118 | init rows cols (fun r c -> m.(row_off + r).(col_off + c))
119 |
120 | let (+:) a b =
121 | assert (rows a = rows b);
122 | assert (cols a = cols b);
123 | init (rows a) (cols a) (fun r c -> Ops.(a.(r).(c) +: b.(r).(c)))
124 |
125 | let (-:) a b =
126 | assert (rows a = rows b);
127 | assert (cols a = cols b);
128 | init (rows a) (cols a) (fun r c -> Ops.(a.(r).(c) -: b.(r).(c)))
129 |
130 | let ( *: ) a b =
131 | let ca, cb = cols a, cols b in
132 | let ra, rb = rows a, rows b in
133 | assert (ca = rb);
134 | let mult row col =
135 | let rec f i x =
136 | if i=ca then x
137 | else f (i+1) Ops.(x +: a.(row).(i) *: b.(i).(col))
138 | in
139 | f 0 Ops.zero
140 | in
141 | init ra cb mult
142 |
143 | let ( *:. ) a b =
144 | init (rows a) (cols a) (fun r c -> Ops.(a.(r).(c) *: b))
145 |
146 | let minor row col m =
147 | assert (row < rows m);
148 | assert (col < cols m);
149 | init (rows m - 1) (cols m - 1)
150 | (fun r c ->
151 | let r = if r < row then r else r+1 in
152 | let c = if c < col then c else c+1 in
153 | m.(r).(c)
154 | )
155 |
156 | let rec det m =
157 | assert (rows m = cols m);
158 | let n = cols m in
159 | if n=1 then m.(0).(0)
160 | (*else if n=2 then det2 m*)
161 | else
162 | let rec f i =
163 | if i=n then Ops.zero
164 | else
165 | let m' = minor 0 i m in
166 | let op = if i mod 2 = 0 then Ops.(-:) else Ops.(+:) in
167 | Ops.(op (m.(0).(i) *: det m') (f (i+1)))
168 | in
169 | f 0
170 |
171 | let adjoint_inverse m =
172 | let d = det m in
173 | if d = Ops.zero then failwith "cannot invert"
174 | else
175 | let m = init (rows m) (cols m) (fun r c ->
176 | let inv = (r+c) mod 2 = 1 in
177 | let d = det (minor r c m) in
178 | if inv then Ops.(zero -: d)
179 | else d)
180 | in
181 | d, transpose m
182 |
183 | let gauss_jordan m =
184 | let open Ops in
185 | let m = copy m in
186 | (* scale row r by s *)
187 | let scale_row r s =
188 | for i=0 to Array.length r - 1 do
189 | r.(i) <- r.(i) /: s
190 | done
191 | in
192 | (* scale row y by s and subtract from x *)
193 | let sub_scale_row x y s =
194 | for i=0 to Array.length x - 1 do
195 | x.(i) <- x.(i) -: (y.(i) *: s)
196 | done
197 | in
198 | (* find the biggest element at the diagonal
199 | * position between row r and the rows below.
200 | * move the largest element to the pivot position.
201 | * at worst this will avoid 0 pivots. it should
202 | * also help numerical stability a bit *)
203 | let pivot r =
204 | let max = ref r in
205 | for i=r+1 to rows m - 1 do
206 | if m.(i).(r) > m.(!max).(r) then
207 | max := i
208 | done;
209 | let a,b = m.(r), m.(!max) in
210 | m.(r) <- b;
211 | m.(!max) <- a
212 | in
213 | for row=0 to rows m - 1 do
214 | pivot row;
215 | scale_row m.(row) m.(row).(row);
216 | for i=0 to rows m - 1 do
217 | if i <> row then
218 | sub_scale_row m.(i) m.(row) m.(i).(row)
219 | done
220 | done;
221 | m
222 |
223 | let gauss_jordan_inverse m =
224 | let n = rows m in
225 | let m = m >> identity n in
226 | let m = gauss_jordan m in
227 | sub 0 n n n m
228 |
229 | (* elementary row operations *)
230 | module Row = struct
231 |
232 | let swap n i j =
233 | init n n (fun r c ->
234 | if r=i then
235 | if c=j then Ops.one else Ops.zero
236 | else if r=j then
237 | if c=i then Ops.one else Ops.zero
238 | else if r=c then Ops.one
239 | else Ops.zero)
240 |
241 | let mult n i m =
242 | init n n (fun r c ->
243 | if r=c then
244 | if r=i then m
245 | else Ops.one
246 | else Ops.zero)
247 |
248 | let madd n i j m =
249 | init n n (fun r c ->
250 | if r=j && c=i then m
251 | else if r=c then Ops.one
252 | else Ops.zero)
253 |
254 | end
255 |
256 | end
257 |
258 |
--------------------------------------------------------------------------------
/src/matrix.mli:
--------------------------------------------------------------------------------
1 | (*
2 | * reedsolomon - error correction CODEC
3 | *
4 | * (c) 2014 MicroJamJar Ltd
5 | *
6 | * Author(s): andy.ray@ujamjar.com
7 | * Description:
8 | *
9 | *)
10 |
11 |
12 | module type S = sig
13 |
14 | type t
15 | type matrix = t array array
16 |
17 | (* size of matrix *)
18 | val rows : matrix -> int
19 | val cols : matrix -> int
20 |
21 | (*val print : ?c:out_channel -> (t -> string) -> int -> matrix -> unit*)
22 |
23 | (* construction of various matrices *)
24 | val init : int -> int -> (int -> int -> t) -> matrix
25 | val create : int -> int -> matrix
26 | val copy : matrix -> matrix
27 | val identity : int -> matrix
28 | val transpose : matrix -> matrix
29 | val map : (t -> t) -> matrix -> matrix
30 | val map2 : (t -> t -> t) -> matrix -> matrix -> matrix
31 |
32 | val row_vector : t array -> matrix
33 | val col_vector : t array -> matrix
34 |
35 | (* concatenate matrices *)
36 | val (>>) : matrix -> matrix -> matrix
37 | val (^^) : matrix -> matrix -> matrix
38 |
39 | (* select a sub matrix *)
40 | val sub : int -> int -> int -> int -> matrix -> matrix
41 |
42 | (* arithmetic *)
43 | val (+:) : matrix -> matrix -> matrix
44 | val (-:) : matrix -> matrix -> matrix
45 | val ( *: ) : matrix -> matrix -> matrix
46 | val ( *:. ) : matrix -> t -> matrix
47 |
48 | (* functions related to inverses *)
49 | val minor : int -> int -> matrix -> matrix
50 | val det : matrix -> t
51 | val adjoint_inverse : matrix -> t * matrix
52 |
53 | (* these functions require element division *)
54 | val gauss_jordan : matrix -> matrix
55 | val gauss_jordan_inverse : matrix -> matrix
56 |
57 | (* elementary row operations *)
58 | module Row : sig
59 | val swap : int -> int -> int -> matrix
60 | val mult : int -> int -> t -> matrix
61 | val madd : int -> int -> int -> t -> matrix
62 | end
63 |
64 | end
65 |
66 | module Make(Ops : Ops.OpsBase) : (S with type t = Ops.t)
67 |
68 |
--------------------------------------------------------------------------------
/src/ops.ml:
--------------------------------------------------------------------------------
1 | (*
2 | * reedsolomon - error correction CODEC
3 | *
4 | * (c) 2014 MicroJamJar Ltd
5 | *
6 | * Author(s): andy.ray@ujamjar.com
7 | * Description:
8 | *
9 | *)
10 |
11 | module type OpsBase = sig
12 | type t
13 | val zero : t
14 | val one : t
15 | val (+:) : t -> t -> t
16 | val (-:) : t -> t -> t
17 | val ( *: ) : t -> t -> t
18 | val (/:) : t -> t -> t
19 | val to_string : t -> string
20 | end
21 |
22 | module type OpsFull = sig
23 | include OpsBase
24 |
25 | val (%:) : t -> t -> t
26 | val abs : t -> t
27 |
28 | val (<<:) : t -> int -> t
29 | val (>>+) : t -> int -> t
30 | val (>>:) : t -> int -> t
31 |
32 | val (&:) : t -> t -> t
33 | val (|:) : t -> t -> t
34 | val (^:) : t -> t -> t
35 | val (~:) : t -> t
36 |
37 | val of_int : int -> t
38 | val to_int : t -> int
39 | val of_int32 : int32 -> t
40 | val to_int32 : t -> int32
41 | val of_int64 : int64 -> t
42 | val to_int64 : t -> int64
43 | val of_float : float -> t
44 | val to_float : t -> float
45 | val of_string : string -> t
46 | end
47 |
48 | module Int = struct
49 | type t = int
50 | let zero = 0
51 | let one = 1
52 | let (+:) = (+)
53 | let (-:) = (-)
54 | let ( *: ) = ( * )
55 | let (/:) = (/)
56 | let (%:) = (mod)
57 | let abs = abs
58 | let (<<:) = (lsl)
59 | let (>>+) = (asr)
60 | let (>>:) = (lsr)
61 | let (&:) = (land)
62 | let (|:) = (lor)
63 | let (^:) = (lxor)
64 | let (~:) = lnot
65 | let of_int x = x
66 | let to_int x = x
67 | let of_int32 = Int32.to_int
68 | let to_int32 = Int32.of_int
69 | let of_int64 = Int64.to_int
70 | let to_int64 = Int64.of_int
71 | let of_float x = int_of_float x
72 | let to_float x = float_of_int x
73 | let of_string x = int_of_string x
74 | let to_string x = string_of_int x
75 | end
76 |
77 | module Int32 = struct
78 | type t = int32
79 | open Int32
80 | let zero = 0l
81 | let one = 1l
82 | let (+:) = add
83 | let (-:) = sub
84 | let ( *: ) = mul
85 | let (/:) = div
86 | let (%:) = rem
87 | let abs = abs
88 | let (<<:) = shift_left
89 | let (>>+) = shift_right
90 | let (>>:) = shift_right_logical
91 | let (&:) = logand
92 | let (|:) = logor
93 | let (^:) = logxor
94 | let (~:) = lognot
95 | let of_int = of_int
96 | let to_int = to_int
97 | let of_int32 x = x
98 | let to_int32 x = x
99 | let of_int64 = Int64.to_int32
100 | let to_int64 = Int64.of_int32
101 | let of_float = of_float
102 | let to_float = to_float
103 | let of_string = of_string
104 | let to_string = to_string
105 | end
106 |
107 | module Int64 = struct
108 | type t = int64
109 | open Int64
110 | let zero = 0L
111 | let one = 1L
112 | let (+:) = add
113 | let (-:) = sub
114 | let ( *: ) = mul
115 | let (/:) = div
116 | let (%:) = rem
117 | let abs = abs
118 | let (<<:) = shift_left
119 | let (>>+) = shift_right
120 | let (>>:) = shift_right_logical
121 | let (&:) = logand
122 | let (|:) = logor
123 | let (^:) = logxor
124 | let (~:) = lognot
125 | let of_int = of_int
126 | let to_int = to_int
127 | let of_float = of_float
128 | let to_float = to_float
129 | let of_string = of_string
130 | let to_string = to_string
131 | let of_int32 = Int64.of_int32
132 | let to_int32 = Int64.to_int32
133 | let of_int64 x = x
134 | let to_int64 x = x
135 | end
136 |
137 | module Float = struct
138 | type t = float
139 | let zero = 0.0
140 | let one = 1.0
141 | let (+:) = (+.)
142 | let (-:) = (-.)
143 | let ( *: ) = ( *. )
144 | let (/:) = ( /. )
145 | let (%:) = mod_float
146 | let abs = abs_float
147 | let (<<:) a b = failwith "Ops.Float: <<:"
148 | let (>>+) a b = failwith "Ops.Float: >>+"
149 | let (>>:) a b = failwith "Ops.Float: >>:"
150 | let (&:) a b = failwith "Ops.Float: &:"
151 | let (|:) a b = failwith "Ops.Float: |:"
152 | let (^:) a b = failwith "Ops.Float: ^:"
153 | let (~:) a = failwith "Ops.Float: ~:"
154 | let of_int = float_of_int
155 | let to_int = int_of_float
156 | let of_float x = x
157 | let to_float x = x
158 | let of_string = float_of_string
159 | let to_string = string_of_float
160 | let of_int32 = Int32.to_float
161 | let to_int32 = Int32.of_float
162 | let of_int64 = Int64.to_float
163 | let to_int64 = Int64.of_float
164 | end
165 |
166 |
167 |
--------------------------------------------------------------------------------
/src/ops.mli:
--------------------------------------------------------------------------------
1 | (*
2 | * reedsolomon - error correction CODEC
3 | *
4 | * (c) 2014 MicroJamJar Ltd
5 | *
6 | * Author(s): andy.ray@ujamjar.com
7 | * Description:
8 | *
9 | *)
10 |
11 | module type OpsBase = sig
12 | type t
13 | val zero : t
14 | val one : t
15 | val (+:) : t -> t -> t
16 | val (-:) : t -> t -> t
17 | val ( *: ) : t -> t -> t
18 | val (/:) : t -> t -> t
19 | val to_string : t -> string
20 | end
21 |
22 | module type OpsFull = sig
23 | include OpsBase
24 |
25 | (* arithmetic *)
26 | val (%:) : t -> t -> t
27 | val abs : t -> t
28 |
29 | (* shift *)
30 |
31 | val (<<:) : t -> int -> t
32 | val (>>+) : t -> int -> t
33 | val (>>:) : t -> int -> t
34 |
35 | (* bitwise *)
36 |
37 | val (&:) : t -> t -> t
38 | val (|:) : t -> t -> t
39 | val (^:) : t -> t -> t
40 | val (~:) : t -> t
41 |
42 | (* conversion *)
43 |
44 | val of_int : int -> t
45 | val to_int : t -> int
46 | val of_int32 : int32 -> t
47 | val to_int32 : t -> int32
48 | val of_int64 : int64 -> t
49 | val to_int64 : t -> int64
50 | val of_float : float -> t
51 | val to_float : t -> float
52 | val of_string : string -> t
53 | end
54 |
55 | module Int : (OpsFull with type t = int)
56 | module Int32 : (OpsFull with type t = int32)
57 | module Int64 : (OpsFull with type t = int64)
58 | module Float : (OpsFull with type t = float)
59 |
60 |
61 |
--------------------------------------------------------------------------------
/src/poly.ml:
--------------------------------------------------------------------------------
1 | (*
2 | * reedsolomon - error correction CODEC
3 | *
4 | * (c) 2014 MicroJamJar Ltd
5 | *
6 | * Author(s): andy.ray@ujamjar.com
7 | * Description:
8 | *
9 | *)
10 |
11 | (* polynomial api. powers are at array index positions *)
12 |
13 | module type S = sig
14 |
15 | type elt
16 | type t
17 |
18 | val degree : t -> int
19 | val zero : t
20 | val one : t
21 | val x : t
22 | val to_poly : elt array -> t
23 | val of_poly : t -> elt array
24 | val copy : t -> t
25 | type poly_format =
26 | {
27 | coef : elt -> string;
28 | indet : int -> string;
29 | }
30 | val poly_format : poly_format
31 | val string_format : bool -> poly_format -> int -> elt -> string
32 | val to_string : ?down:bool -> ?str:(int -> elt -> string) -> t -> string
33 | val trim : t -> t
34 | val slice : t -> int -> t
35 |
36 | val (+:) : t -> t -> t
37 | val (-:) : t -> t -> t
38 | val ( *: ) : t -> t -> t
39 | val (/:) : t -> t -> t * t
40 | val ( *:. ) : t -> elt -> t
41 | val (/:.) : t -> elt -> t
42 | val (^:) : t -> int -> t
43 | val ( **: ) : t -> int -> t
44 |
45 | val ext_gcd : t -> t -> t * t
46 |
47 | val eval : t -> elt -> elt
48 |
49 | end
50 |
51 | module Make(E : Ops.OpsBase) = struct
52 |
53 | type elt = E.t
54 | type t = elt array
55 |
56 | let string_of_elt = E.to_string
57 |
58 | let degree p = Array.length p - 1
59 |
60 | let zero = [| E.zero |]
61 | let one = [| E.one |]
62 | let x = [| E.zero;E.one |]
63 |
64 | (* remove high powers which are 0 *)
65 | let trim' p =
66 | (* look for trailing zero's *)
67 | let deg = degree p in
68 | if deg < 0 then p
69 | else
70 | let rec cnt n =
71 | if n = 0 then n
72 | else if p.(n) = E.zero then cnt (n-1)
73 | else n
74 | in
75 | let c = cnt deg in
76 | if c = deg then p
77 | else Array.init (c+1) (fun i -> p.(i))
78 |
79 | (* ensure '0' is [|0|] *)
80 | let trim p =
81 | let p = trim' p in
82 | if degree p < 0 then zero
83 | else p
84 |
85 | let to_poly p = trim p
86 | let of_poly p = p
87 |
88 | let slice p deg =
89 | let pdeg = degree p in
90 | if deg = pdeg then p
91 | else
92 | Array.init (deg+1) (fun i ->
93 | if i <= pdeg then p.(i)
94 | else E.zero)
95 |
96 | let copy p = Array.copy p
97 |
98 | type poly_format =
99 | {
100 | coef : elt -> string;
101 | indet : int -> string;
102 | }
103 |
104 | let poly_format =
105 | {
106 | coef = string_of_elt;
107 | indet =
108 | function
109 | | 0 -> ""
110 | | 1 -> "x"
111 | | _ as n -> "x^" ^ string_of_int n;
112 | }
113 |
114 | let string_format filter fmt pow cof =
115 | let coef = fmt.coef cof in
116 | let indet = fmt.indet pow in
117 | if filter && cof=E.zero then ""
118 | else if filter && cof=E.one then
119 | match pow with
120 | | 0 -> coef
121 | | _ -> indet
122 | else
123 | match coef,indet with
124 | | "","" -> ""
125 | | coef,"" -> coef
126 | | "",indet -> indet
127 | | _ -> coef ^ "." ^ indet
128 |
129 | let to_string ?(down=true) ?(str=(string_format true poly_format)) p =
130 | let open Printf in
131 | let sep a s =
132 | if a="" then s else (if down then s ^ " + " ^ a else a ^ " + " ^ s)
133 | in
134 | let p =
135 | List.filter ((<>)"") (Array.to_list (Array.mapi str p))
136 | in
137 | List.fold_left sep "" p
138 | (*Array.fold_left sep "" (Array.mapi str p)*)
139 |
140 | (* add polys *)
141 | let add a b =
142 | let max = max (degree a) (degree b) in
143 | let a,b = slice a max, slice b max in
144 | trim (Array.init (max+1) E.(fun i -> a.(i) +: b.(i)))
145 |
146 | let sub a b =
147 | let max = max (degree a) (degree b) in
148 | let a,b = slice a max, slice b max in
149 | trim (Array.init (max+1) E.(fun i -> a.(i) -: b.(i)))
150 |
151 | (* raise to power of x *)
152 | let pow_x a b =
153 | if b < 0 then
154 | (try trim (Array.init (degree a + b + 1) (fun i -> a.(i-b)))
155 | with _ -> zero)
156 | else if b=0 then trim a
157 | else trim (Array.concat [ Array.make b E.zero; a ])
158 |
159 | (* scale poly *)
160 | let mul_scalar a b = trim (Array.map E.(fun a -> a *: b) a)
161 | let div_scalar a b = trim (Array.map E.(fun a -> a /: b) a)
162 |
163 | (* multiply polys *)
164 | let mul a b =
165 | let a, b = trim a, trim b in
166 | let factors = Array.mapi (fun n a -> pow_x (mul_scalar b a) n) a in
167 | trim (Array.fold_left add [| E.zero |] factors)
168 |
169 | (* polynomial divison *)
170 | let div a b =
171 | let a, b = trim a, trim b in
172 | if b = zero then failwith "poly divide by zero"
173 | else if b = one then a, zero
174 | else if degree b = 0 then div_scalar a b.(0), zero
175 | else
176 | let da = degree a in
177 | let db = degree b in
178 | let rec div a q =
179 | let da = degree a in
180 | if da < db then q,a
181 | else
182 | let n = da-db in
183 | let s = E.(a.(da) /: b.(db)) in
184 | let a' = trim (slice (sub a (mul_scalar (pow_x b n) s)) (da-1)) in
185 | div a' ((n,s)::q)
186 | in
187 | let q,r = div a [] in
188 | trim (Array.init da (fun i -> try List.assoc i q with _ -> E.zero)), r
189 |
190 | let rec ext_gcd a b =
191 | if b = zero then one, zero
192 | else
193 | let q, r = div a b in
194 | let s, t = ext_gcd b r in
195 | t, sub s (mul q t)
196 |
197 | let eval p x =
198 | let deg = degree p in
199 | let rec f n x' =
200 | if n > deg then E.zero
201 | else
202 | let a = E.(x' *: p.(n)) in
203 | E.(a +: f (n+1) (x' *: x))
204 | in
205 | E.(p.(0) +: f 1 x)
206 |
207 | let (+:) = add
208 | let (-:) = sub
209 | let ( *: ) = mul
210 | let (/:) = div
211 | let ( *:. ) = mul_scalar
212 | let (/:.) = div_scalar
213 | let (^:) = pow_x
214 | let rec ( **: ) x = function
215 | | 0 -> one
216 | | 1 -> x
217 | | _ as n -> x *: (x **: (n-1))
218 |
219 | end
220 |
221 |
--------------------------------------------------------------------------------
/src/poly.mli:
--------------------------------------------------------------------------------
1 | (*
2 | * reedsolomon - error correction CODEC
3 | *
4 | * (c) 2014 MicroJamJar Ltd
5 | *
6 | * Author(s): andy.ray@ujamjar.com
7 | * Description:
8 | *
9 | *)
10 |
11 | (** basic polynomials of 1 variable *)
12 | module type S = sig
13 |
14 | (** polynomial coefficient type *)
15 | type elt
16 | (** an array of 'elt's representing the polynomial. powers
17 | are at index position (ie lowest first) *)
18 | type t
19 |
20 | (** the degree of the polynomial *)
21 | val degree : t -> int
22 | (** this is represented as [|E.zero|] *)
23 | val zero : t
24 | (** this is represented as [|E.one|] *)
25 | val one : t
26 | (** this is represented as [|E.zero;E.one|] *)
27 | val x : t
28 | (** convert to poly *)
29 | val to_poly : elt array -> t
30 | (** convert from poly *)
31 | val of_poly : t -> elt array
32 | (** make a copy of the poly *)
33 | val copy : t -> t
34 |
35 | (** control over print formatting *)
36 | type poly_format =
37 | {
38 | coef : elt -> string;
39 | indet : int -> string;
40 | }
41 | val poly_format : poly_format
42 | val string_format : bool -> poly_format -> int -> elt -> string
43 |
44 | (** create string of poly *)
45 | val to_string : ?down:bool -> ?str:(int -> elt -> string) -> t -> string
46 |
47 | (** legalise the poly. high order powers which are 0 are removed. *)
48 | val trim : t -> t
49 |
50 | val slice : t -> int -> t
51 |
52 | (** poly addition *)
53 | val (+:) : t -> t -> t
54 | (** poly subtraction *)
55 | val (-:) : t -> t -> t
56 | (** poly multiplication *)
57 | val ( *: ) : t -> t -> t
58 | (** poly division *)
59 | val (/:) : t -> t -> t * t
60 | (** scalar multiplication *)
61 | val ( *:. ) : t -> elt -> t
62 | (** scalar division *)
63 | val (/:.) : t -> elt -> t
64 | (** multiply poly by x^n *)
65 | val (^:) : t -> int -> t
66 | (** raise poly to power n *)
67 | val ( **: ) : t -> int -> t
68 |
69 | (** extended gcd algorithm *)
70 | val ext_gcd : t -> t -> t * t
71 |
72 | (** evaluate polynomial *)
73 | val eval : t -> elt -> elt
74 |
75 | end
76 |
77 | (** Basic polynomial representations. Coefficients are members of
78 | Ops.OpsBase (which effectively provide '+' and '*') *)
79 | module Make(E : Ops.OpsBase) : (S with type t = E.t array
80 | and type elt = E.t)
81 |
82 |
--------------------------------------------------------------------------------
/test/dune:
--------------------------------------------------------------------------------
1 | (executable
2 | (name test_iter)
3 | (flags (:standard -w -27-35))
4 | (libraries reedsolomon unix))
5 |
--------------------------------------------------------------------------------
/test/test_iter.ml:
--------------------------------------------------------------------------------
1 | open Reedsolomon.Iter
2 |
3 | module Test(X : sig val rsp : rsparams end) = struct
4 |
5 | open X
6 |
7 | let () = Printf.printf "%i bits/symbol, %i symbols/codeword, t=%i\n"
8 | rsp.m rsp.n rsp.t
9 |
10 | let rand_sort a =
11 | for i=(Array.length a - 1) downto 1 do
12 | let swap = Random.int (i+1) in
13 | let tmp = a.(i) in
14 | a.(i) <- a.(swap);
15 | a.(swap) <- tmp
16 | done
17 |
18 | (* random error vector with 'e' errors *)
19 | let error e =
20 | let e = Array.init rsp.n (fun i -> if i < e then 1 + Random.int rsp.n else 0) in
21 | rand_sort e;
22 | e
23 |
24 | let random n = Array.init n (fun i -> Random.int (rsp.n+1))
25 |
26 | let rs = init rsp
27 |
28 | let print a =
29 | let open Printf in
30 | for i=0 to Array.length a - 1 do
31 | printf "%.2x" a.(i);
32 | done;
33 | printf "\n"
34 |
35 | (* correctness tests *)
36 | let test1 n_errors =
37 | let data = random rsp.k in
38 | let parity = rspoly (rsp.t*2) in
39 | let () = rs.encode data parity in
40 | let message = Array.concat [ data;parity ] in
41 | let err = error n_errors in
42 | let received = Array.init rsp.n (fun i -> message.(i) lxor err.(i)) in
43 | let corrected = rspoly rsp.n in
44 | let n_corrections = rs.decode received corrected in
45 | if corrected <> message || n_corrections <> n_errors then begin
46 | Printf.printf "\n\nERROR:\n\n";
47 | print data;
48 | print message;
49 | print err;
50 | print received;
51 | print corrected;
52 | Printf.printf "n_errors=%i n_corrections=%i\n" n_errors n_corrections;
53 | end;
54 | n_corrections, corrected = message
55 |
56 | let testn nn =
57 | for ne=0 to rsp.t do
58 | for n=0 to nn-1 do
59 | Printf.printf "\r%i %i%!" ne n;
60 | let ce,ok = test1 ne in
61 | assert (ce=ne);
62 | assert ok;
63 | done;
64 | Printf.printf "\r \r%!";
65 | done;
66 | Printf.printf "OK\n%!"
67 |
68 | let () = testn 10000
69 |
70 | (* performance tests. *)
71 | let perf n_errors n_tests =
72 | let data = random rsp.k in
73 | let parity = rspoly (rsp.t*2) in
74 | let () = rs.encode data parity in
75 | let message = Array.concat [ data;parity ] in
76 | let err = error n_errors in
77 | let received = Array.init rsp.n (fun i -> message.(i) lxor err.(i)) in
78 | let corrected = rspoly rsp.n in
79 | for i=0 to n_tests-1 do
80 | ignore (rs.decode received corrected)
81 | done
82 |
83 | let perfs n_tests =
84 | for ne=0 to rsp.t do
85 | let time = Unix.gettimeofday() in
86 | perf ne n_tests;
87 | let time = Unix.gettimeofday() -. time in
88 | Printf.printf "%i errors/cw %f secs %f Mbits/sec\n%!"
89 | ne time
90 | (float_of_int (rsp.n * rsp.m * n_tests) /. (1000000. *. time))
91 | done
92 |
93 | let () = perfs 10000
94 |
95 | end
96 |
97 | let bbc =
98 | {
99 | m = 4;
100 | k = 11;
101 | t = 2;
102 | n = 15;
103 | b = 0;
104 | prim_poly = 19;
105 | prim_elt = 2;
106 | }
107 |
108 | let g709 =
109 | {
110 | m = 8;
111 | k = 239;
112 | t = 8;
113 | n = 255;
114 | b = 0;
115 | prim_poly = 285;
116 | prim_elt = 2;
117 | }
118 |
119 | let g16 =
120 | {
121 | m = 8;
122 | k = 255-32;
123 | t = 16;
124 | n = 255;
125 | b = 0;
126 | prim_poly = 285;
127 | prim_elt = 2;
128 | }
129 |
130 | (* 4 bits/symbol, t=2 *)
131 | module A = Test(struct let rsp = bbc end)
132 | (* 8 bits/symbol, t=8 *)
133 | module B = Test(struct let rsp = g709 end)
134 | (* 8 bits/symbol, t=16 *)
135 | module C = Test(struct let rsp = g16 end)
136 |
137 |
--------------------------------------------------------------------------------
/webdemo/dune:
--------------------------------------------------------------------------------
1 | (executable
2 | (name rswebdemo)
3 | (libraries reedsolomon js_of_ocaml)
4 | (flags (:standard -w -27-32))
5 | (js_of_ocaml (flags "+nat.js"))
6 | (preprocess (pps js_of_ocaml-ppx)))
7 |
--------------------------------------------------------------------------------
/webdemo/rswebdemo.ml:
--------------------------------------------------------------------------------
1 | (* Reed-Solomon web tutorial *)
2 | open Reedsolomon
3 | module D = Dom_html
4 |
5 | let rec nbits x =
6 | if x < 0 then failwith "arg to clog2 must be >= 0";
7 | match x with 0 | 1 -> 1 | x -> 1 + (nbits (x/2))
8 |
9 | module B = struct
10 | (* copied from hardcaml - could be much more efficient (but it doesnt matter *)
11 | let constb v =
12 | let to_int = function '0' -> 0 | '1' -> 1 | _ -> failwith "invalid constant" in
13 | let len = String.length v in
14 | let rec const b i =
15 | if len = i then b
16 | else const (to_int v.[i] :: b) (i+1)
17 | in
18 | List.rev (const [] 0)
19 | let bstr_of_int w d =
20 | let rec b i d =
21 | if i = w then ""
22 | else b (i+1) (d asr 1) ^ (if d land 1 = 1 then "1" else "0")
23 | in
24 | b 0 d
25 | let consti l v = constb (bstr_of_int l v)
26 | let consti b v = []
27 | let to_int x = List.fold_left (fun acc x -> (acc * 2) + x) 0 x
28 |
29 | end
30 |
31 | (***********************************************************************)
32 |
33 | let debug = true
34 | let jlog s = if debug then Firebug.console##(log s)
35 | let log s = if debug then jlog (Js.string s)
36 |
37 | let ostr = Js.to_string
38 | let jstr = Js.string
39 | let jstri x = jstr (string_of_int x)
40 |
41 | let get_element e =
42 | let d = D.document in
43 | Js.Opt.get
44 | (d##(getElementById (Js.string ("jsoo_" ^ e))))
45 | (fun () ->
46 | log ("get_element failed: " ^ e);
47 | assert false)
48 |
49 | let rec delete_kids par =
50 | let kid = par##.firstChild in
51 | match Js.Opt.to_option kid with
52 | | Some(kid) -> begin
53 | Dom.removeChild par kid;
54 | delete_kids par
55 | end
56 | | None ->
57 | ()
58 |
59 | let get_input n =
60 | match D.tagged (get_element n) with
61 | | D.Input(x) -> x
62 | | _ -> failwith ("couldn't find text element" ^ n)
63 |
64 | let mk_table border n_rows n_cols f =
65 | let d = D.document in
66 | let table = D.createTable d in
67 | let tbody = D.createTbody d in
68 | Dom.appendChild table tbody;
69 | for row=0 to n_rows-1 do
70 | let trow = D.createTr d in
71 | for col=0 to n_cols-1 do
72 | let telt = D.createTd d in
73 | if (border row col) then begin
74 | let style = telt##.style in
75 | style##.borderStyle := Js.string "solid";
76 | style##.borderWidth := Js.string "1px";
77 | style##.borderColor := Js.string "#d0d0d0";
78 | end;
79 | Dom.appendChild telt (f row col);
80 | Dom.appendChild trow telt
81 | done;
82 | Dom.appendChild tbody trow
83 | done;
84 | table
85 |
86 | let mk_p ?(className="js_para") s =
87 | let d = D.document in
88 | let t = D.createP d in
89 | t##.className := Js.string className;
90 | t##.innerHTML := Js.string s;
91 | t
92 |
93 | (* XXX this is a bit yukky...
94 | * we invoke the 'old' handler then the new one to allow us to
95 | * chain them, however, the first time round there is no handler
96 | * so what happens? We catch problems with exceptions.
97 | * I dont know how to detect when its empty - the old way
98 | * of checking against 'no_handler' worked in chrome but not firefox *)
99 | let install_window_onload h =
100 | let o = D.window##.onload in
101 | D.window##.onload := D.handler (fun e ->
102 | let safe_invoke h =
103 | try ignore(D.invoke_handler h D.window e)
104 | with _ -> log "safe_invoke failed"
105 | in
106 | safe_invoke o;
107 | safe_invoke h;
108 | Js._false
109 | )
110 |
111 | (***********************************************************************)
112 |
113 | class type jq_math = object('self)
114 | method parseMath : Dom_html.element Js.t -> unit Js.meth
115 | end
116 | let math : jq_math Js.t = (Js.Unsafe.variable "window")##._M
117 |
118 |
119 | (***********************************************************************)
120 |
121 | module type Params = sig
122 | val m : int
123 | val n : int
124 | val k : int
125 | val t : int
126 | val b : int
127 | val pp : int
128 | val pe : int
129 | val decimal : bool
130 | val ud : bool
131 | end
132 |
133 | let value name = (get_input name)##.value
134 | let int_value name = int_of_string (ostr (value name))
135 |
136 | let get_m () = int_value "param_m"
137 | let get_t () = int_value "param_t"
138 | let get_pp () = int_value "param_pp"
139 | let get_pe () = int_value "param_pe"
140 | let get_b () = int_value "param_b"
141 |
142 | let get_n () = (1 lsl (get_m())) - 1
143 | let get_k () = get_n() - (get_t() * 2)
144 |
145 | let get_dec () = Js.to_bool (get_input "show_decimal")##.checked
146 | let get_ud () = Js.to_bool (get_input "up_down")##.checked
147 |
148 | let set_int_value name x = (get_input name)##.value := jstr (string_of_int x)
149 |
150 | let set_pp = set_int_value "param_pp"
151 | let set_pe = set_int_value "param_pe"
152 |
153 | let read_params () =
154 | get_m(), get_t(), get_pp(), get_pe(), get_b(), get_dec(), get_ud()
155 |
156 | let mk_params () =
157 | let m,t,pp,pe,b,dec,ud = read_params () in
158 | let module P = struct
159 | let m = m
160 | let n = (1 lsl m) - 1
161 | let k = n - (2*t)
162 | let t = t
163 | let b = b
164 | let pp = pp
165 | let pe = pe
166 | let decimal = dec
167 | let ud = ud
168 | end in
169 | (module P : Params)
170 |
171 | (***********************************************************************)
172 |
173 | module Gen(P : Params) = struct
174 |
175 | let prim_poly = Array.of_list (List.rev (B.consti (nbits P.pp) P.pp))
176 | let prim_elt = Array.of_list (List.rev (B.consti (nbits P.pe) P.pe))
177 |
178 | module G' = Galois.Table.Make(struct
179 | module Ops = Galois.Extension.Make(struct
180 | module Poly = Poly.Make(Galois.Primitive.GF2)
181 | let pp = prim_poly
182 | end)
183 | let alpha = prim_elt
184 | end)
185 |
186 | let intg n = B.to_int (List.rev (Array.to_list n))
187 |
188 | module G = struct
189 | include G'
190 | let to_string x = string_of_int (intg x)
191 | end
192 |
193 | let constg n = G.(zero +: (Array.of_list (List.rev (B.consti P.m n))))
194 |
195 | module Rs = Reedsolomon.Codec.MakePoly(G)(P)
196 |
197 | (***********************************************************************)
198 |
199 | let sep s l =
200 | List.fold_left (fun a x -> if a = "" then x else a ^ s ^ x) "" l
201 |
202 | let poly_split = 8
203 |
204 | let alpha = "α"
205 | let loc = "Λ"
206 | let omega = "Ω"
207 |
208 | let to_pow_string x =
209 | if x = G.zero then "0"
210 | else
211 | alpha ^ "^" ^ string_of_int (G.log x)
212 |
213 | let pow_str v x n = (* v.x^n *)
214 | match n with
215 | | 0 -> v
216 | | 1 -> if v="1" then x else v ^ x
217 | | _ -> (if v="1" then "" else v) ^ x ^ "^" ^ string_of_int n
218 |
219 | let jqmath_of_poly' ?(var="x") zero to_string p =
220 | let p = Array.to_list p in
221 | let _,p = List.fold_left (fun (p,l) x -> (p+1,(p,x)::l)) (0,[]) p in
222 | let p = List.filter (fun (_,v) -> v <> zero) p in
223 | let p = if P.ud then p else List.rev p in
224 | if p=[] then to_string zero
225 | else
226 | let rec split i l a =
227 | if i=0 then List.rev a, l
228 | else
229 | match l with
230 | | [] -> split 0 l a
231 | | h::t -> split (i-1) t (h::a)
232 | in
233 | let rec group l =
234 | let h,t = split poly_split l [] in
235 | match t with
236 | | [] -> if h=[] then [] else [h]
237 | | _ -> h :: group t
238 | in
239 | let p = group p in
240 | let f p =
241 | sep " + "
242 | (List.map (fun (p,v) -> pow_str (to_string v) var p) p)
243 | in
244 | let p = List.map f p in
245 | let s = "\\table " ^ sep " + ;" p ^ ";" in
246 | log ("rendered into " ^ string_of_int (List.length p) ^
247 | " elements");
248 | if List.length p > 1 then "(" ^ s ^ ")"
249 | else s
250 |
251 | let jqmath_of_gf ?(var="x") p = jqmath_of_poly' ~var 0 string_of_int p
252 | let jqmath_of_poly ?(var="x") p = jqmath_of_poly' ~var G.zero G.to_string p
253 | let jqmath_of_poly_a ?(var="x") p = jqmath_of_poly' ~var G.zero to_pow_string p
254 |
255 | let jqmath_of_poly ?(var="x") p =
256 | if P.decimal then jqmath_of_poly ~var p
257 | else jqmath_of_poly_a ~var p
258 |
259 | let jqwrap s = "$$" ^ s ^ "$$"
260 |
261 | let jqmath_elt name str =
262 | let div = get_element name in
263 | delete_kids div;
264 | Dom.appendChild div (mk_p (jqwrap str));
265 | math##(parseMath div)
266 |
267 | (***********************************************************************)
268 |
269 | let encoder d e =
270 | let t = Rs.encode d in
271 | let r = Rs.R.(t +: e) in
272 | jqmath_elt "message_poly" (jqmath_of_poly d);
273 | jqmath_elt "generator_poly" (jqmath_of_poly Rs.generator);
274 | jqmath_elt "error_poly" (jqmath_of_poly e);
275 | jqmath_elt "codeword_poly" (jqmath_of_poly t);
276 | jqmath_elt "received_poly" (jqmath_of_poly r);
277 | t, r
278 |
279 | let string_of_syndrome s i =
280 | "R(" ^ to_pow_string (Rs.root i) ^ "), =, " ^ to_pow_string s.(i) ^
281 | ", =, " ^ string_of_int (intg s.(i)) ^ ";"
282 |
283 | let euclid s =
284 | let rec gen r s =
285 | match r, s with
286 | | r0::r1::rt, s0::s1::st -> begin
287 | if Rs.R.degree r0 < P.t then r,s
288 | else
289 | let r', s' = Rs.euclid_inner (r0,r1) (s0,s1) in
290 | gen (r'::r) (s'::s)
291 | end
292 | | _ -> failwith "invalid"
293 | in
294 | let r, s = gen [Rs.R.trim s; Rs.x2t] [Rs.R.one; Rs.R.zero] in
295 | Array.of_list (List.rev r), Array.of_list (List.rev s)
296 |
297 | let gen_euclid_table s =
298 | let r,s = euclid s in
299 | let x = Array.init (Array.length r*2) (fun i ->
300 | if i mod 2 = 0 then r.(i/2) else s.(i/2))
301 | in
302 | let x = Array.mapi (fun i p ->
303 | (if i mod 2 = 0 then "r_{" else "s_{") ^
304 | string_of_int (i/2) ^ "}, =, " ^
305 | "{" ^ jqmath_of_poly p ^ "};") x
306 | in
307 | jqmath_elt "euclid" ("\\table " ^ Array.fold_left (^) "" x)
308 |
309 | let berlekamp_massey s =
310 | let one, x = Rs.R.(one, one ^: 1) in
311 | let rec f k (n,c,l as x) =
312 | if k > 2*P.t then []
313 | else
314 | let x = Rs.berlekamp_massey_iter s k x in
315 | x :: f (k+1) x
316 | in
317 | f 1 (one, x, 0)
318 |
319 | let gen_berlekamp_massey_table s =
320 | let x = berlekamp_massey s in
321 | let x = Array.of_list x in
322 | let x = Array.mapi (fun k (n,c,l) ->
323 | let k = string_of_int (k+1) in
324 | "L_{"^k^"}, =, " ^ string_of_int l ^ ";" ^
325 | "Λ_{"^k^"}, =, {" ^ jqmath_of_poly n ^ "};" ^
326 | "C_{"^k^"}, =, {" ^ jqmath_of_poly c ^ "};") x
327 | in
328 | jqmath_elt "berlekamp_massey" ("\\table " ^ Array.fold_left (^) "" x)
329 |
330 | let decoder r =
331 | (* syndromes *)
332 | let s = Rs.syndromes r in
333 | let s' = Array.init (2*P.t) (string_of_syndrome s) in
334 | jqmath_elt "syndromes" ("\\table " ^ Array.fold_left (^) "" s');
335 | jqmath_elt "syndrome_poly" (jqmath_of_poly s);
336 | (* euclid *)
337 | let v, l = Rs.euclid ~norm:true s in
338 | gen_euclid_table s;
339 | gen_berlekamp_massey_table s;
340 | jqmath_elt "error_locator_poly" (jqmath_of_poly l);
341 | jqmath_elt "error_magnitude_poly" (jqmath_of_poly v);
342 | (* chien *)
343 | let el = Rs.chien l in
344 | let el' = Array.init P.n (fun i ->
345 | let x = Rs.horner l (G.antilog i) in
346 | loc ^ "(" ^ to_pow_string (G.antilog i) ^ "), =, " ^
347 | string_of_int (intg x) ^ ", =, " ^ to_pow_string x ^ ";")
348 | in
349 | jqmath_elt "chien_search" ("\\table " ^ Array.fold_left (^) "" el');
350 | let el' = Array.of_list el in
351 | let el'' = Array.init (Array.length el') (fun i ->
352 | "X_{" ^ string_of_int (i+1) ^ "}^{-1}, =, " ^
353 | to_pow_string (G.antilog el'.(i)) ^
354 | ", thus, log_{α} X_{" ^ string_of_int (i+1) ^ "}, =, " ^
355 | string_of_int G.(log (inv (antilog el'.(i)))) ^ ";")
356 | in
357 | jqmath_elt "error_locations" ("\\table " ^ Array.fold_left (^) "" el'');
358 | (* forney *)
359 | let forney = Rs.forney v l in
360 | let ev = List.map forney el in
361 | let l' = Rs.deriv l in
362 | let f = "X_{j}^{"^ string_of_int (1-P.b) ^ "} {" ^
363 | jqmath_of_poly_a ~var:"X_{j}^{-1}" v ^ "} / {" ^
364 | jqmath_of_poly_a ~var:"X_{j}^{-1}" l' ^ "}"
365 | in
366 | jqmath_elt "forney_poly" f;
367 | let forney i el =
368 | let x' = G.antilog el in
369 | let x = G.inv x' in
370 | let f = forney el in
371 | "Y_{" ^ string_of_int (i+1) ^ "}, =, " ^
372 | to_pow_string G.(x **: (1-P.b)) ^
373 | "{" ^ to_pow_string (Rs.horner v x') ^ " / " ^
374 | to_pow_string (Rs.horner l' x') ^ "}, =, " ^
375 | to_pow_string f ^ ", =, " ^ string_of_int (intg f) ^ ";"
376 | in
377 | let f = Array.init (Array.length el') (fun i -> forney i el'.(i)) in
378 | jqmath_elt "forney_res" ("\\table " ^ Array.fold_left (^) "" f);
379 | (* correction *)
380 | let e' = Rs.error ev el in
381 | jqmath_elt "calc_error_poly" (jqmath_of_poly e');
382 | jqmath_elt "corrected_poly" (jqmath_of_poly Rs.R.(e'+:r))
383 |
384 | end
385 |
386 | (***********************************************************************)
387 |
388 | let hide_galois_field _ =
389 | (get_element "show_galois_field_div")##.style##.display := jstr "none";
390 | Js._false
391 |
392 | let toggle_galois_field _ =
393 | let module X = Gen( (val (mk_params ()) : Params) ) in
394 | let open X in
395 | let box = get_element "show_galois_field_div" in
396 | if box##.style##.display = jstr "block" then begin
397 | hide_galois_field ()
398 | end else begin
399 | jqmath_elt "prim_poly" (jqmath_of_gf prim_poly);
400 | jqmath_elt "prim_elt" (jqmath_of_gf prim_elt);
401 | (* table of GF(2^m) elements *)
402 | let p =
403 | Array.init G.n_elems (fun i ->
404 | let c = constg i in
405 | string_of_int i ^ ", {" ^
406 | jqmath_of_gf c ^ "}, " ^ to_pow_string c ^ ";")
407 | in
408 | let s = "\\table " ^ Array.fold_left (^) "" p in
409 | jqmath_elt "galois_field" s;
410 | (get_element "show_galois_field_div")##.style##.display := jstr "block";
411 | Js._false
412 | end
413 |
414 | (***********************************************************************)
415 |
416 | (* number input cell *)
417 | let mk_num_input id =
418 | let i = D.createInput ~_type:(jstr "text") D.document in
419 | i##.id :=jstr id;
420 | i##.maxLength := 4;
421 | i##.size := 4;
422 | i##.value := jstr "0";
423 | i##.onkeypress := D.handler (fun e ->
424 | (* only allow numbers *)
425 | let cc = e##.charCode in
426 | match Js.Optdef.to_option cc with
427 | | None -> Js._true
428 | | Some(cc) ->
429 | if cc > 31 && (cc < 48 || cc > 57) then Js._false
430 | else Js._true
431 | );
432 | i
433 |
434 | type table_data =
435 | {
436 | name : string;
437 | data : Dom_html.inputElement Js.t array ref;
438 | }
439 |
440 | let message_data = { name = "message_data"; data = ref [||]; }
441 | let error_data = { name = "error_data"; data = ref [||]; }
442 |
443 | (* construct a new table, copy data from old one where possible *)
444 | let mk_table_data n d =
445 | if Array.length !(d.data) <> n then begin
446 | d.data := Array.init n
447 | (fun i ->
448 | let inp = mk_num_input (d.name ^ string_of_int i) in
449 | inp##.value := (try !(d.data).(i)##.value with _ -> jstr "0");
450 | inp);
451 | let table = mk_table (fun _ _ -> false) ((n+7)/8) 8 (fun r c ->
452 | let i = (r*8)+c in
453 | try ((!(d.data).(i)) :> Dom.element Js.t)
454 | with _ -> (mk_p "" :> Dom.element Js.t))
455 | in
456 | let div = get_element d.name in
457 | delete_kids div;
458 | Dom.appendChild div table
459 | end
460 |
461 | let set_table_data table data =
462 | mk_table_data (Array.length data) table;
463 | Array.iteri (fun x i -> i##.value := jstr (string_of_int data.(x)))
464 | !(table.data)
465 |
466 | let get_table_data table =
467 | Array.map (fun i -> int_of_string (ostr (i##.value))) !(table.data)
468 |
469 | let read_data () =
470 | get_table_data message_data, get_table_data error_data
471 |
472 | let init_table table fn =
473 | let data = Array.init (Array.length !(table.data)) fn in
474 | set_table_data table data;
475 | Js._false
476 |
477 | (***********************************************************************)
478 |
479 | let run_rs _ =
480 | let module X = Gen( (val (mk_params ()) : Params) ) in
481 | let d, e = read_data () in
482 | let t, r = X.encoder (Array.map X.constg d) (Array.map X.constg e) in
483 | X.decoder r;
484 | Js._false
485 |
486 | let int_of_gf2_prim_poly m =
487 | let x = Galois.GF2N.gf2_prim_polys.(m) in
488 | let x = B.to_int (List.rev (Array.to_list x)) in
489 | x
490 |
491 | let derived_params _ =
492 | let div = get_element "derived_params" in
493 | let p = mk_p
494 | ("n = " ^ string_of_int (get_n()) ^
495 | ", k = " ^ string_of_int (get_k ()))
496 | in
497 | delete_kids div;
498 | Dom.appendChild div p;
499 | Js._false
500 |
501 | let update_tables _ =
502 | let m, t, _, _, _, _, _ = read_params () in
503 | let n = (1 lsl m) - 1 in
504 | let k = n - 2*t in
505 | mk_table_data k message_data;
506 | mk_table_data n error_data;
507 | Js._false
508 |
509 | let select_poly _ =
510 | set_pp (int_of_gf2_prim_poly (get_m ()));
511 | set_pe 2;
512 | Js._false
513 |
514 | let init_table table fn _ =
515 | let n,t = get_n(), get_t() in
516 | let fn = fn n t in
517 | init_table table fn
518 |
519 | let onload _ =
520 | log "loading reed-solomon tutorial app";
521 |
522 | (* example from the bbc white paper *)
523 | let d = [| 11;10;9;8;7;6;5;4;3;2;1 |] in
524 | let e = [| 0;0;2;0;0;0;0;0;0;13;0;0;0;0;0 |] in
525 |
526 | (* create input data tables *)
527 | set_table_data message_data d;
528 | set_table_data error_data e;
529 |
530 | (get_element "show_galois_field")##.onclick :=
531 | D.handler toggle_galois_field;
532 |
533 | (get_element "random_message")##.onclick :=
534 | D.handler (init_table message_data (fun n _ _ -> Random.int (n+1)));
535 |
536 | (get_element "random_errors")##.onclick :=
537 | D.handler (init_table error_data
538 | (fun n t _ -> if Random.int n <= t then (Random.int n)+1 else 0));
539 |
540 | (get_element "clear_message")##.onclick :=
541 | D.handler (init_table message_data (fun _ _ _ -> 0));
542 | (get_element "clear_errors")##.onclick :=
543 | D.handler (init_table error_data (fun _ _ _ -> 0));
544 |
545 | let handlers l = (* run multiple handlers *)
546 | D.handler (fun e -> List.iter (fun f -> ignore (f e)) l; Js._false)
547 | in
548 | ignore (derived_params());
549 |
550 | (get_input "param_m")##.onchange := handlers
551 | [update_tables; hide_galois_field; select_poly; derived_params];
552 | (get_input "param_t")##.onchange := handlers
553 | [update_tables; derived_params];
554 |
555 | (get_input "param_pp")##.onchange := D.handler hide_galois_field;
556 | (get_input "param_pe")##.onchange := D.handler hide_galois_field;
557 |
558 | (get_element "calculate_rs")##.onclick := D.handler run_rs;
559 |
560 | ignore (run_rs());
561 |
562 | Js._false
563 |
564 | let _ = install_window_onload (D.handler onload)
565 |
566 |
--------------------------------------------------------------------------------