#!/usr/bin/perl

use strict;
use warnings;

#
# Usage:
#   kmer_creator.pl WORDLEN HAPLOTYPE_FILE
#

if (!defined ($ARGV[0])) {
  printf (STDERR "Usage:\nkmer_creator.pl HAPLOTYPE_FILE\n");
  exit (1);
}
my $wlen = $ARGV[0];
my $fname = $ARGV[1];

# IUPAC codes
my %iupac = (
  "M" => "AC",
  "R" => "AG",
  "W" => "AT",
  "S" => "CG",
  "Y" => "CT",
  "K" => "GT",
  "V" => "ACG",
  "H" => "ACT",
  "D" => "AGT",
  "B" => "CGT",
  "N" => "ACGT"
);

my $index = 1;

open (my $ifs, $fname) or die $!;
while (my $line = <$ifs>) {
  chomp ($line);
  my $id = substr ($line, 1);
  $line = <$ifs>;
  chomp ($line);
  my $seq = $line;
  for (my $i = 0; $i <= length ($seq) - $wlen; $i++) {
    rec ($id, "", substr ($seq, $i, $wlen), 0);
  }
}
printf (STDERR "Done\n");
exit (0);

# rec (ID, STRING, SOURCE, POSITION)

sub rec {
  my $id = $_[0];
  my $str = $_[1];
  my $src = $_[2];
  my $pos = $_[3];
  #printf (STDOUT "%s %s %s\n", $str, $src, $pos);
  # Find first non-canonical
  my $next = $pos;
  while ($next < length ($src)) {
    last if (defined ($iupac{substr ($src, $next, 1)}));
    $next += 1;
  }
  if ($next > $pos) {
    $str .= substr ($src, $pos, $next - $pos);
  }
  if ($next >= length ($src)) {
    printf (STDOUT ">%s %s\n%s\n", $index, $id, $str);
    $index += 1;
  } else {
    my @alt = split ("", $iupac{substr ($src, $next, 1)});
    foreach (@alt) {
      #printf (STDOUT "%s ", $_);
      my $sstr = $str . $_;
      rec ($id, $sstr, $src, $next + 1);
    }
  }
}
