aboutsummaryrefslogtreecommitdiff
path: root/src/nbc/nmer.sml
diff options
context:
space:
mode:
Diffstat (limited to 'src/nbc/nmer.sml')
-rw-r--r--src/nbc/nmer.sml557
1 files changed, 0 insertions, 557 deletions
diff --git a/src/nbc/nmer.sml b/src/nbc/nmer.sml
deleted file mode 100644
index 82c5b53..0000000
--- a/src/nbc/nmer.sml
+++ /dev/null
@@ -1,557 +0,0 @@
-signature NMER_SIDES = sig
- type sidesBase
- type sidesNmer
- type sides
- val create: unit -> sides
- val clear: sides -> unit
- val put: sides * sidesBase -> unit
- val isFull: sides -> bool
- val forward: sides -> sidesNmer
-end
-
-signature NMER = sig
- eqtype base
- val a: base
- val c: base
- val g: base
- val t: base
- eqtype nmer
- val compare: nmer * nmer -> order
- val maximum: nmer
- val minimum: nmer
- val next: nmer -> nmer
- val hash: nmer -> Word.word
- val equal: nmer * nmer -> bool
- val toString: nmer -> string
- val fromString: string -> nmer option
- structure Single: NMER_SIDES
- where type sidesBase = base
- where type sidesNmer = nmer
- structure Double: sig
- include NMER_SIDES
- where type sidesBase = base
- where type sidesNmer = nmer
- val reverse: sides -> nmer
- end
-end
-
-signature NMER_ARGUMENTS = sig
- val order: int
- structure Word: sig
- eqtype word
- val fromInt: Int.int -> word
- val toInt: word -> Int.int
- val + : word * word -> word
- val << : word * Word.word -> word
- val ~>> : word * Word.word -> word
- val andb: word * word -> word
- val orb: word * word -> word
- val xorb: word * word -> word
- val compare: word * word -> order
- val toLarge: word -> LargeWord.word
- end
-end
-
-functor Nmer (Arguments: NMER_ARGUMENTS) = struct
- type base = Arguments.Word.word
- val a = Arguments.Word.fromInt 0
- val c = Arguments.Word.fromInt 1
- val g = Arguments.Word.fromInt 2
- val t = Arguments.Word.fromInt 3
- val maximumBase = t
- val baseBits = 0w2
- val nmerBits = Word.fromInt (Arguments.order * 2)
- fun opposite base =
- (*
- Conveniently enough, xor properly implements this:
- a -> t
- c -> g
- g -> c
- t -> a
- *)
- Arguments.Word.xorb (base, maximumBase)
- type nmer = Arguments.Word.word
- val compare = Arguments.Word.compare
- val minimum = Arguments.Word.fromInt 0
- local
- fun shiftInto (nmer, base) =
- Arguments.Word.+ (
- Arguments.Word.<< (nmer, baseBits)
- , base
- )
- fun maximumOfOrder order =
- if order = 0 then minimum
- else shiftInto (
- maximumOfOrder (order - 1)
- , maximumBase
- )
- in
- val maximum = maximumOfOrder Arguments.order
- end
- local
- val one = Arguments.Word.fromInt 1
- in
- fun next nmer = Arguments.Word.+ (nmer, one)
- end
- local
- fun charFromBase base = case Arguments.Word.toInt base of
- 0 => #"A"
- | 1 => #"C"
- | 2 => #"G"
- | 3 => #"T"
- | _ => raise Fail "bug in nmer.sml"
- fun get (nmer, index) =
- let
- fun multiplyByTwo word = Word.<< (word, 0w1)
- val offset = multiplyByTwo (
- Word.fromInt (
- Arguments.order - 1 - index
- )
- )
- in
- Arguments.Word.~>> (
- Arguments.Word.andb (
- nmer
- , Arguments.Word.<< (
- maximumBase
- , offset
- )
- ), offset
- )
- end
- in
- fun toString nmer = CharVector.tabulate (
- Arguments.order
- , fn index => charFromBase (
- get (nmer, index)
- )
- )
- end
- fun hash nmer = Word.fromLarge (Arguments.Word.toLarge nmer)
- fun equal (a, b) = Arguments.Word.compare (a, b) = EQUAL
- structure Undetermined = struct
- type sidesBase = base
- type sidesNmer = nmer
- type 'reverse undeterminedSides = {
- forward: nmer ref
- , reverse: 'reverse
- , count: int ref
- }
- fun clear {forward = _, reverse = _, count} = count := 0
- fun put ({forward, reverse, count}, base) = (
- forward := Arguments.Word.+ (
- Arguments.Word.andb (
- Arguments.Word.<< (
- !forward
- , baseBits
- ), maximum
- ), base
- );
- if !count = Arguments.order then ()
- else count := !count + 1
- )
- fun isFull {forward = _, reverse = _, count = ref count} =
- count = Arguments.order
- fun forward {forward = ref forward, reverse = _, count = _} =
- forward
- end
- structure Single = struct
- open Undetermined
- type sides = unit undeterminedSides
- fun create () = {
- forward = ref minimum
- , reverse = ()
- , count = ref 0
- }
- end
- structure Double = struct
- open Undetermined
- type sides = nmer ref undeterminedSides
- fun create () = {
- forward = ref minimum
- , reverse = ref maximum
- , count = ref 0
- }
- val put = fn (
- sides as {forward = _, reverse, count = _}
- , base
- ) => (
- put (sides, base)
- ; reverse := Arguments.Word.+ (
- Arguments.Word.~>> (
- !reverse
- , baseBits
- ), Arguments.Word.<< (
- opposite base
- , nmerBits - baseBits
- )
- )
- )
- fun reverse {reverse = ref reverse, forward = _, count = _} =
- reverse
- end
- fun fromString string =
- let
- val side = Single.create ()
- val char = fn
- #"A" => (Single.put (side, a); true)
- | #"a" => (Single.put (side, a); true)
- | #"C" => (Single.put (side, c); true)
- | #"c" => (Single.put (side, c); true)
- | #"G" => (Single.put (side, g); true)
- | #"g" => (Single.put (side, g); true)
- | #"T" => (Single.put (side, t); true)
- | #"t" => (Single.put (side, t); true)
- | _ => false
-
- in
- if CharVector.all char string then
- SOME (Single.forward side)
- else NONE
- end
-end
-
-functor Test () = struct
- structure Nmer1 = Nmer (
- val order = 1
- structure Word = Word32
- )
- structure Nmer2 = Nmer (
- val order = 2
- structure Word = Word32
- )
- structure Nmer3 = Nmer (
- val order = 3
- structure Word = Word32
- )
- val () = Test.list [
- {
- description = "opposite a = t"
- , function = fn () =>
- Bool.toString (
- Nmer1.opposite Nmer1.a = Nmer1.t
- )
- , expectedResult = "true"
- }, {
- description = "opposite c = g"
- , function = fn () =>
- Bool.toString (
- Nmer1.opposite Nmer1.c = Nmer1.g
- )
- , expectedResult = "true"
- }, {
- description = "A forward"
- , function = fn () =>
- let
- val nmer = Nmer1.Double.create ()
- in
- Nmer1.Double.put (nmer, Nmer1.a)
- ; Nmer1.toString (
- Nmer1.Double.forward nmer
- )
- end
- , expectedResult = "A"
- }, {
- description = "A reverse"
- , function = fn () =>
- let
- val nmer = Nmer1.Double.create ()
- in
- Nmer1.Double.put (nmer, Nmer1.a)
- ; Nmer1.toString (
- Nmer1.Double.reverse nmer
- )
- end
- , expectedResult = "T"
- }, {
- description = "C forward"
- , function = fn () =>
- let
- val nmer = Nmer1.Double.create ()
- in
- Nmer1.Double.put (nmer, Nmer1.c)
- ; Nmer1.toString (
- Nmer1.Double.forward nmer
- )
- end
- , expectedResult = "C"
- }, {
- description = "C reverse"
- , function = fn () =>
- let
- val nmer = Nmer1.Double.create ()
- in
- Nmer1.Double.put (nmer, Nmer1.c)
- ; Nmer1.toString (
- Nmer1.Double.reverse nmer
- )
- end
- , expectedResult = "G"
- }, {
- description = "G forward"
- , function = fn () =>
- let
- val nmer = Nmer1.Double.create ()
- in
- Nmer1.Double.put (nmer, Nmer1.g)
- ; Nmer1.toString (
- Nmer1.Double.forward nmer
- )
- end
- , expectedResult = "G"
- }, {
- description = "G reverse"
- , function = fn () =>
- let
- val nmer = Nmer1.Double.create ()
- in
- Nmer1.Double.put (nmer, Nmer1.g)
- ; Nmer1.toString (
- Nmer1.Double.reverse nmer
- )
- end
- , expectedResult = "C"
- }, {
- description = "T forward"
- , function = fn () =>
- let
- val nmer = Nmer1.Double.create ()
- in
- Nmer1.Double.put (nmer, Nmer1.t)
- ; Nmer1.toString (
- Nmer1.Double.forward nmer
- )
- end
- , expectedResult = "T"
- }, {
- description = "T reverse"
- , function = fn () =>
- let
- val nmer = Nmer1.Double.create ()
- in
- Nmer1.Double.put (nmer, Nmer1.t)
- ; Nmer1.toString (
- Nmer1.Double.reverse nmer
- )
- end
- , expectedResult = "A"
- }, {
- description = "AA forward"
- , function = fn () =>
- let
- val nmer = Nmer2.Double.create ()
- in
- Nmer2.Double.put (nmer, Nmer2.a)
- ; Nmer2.Double.put (nmer, Nmer2.a)
- ; Nmer2.toString (
- Nmer2.Double.forward nmer
- )
- end
- , expectedResult = "AA"
- }, {
- description = "AA reverse"
- , function = fn () =>
- let
- val nmer = Nmer2.Double.create ()
- in
- Nmer2.Double.put (nmer, Nmer2.a)
- ; Nmer2.Double.put (nmer, Nmer2.a)
- ; Nmer2.toString (
- Nmer2.Double.reverse nmer
- )
- end
- , expectedResult = "TT"
- }, {
- description = "AC forward"
- , function = fn () =>
- let
- val nmer = Nmer2.Double.create ()
- in
- Nmer2.Double.put (nmer, Nmer2.a)
- ; Nmer2.Double.put (nmer, Nmer2.c)
- ; Nmer2.toString (
- Nmer2.Double.forward nmer
- )
- end
- , expectedResult = "AC"
- }, {
- description = "AC reverse"
- , function = fn () =>
- let
- val nmer = Nmer2.Double.create ()
- in
- Nmer2.Double.put (nmer, Nmer2.a)
- ; Nmer2.Double.put (nmer, Nmer2.c)
- ; Nmer2.toString (
- Nmer2.Double.reverse nmer
- )
- end
- , expectedResult = "GT"
- }, {
- description = "GTA forward"
- , function = fn () =>
- let
- val nmer = Nmer3.Double.create ()
- in
- Nmer3.Double.put (nmer, Nmer3.g)
- ; Nmer3.Double.put (nmer, Nmer3.t)
- ; Nmer3.Double.put (nmer, Nmer3.a)
- ; Nmer3.toString (
- Nmer3.Double.forward nmer
- )
- end
- , expectedResult = "GTA"
- }, {
- description = "GTA reverse"
- , function = fn () =>
- let
- val nmer = Nmer3.Double.create ()
- in
- Nmer3.Double.put (nmer, Nmer3.g)
- ; Nmer3.Double.put (nmer, Nmer3.t)
- ; Nmer3.Double.put (nmer, Nmer3.a)
- ; Nmer3.toString (
- Nmer3.Double.reverse nmer
- )
- end
- , expectedResult = "TAC"
- }, {
- description = "( ) isFull"
- , function = fn () =>
- let
- val nmer = Nmer1.Double.create ()
- in
- Bool.toString (
- Nmer1.Double.isFull nmer
- )
- end
- , expectedResult = "false"
- }, {
- description = "(C) isFull"
- , function = fn () =>
- let
- val nmer = Nmer1.Double.create ()
- in
- Nmer1.Double.put (nmer, Nmer1.g)
- ; Bool.toString (
- Nmer1.Double.isFull nmer
- )
- end
- , expectedResult = "true"
- }, {
- description = "(C ) isFull"
- , function = fn () =>
- let
- val nmer = Nmer2.Double.create ()
- in
- Nmer2.Double.put (nmer, Nmer2.c)
- ; Bool.toString (
- Nmer2.Double.isFull nmer
- )
- end
- , expectedResult = "false"
- }, {
- description = "(CG) isFull"
- , function = fn () =>
- let
- val nmer = Nmer2.Double.create ()
- in
- Nmer2.Double.put (nmer, Nmer2.c)
- ; Nmer2.Double.put (nmer, Nmer2.g)
- ; Bool.toString (
- Nmer2.Double.isFull nmer
- )
- end
- , expectedResult = "true"
- }, {
- description = "C(GA) isFull"
- , function = fn () =>
- let
- val nmer = Nmer2.Double.create ()
- in
- Nmer2.Double.put (nmer, Nmer2.c)
- ; Nmer2.Double.put (nmer, Nmer2.g)
- ; Nmer2.Double.put (nmer, Nmer2.a)
- ; Bool.toString (
- Nmer2.Double.isFull nmer
- )
- end
- , expectedResult = "true"
- }, {
- description = "CGA( ) isFull"
- , function = fn () =>
- let
- val nmer = Nmer2.Double.create ()
- in
- Nmer2.Double.put (nmer, Nmer2.c)
- ; Nmer2.Double.put (nmer, Nmer2.g)
- ; Nmer2.Double.put (nmer, Nmer2.a)
- ; Nmer2.Double.clear nmer
- ; Bool.toString (
- Nmer2.Double.isFull nmer
- )
- end
- , expectedResult = "false"
- }, {
- description = "CGA (AC) isFull"
- , function = fn () =>
- let
- val nmer = Nmer2.Double.create ()
- in
- Nmer2.Double.put (nmer, Nmer2.c)
- ; Nmer2.Double.put (nmer, Nmer2.g)
- ; Nmer2.Double.put (nmer, Nmer2.a)
- ; Nmer2.Double.clear nmer
- ; Nmer2.Double.put (nmer, Nmer2.a)
- ; Nmer2.Double.put (nmer, Nmer2.c)
- ; Bool.toString (
- Nmer2.Double.isFull nmer
- )
- end
- , expectedResult = "true"
- }, {
- description = "CGA (AC) forward"
- , function = fn () =>
- let
- val nmer = Nmer2.Double.create ()
- in
- Nmer2.Double.put (nmer, Nmer2.c)
- ; Nmer2.Double.put (nmer, Nmer2.g)
- ; Nmer2.Double.put (nmer, Nmer2.a)
- ; Nmer2.Double.clear nmer
- ; Nmer2.Double.put (nmer, Nmer2.a)
- ; Nmer2.Double.put (nmer, Nmer2.c)
- ; Nmer2.toString (
- Nmer2.Double.forward nmer
- )
- end
- , expectedResult = "AC"
- }, {
- description = "CGA (AC) reverse"
- , function = fn () =>
- let
- val nmer = Nmer2.Double.create ()
- in
- Nmer2.Double.put (nmer, Nmer2.c)
- ; Nmer2.Double.put (nmer, Nmer2.g)
- ; Nmer2.Double.put (nmer, Nmer2.a)
- ; Nmer2.Double.clear nmer
- ; Nmer2.Double.put (nmer, Nmer2.a)
- ; Nmer2.Double.put (nmer, Nmer2.c)
- ; Nmer2.toString (
- Nmer2.Double.reverse nmer
- )
- end
- , expectedResult = "GT"
- }, {
- description = "TG fromString"
- , function = fn () =>
- case Nmer2.fromString "TG" of
- NONE => "invalid string"
- | SOME nmer => Nmer2.toString nmer
- , expectedResult = "TG"
- }
- ]
-end
-
-functor Nmer (Arguments: NMER_ARGUMENTS) :> NMER = Nmer (Arguments)
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-15 02:42:45 +0000