From b632667ce57af89691407bb8668e1512775278ae Mon Sep 17 00:00:00 2001 From: Calvin Date: Fri, 15 Mar 2013 15:26:20 -0400 Subject: nbc added --- src/nbc/nmer.sml | 557 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 557 insertions(+) create mode 100644 src/nbc/nmer.sml (limited to 'src/nbc/nmer.sml') diff --git a/src/nbc/nmer.sml b/src/nbc/nmer.sml new file mode 100644 index 0000000..82c5b53 --- /dev/null +++ b/src/nbc/nmer.sml @@ -0,0 +1,557 @@ +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) -- cgit v1.2.3