-- The Great Computer Language Shootout
-- http://shootout.alioth.debian.org/
--
-- contributed by Adam Sampson <ats@offog.org>

#INCLUDE "course.module"

VAL INT N IS 2500000:

VAL INT IM IS 139968:
VAL INT IA IS 3877:
VAL INT IC IS 29573:

VAL []BYTE ALU IS "GGCCGGGCGCGGTGGCTCACGCCTGTAATCCCAGCACTTTGGGAGGCCGAGGCGGGCGGATCACCTGAGGTCAGGAGTTCGAGACCAGCCTGGCCAACATGGTGAAACCCCGTCTCTACTAAAAATACAAAAATTAGCCGGGCGTGGTGGCGCGCGCCTGTAATCCCAGCTACTCGGGAGGCTGAGGCAGGAGAATCGCTTGAACCCGGGAGGCGGAGGTTGCAGTGAGCCGAGATCGCGCCACTGCACTCCAGCCTGGGCGACAGAGCGAGACTCCGTCTCAAAAA":

VAL []BYTE iub.b IS "acgtBDHKMNRSVWY":
VAL []REAL64 iub.f IS [0.27, 0.12, 0.12, 0.27, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02, 0.02]:

VAL []BYTE hs.b IS "acgt":
VAL []REAL64 hs.f IS [0.3029549426680, 0.1979883004921, 0.1975473066391, 0.3015094502008]:

PROTOCOL FASTA
  CASE
    header; MOBILE []BYTE; MOBILE []BYTE
    data; BYTE
    done
:

PROC main (CHAN BYTE out!)
  INITIAL INT last IS 42:
  PROC gen.random (VAL REAL64 max, REAL64 out)
    SEQ
      last := ((last TIMES IA) PLUS IC) \ IM
      out := max * ((REAL64 ROUND last) / (REAL64 ROUND IM))
  :

  PROC repeat (VAL []BYTE d, VAL INT n, CHAN FASTA out!)
    VAL INT sd IS SIZE d:
    SEQ i = 0 FOR n
      out ! data; d[i \ sd]
  :

  PROC random (VAL []BYTE bs, VAL []REAL64 fs, VAL INT n, CHAN FASTA out!)
    VAL INT nb IS SIZE bs:
    MOBILE []REAL64 cfs:
    INITIAL REAL64 c IS 0.0:
    SEQ
      cfs := MOBILE [nb + 1]REAL64
      SEQ i = 0 FOR nb
        SEQ
          cfs[i] := c
          c := c + fs[i]
      cfs[nb] := 1.0
      SEQ i = 0 FOR n
        REAL64 r:
        SEQ
          gen.random (1.0, r)
          IF j = 0 FOR nb
            cfs[j + 1] > r
              out ! data; bs[j]
  :

  PROC output (CHAN FASTA in?, CHAN BYTE out!)
    INITIAL INT count IS 0:
    INITIAL BOOL running IS TRUE:
    WHILE running
      in ? CASE
        MOBILE []BYTE id, desc:
        header; id; desc
          SEQ
            IF
              count <> 0
                out ! '*n'
              TRUE
                SKIP
            out ! '>'
            out.string (id, 0, out!)
            out ! ' '
            out.string (desc, 0, out!)
            out ! '*n'
            count := 0
        BYTE b:
        data; b
          SEQ
            out ! b
            count := (count + 1) \ 60
            IF
              count = 0
                out ! '*n'
              TRUE
                SKIP
        done
          SEQ
            IF
              count <> 0
                out ! '*n'
              TRUE
                SKIP
            running := FALSE
  :

  CHAN FASTA fasta:
  PAR
    SEQ
      fasta ! header; "ONE"; "Homo sapiens alu"
      repeat (ALU, N * 2, fasta!)
      fasta ! header; "TWO"; "IUB ambiguity codes"
      random (iub.b, iub.f, N * 3, fasta!)
      fasta ! header; "THREE"; "Homo sapiens frequency"
      random (hs.b, hs.f, N * 5, fasta!)
      fasta ! done
    output (fasta?, out!)
:
