code_perl/Maasha/KISS.pm

   1 package Maasha::KISS;
   2
   3 # Copyright (C) 2009 Martin A. Hansen.
   4
   5 # This program is free software; you can redistribute it and/or
   6 # modify it under the terms of the GNU General Public License
   7 # as published by the Free Software Foundation; either version 2
   8 # of the License, or (at your option) any later version.
   9
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program; if not, write to the Free Software
  17 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  18
  19 # http://www.gnu.org/copyleft/gpl.html
  20
  21
  22 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> DESCRIPTION <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  23
  24
  25 # Routines for parsing and emitting KISS records.
  26
  27 # http://code.google.com/p/biopieces/wiki/KissFormat
  28
  29
  30 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  31
  32
  33 use warnings;
  34 use strict;
  35 use Data::Dumper;
  36 use JSON::XS;
  37 use Maasha::Common;
  38 use Maasha::Filesys;
  39 use Maasha::Align;
  40
  41 use vars qw( @ISA @EXPORT );
  42
  43 @ISA = qw( Exporter );
  44
  45 use constant {
  46     S_ID             => 0,
  47     S_BEG            => 1,
  48     S_END            => 2,
  49     Q_ID             => 3,
  50     SCORE            => 4,
  51     STRAND           => 5,
  52     HITS             => 6,
  53     ALIGN            => 7,
  54     BLOCK_COUNT      => 8,
  55     BLOCK_BEGS       => 9,
  56     BLOCK_LENS       => 10,
  57     BLOCK_TYPE       => 11,
  58     INDEX_BLOCK_SIZE => 100,
  59     INDEX_LEVEL      => 100_000_000,
  60     INDEX_FACTOR     => 100,
  61
  62     BUCKET_SIZE      => 100,
  63     COUNT            => 0,
  64     OFFSET           => 1,
  65
  66     INDEX_BEG        => 1,
  67     INDEX_END        => 2,
  68     INDEX            => 12,
  69 };
  70
  71
  72 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  73
  74
  75 sub kiss_entry_get
  76 {
  77     # Martin A. Hansen, November 2009.
  78
  79     # Gets the next KISS entry from a file handle.
  80
  81     my ( $fh,    # file handle
  82        ) = @_;
  83
  84     # Returns a hashref.
  85
  86     my ( $line, @fields );
  87
  88     while ( $line = <$fh> )
  89     {
  90         chomp $line;
  91
  92         next if $line =~ /^$|^#/;
  93
  94         @fields = split /\t/, $line;
  95
  96         Maasha::Common::error( qq(BAD kiss entry: $line) ) if not @fields == 12;
  97
  98         return wantarray ? @fields : \@fields;
  99     }
 100 }
 101
 102
 103 sub kiss_retrieve
 104 {
 105     # Martin A. Hansen, February 2010.
 106
 107     # Retrieves KISS entries from a given sorted KISS file
 108     # within an optional interval.
 109
 110     my ( $file,   # path to KISS file
 111          $beg,    # interval begin  -  OPTIONAL
 112          $end,    # interval end    -  OPTIONAL
 113        ) = @_;
 114
 115     # Returns a list.
 116
 117     my ( $fh, $entry, @entries );
 118
 119     $beg ||= 0;
 120     $end ||= 999999999;
 121
 122     $fh = Maasha::Filesys::file_read_open( $file );
 123
 124     while ( $entry = kiss_entry_get( $fh ) )
 125     {
 126         last if $entry->[ S_BEG ] > $end;
 127         push @entries, $entry if $entry->[ S_END ] > $beg;
 128     }
 129
 130     close $fh;
 131
 132     return wantarray ? @entries : \@entries;
 133 }
 134
 135
 136 sub kiss_entry_parse
 137 {
 138     # Martin A. Hansen, December 2009.
 139
 140     # Parses a line with a KISS entry.
 141
 142     my ( $line,   #  KISS line to parse
 143        ) = @_;
 144
 145     # Returns a hash
 146
 147     my ( @fields, %entry );
 148
 149     @fields = split /\t/, $line;
 150
 151     Maasha::Common::error( qq(BAD kiss entry: $line) ) if not @fields == 12;
 152
 153     return wantarray ? @fields : \@fields;
 154 }
 155
 156
 157 sub kiss_entry_put
 158 {
 159     # Martin A. Hansen, November 2009.
 160
 161     # Outputs a KISS record to a given filehandle
 162     # or STDOUT if no filehandle is given.
 163
 164     my ( $entry,   # KISS entry to output
 165          $fh,      # file handle  -  OPTIONAL
 166        ) = @_;
 167
 168     # Returns nothing.
 169
 170     Maasha::Common::error( qq(BAD kiss entry) ) if not scalar @{ $entry } == 12;
 171
 172     if ( defined $entry->[ S_ID ]  and
 173          defined $entry->[ S_BEG ] and
 174          defined $entry->[ S_END ]
 175        )
 176     {
 177         Maasha::Common::error( qq(Bad S_BEG value: $entry->[ S_BEG ] < 0 ) ) if $entry->[ S_BEG ] < 0;
 178         Maasha::Common::error( qq(Bad S_END value: $entry->[ S_END ] < $entry->[ S_BEG ] ) ) if $entry->[ S_END ] < $entry->[ S_BEG ];
 179
 180         $fh ||= \*STDOUT;
 181
 182         $entry->[ Q_ID ]        = "." if not defined $entry->[ Q_ID ];
 183         $entry->[ SCORE ]       = "." if not defined $entry->[ SCORE ];
 184         $entry->[ STRAND ]      = "." if not defined $entry->[ STRAND ];
 185         $entry->[ HITS ]        = "." if not defined $entry->[ HITS ];
 186         $entry->[ ALIGN ]       = "." if not defined $entry->[ ALIGN ];
 187         $entry->[ BLOCK_COUNT ] = "." if not defined $entry->[ BLOCK_COUNT ];
 188         $entry->[ BLOCK_BEGS ]  = "." if not defined $entry->[ BLOCK_BEGS ];
 189         $entry->[ BLOCK_LENS ]  = "." if not defined $entry->[ BLOCK_LENS ];
 190         $entry->[ BLOCK_TYPE ]  = "." if not defined $entry->[ BLOCK_TYPE ];
 191
 192         print $fh join( "\t", @{ $entry } ), "\n";
 193     }
 194 }
 195
 196
 197 sub kiss_sort
 198 {
 199     # Martin A. Hansen, November 2009.
 200
 201     # Sorts a KISS file on S_BEG and S_END
 202
 203     my ( $file,   # KISS file
 204        ) = @_;
 205
 206     # Returns nothing.
 207
 208     `sort -k 2,2n -k 3,3nr $file > $file.sort`;
 209
 210     rename "$file.sort", $file;
 211 }
 212
 213
 214 sub kiss_index
 215 {
 216     # Martin A. Hansen, December 2009.
 217
 218     # Creates a lookup index of a sorted KISS file.
 219
 220     my ( $file,   # path to KISS file
 221        ) = @_;
 222
 223     # Returns nothing.
 224
 225     my ( $fh, $offset, $line, $s_beg, $bucket, $index );
 226
 227     $fh = Maasha::Filesys::file_read_open( $file );
 228
 229     $offset = 0;
 230
 231     while ( $line = <$fh> )
 232     {
 233         ( undef, $s_beg ) = split "\t", $line, 3;
 234
 235         $bucket = int( $s_beg / BUCKET_SIZE );
 236
 237         $index->[ $bucket ]->[ COUNT ]++;
 238         $index->[ $bucket ]->[ OFFSET ] = $offset if not defined $index->[ $bucket ]->[ OFFSET ];
 239
 240         $offset += length $line;
 241     }
 242
 243     close $fh;
 244
 245     Maasha::KISS::kiss_index_store( "$file.index", $index );
 246 }
 247
 248
 249 sub kiss_index_offset
 250 {
 251     # Martin A. Hansen, December 2009.
 252
 253     # Given a KISS index and a begin position,
 254     # locate the offset closest to the begin position,
 255     # and return this.
 256
 257     my ( $index,    # KISS index
 258          $beg,      # begin position
 259        ) = @_;
 260
 261     # Returns a number.
 262
 263     my ( $bucket );
 264
 265     Maasha::Common::error( qq(Negative begin position: "$beg") ) if $beg < 0;
 266
 267     $bucket = int( $beg / BUCKET_SIZE );
 268
 269     $bucket = scalar @{ $index } if $bucket > scalar @{ $index };
 270
 271     while ( $bucket >= 0 )
 272     {
 273         return $index->[ $bucket ]->[ OFFSET ] if defined $index->[ $bucket ];
 274
 275         $bucket--;
 276     }
 277 }
 278
 279
 280 sub kiss_index_count
 281 {
 282     # Martin A. Hansen, December 2009.
 283
 284     # Given a KISS index and a begin/end interval
 285     # sum the number of counts in that interval,
 286     # and return this.
 287
 288     my ( $index,   # KISS index
 289          $beg,     # Begin position
 290          $end,     # End position
 291        ) = @_;
 292
 293     # Returns a number.
 294
 295     my ( $bucket_beg, $bucket_end, $count, $i );
 296
 297     Maasha::Common::error( qq(Negative begin position: "$beg") ) if $beg < 0;
 298
 299     $bucket_beg = int( $beg / BUCKET_SIZE );
 300     $bucket_end = int( $end / BUCKET_SIZE );
 301
 302     $bucket_end = scalar @{ $index } if $bucket_end > scalar @{ $index };
 303
 304     $count = 0;
 305
 306     for ( $i = $bucket_beg; $i <= $bucket_end; $i++ ) {
 307         $count += $index->[ $i ]->[ COUNT ] if defined $index->[ $i ];
 308     }
 309
 310     return $count;
 311 }
 312
 313
 314 sub kiss_index_count_nc
 315 {
 316     # Martin A. Hansen, December 2009.
 317
 318     # Given a KISS index and a begin/end interval
 319     # sum the number of counts in that interval,
 320     # and return this.
 321
 322     my ( $index,   # KISS index
 323          $beg,     # Begin position
 324          $end,     # End position
 325        ) = @_;
 326
 327     # Returns a number.
 328
 329     my ( $count );
 330
 331     Maasha::Common::error( qq(Negative begin position: "$beg") ) if $beg < 0;
 332
 333     $count = Maasha::NClist::nc_list_count_interval( $index, $beg, $end, INDEX_BEG, INDEX_END, INDEX );
 334
 335     return $count;
 336 }
 337
 338
 339 sub kiss_index_get_entries
 340 {
 341     # Martin A. Hansen, November 2009.
 342
 343     # Given a path to a KISS file and a KISS index
 344     # along with a beg/end interval, locate all entries
 345     # in that interval and return those.
 346
 347     my ( $file,    # path to KISS file
 348          $index,   # KISS index
 349          $beg,     # interval begin
 350          $end,     # interval end
 351        ) = @_;
 352
 353     # Returns a list.
 354
 355     my ( $offset, $fh, $entry, @entries );
 356
 357     # $offset = kiss_index_offset( $index, $beg );
 358
 359     $fh = Maasha::Filesys::file_read_open( $file );
 360
 361     # sysseek( $fh, $offset, 0 );
 362
 363     while ( $entry = Maasha::KISS::kiss_entry_get( $fh ) )
 364     {
 365         push @entries, $entry if $entry->[ S_END ] > $beg;
 366
 367         last if $entry->[ S_BEG ] > $end;
 368     }
 369
 370     close $fh;
 371
 372     return wantarray ? @entries : \@entries;
 373 }
 374
 375
 376 sub kiss_index_get_entries_OLD
 377 {
 378     # Martin A. Hansen, November 2009.
 379
 380     # Given a path to a KISS file and a KISS index
 381     # along with a beg/end interval, locate all entries
 382     # in that interval and return those.
 383
 384     my ( $file,    # path to KISS file
 385          $index,   # KISS index
 386          $beg,     # interval begin
 387          $end,     # interval end
 388        ) = @_;
 389
 390     # Returns a list.
 391
 392     my ( $offset, $fh, $entry, @entries );
 393
 394     $offset = kiss_index_offset( $index, $beg );
 395
 396     $fh = Maasha::Filesys::file_read_open( $file );
 397
 398     sysseek( $fh, $offset, 0 );
 399
 400     while ( $entry = Maasha::KISS::kiss_entry_get( $fh ) )
 401     {
 402         push @entries, $entry if $entry->[ S_END ] > $beg;
 403
 404         last if $entry->[ S_BEG ] > $end;
 405     }
 406
 407     close $fh;
 408
 409     return wantarray ? @entries : \@entries;
 410 }
 411
 412
 413 sub kiss_index_get_blocks
 414 {
 415     # Martin A. Hansen, December 2009.
 416
 417     # Given a KISS index returns blocks from this in a
 418     # given position interval. Blocks consisting of
 419     # hashes of BEG/END/COUNT.
 420
 421     my ( $index,   # KISS index node
 422          $beg,     # interval begin
 423          $end,     # interval end
 424        ) = @_;
 425
 426     # Returns a list.
 427
 428     my ( $bucket_beg, $bucket_end, $i, @blocks );
 429
 430     Maasha::Common::error( qq(Negative begin position: "$beg") ) if $beg < 0;
 431
 432     $bucket_beg = int( $beg / BUCKET_SIZE );
 433     $bucket_end = int( $end / BUCKET_SIZE );
 434
 435     $bucket_end = scalar @{ $index } if $bucket_end > scalar @{ $index };
 436
 437     for ( $i = $bucket_beg; $i <= $bucket_end; $i++ )
 438     {
 439         if ( defined $index->[ $i ] )
 440         {
 441             push @blocks, {
 442                 BEG   => BUCKET_SIZE * $i,
 443                 END   => BUCKET_SIZE * ( $i + 1 ),
 444                 COUNT => $index->[ $i ]->[ COUNT ],
 445             };
 446         }
 447     }
 448
 449     return wantarray ? @blocks : \@blocks;
 450 }
 451
 452
 453 sub kiss_intersect
 454 {
 455     # Martin A. Hansen, December 2009.
 456
 457     # Given filehandles to two different unsorted KISS files
 458     # intersect the entries so that all entries from file1 that
 459     # overlap entries in file2 are returned - unless the inverse flag
 460     # is given in which case entreis from file1 that does not
 461     # overlap any entries in file2 are returned.
 462
 463     my ( $fh1,       # filehandle to file1
 464          $fh2,       # filehandle to file2
 465          $inverse,   # flag indicating inverse matching - OPTIONAL
 466        ) = @_;
 467
 468     # Returns a list
 469
 470     my ( $entry, %lookup, $pos, $overlap, @entries );
 471
 472     while ( $entry = kiss_entry_get( $fh2 ) ) {
 473         map { $lookup{ $_ } = 1 } ( $entry->[ S_BEG ] .. $entry->[ S_END ] );
 474     }
 475
 476     while ( $entry = kiss_entry_get( $fh1 ) )
 477     {
 478         $overlap = 0;
 479
 480         foreach $pos ( $entry->[ S_BEG ] .. $entry->[ S_END ] )
 481         {
 482             if ( exists $lookup{ $pos } )
 483             {
 484                 $overlap = 1;
 485
 486                 last;
 487             }
 488         }
 489
 490         if ( $overlap and not $inverse ) {
 491             push @entries, $entry;
 492         } elsif ( not $overlap and $inverse ) {
 493             push @entries, $entry;
 494         }
 495     }
 496
 497     return wantarray ? @entries : \@entries;
 498 }
 499
 500
 501 sub kiss_index_store
 502 {
 503     # Martin A. Hansen, November 2009.
 504
 505     # Stores a KISS index to a file.
 506
 507     my ( $path,    # path to KISS index
 508          $index,   # KISS index
 509        ) = @_;
 510
 511     # Returns nothing.
 512
 513     my ( $fh, $json );
 514
 515     $json = JSON::XS::encode_json( $index );
 516
 517     $fh = Maasha::Filesys::file_write_open( $path );
 518
 519     print $fh $json;
 520
 521     close $fh;
 522 }
 523
 524
 525 sub kiss_index_retrieve
 526 {
 527     # Martin A. Hansen, November 2009.
 528
 529     # Retrieves a KISS index from a file.
 530
 531     my ( $path,   # Path to KISS index
 532        ) = @_;
 533
 534     # Returns a data structure.
 535
 536     my ( $fh, $json, $index );
 537
 538     local $/ = undef;
 539
 540     $fh = Maasha::Filesys::file_read_open( $path );
 541
 542     $json = <$fh>;
 543
 544     close $fh;
 545
 546     $index = JSON::XS::decode_json( $json );
 547
 548     return wantarray ? @{ $index } : $index;
 549 }
 550
 551
 552 sub kiss_align_enc
 553 {
 554     # Martin A. Hansen, November 2009.
 555
 556     # Encodes alignment descriptors for two
 557     # aligned sequences.
 558
 559     my ( $s_seq,    # Subject sequence reference
 560          $q_seq,    # Query sequence reference
 561          $offset,   # alternate offset - OPTIONAL
 562        ) = @_;
 563
 564     # Returns a list
 565
 566     my ( $i, $s, $q, @align );
 567
 568     # Maasha::Common::error( "Sequence lengths don't match" ) if length ${ $s_seq } != length ${ $q_seq };
 569
 570     if ( length ${ $s_seq } != length ${ $q_seq } ) {   # for unknown reasons this situation may occur - TODO FIXME
 571         return wantarray ? () : [];
 572     }
 573
 574     $offset ||= 0;
 575
 576     for ( $i = 0; $i < length ${ $s_seq }; $i++ )
 577     {
 578         $s = uc substr ${ $s_seq }, $i, 1;
 579         $q = uc substr ${ $q_seq }, $i, 1;
 580
 581         if ( $s eq '-' and $q eq '-' )
 582         {
 583             # do nothing
 584         }
 585         elsif ( $s eq $q )
 586         {
 587             $offset++;
 588         }
 589         else
 590         {
 591             push @align, "$offset:$s>$q";
 592
 593             $offset++ if not $s eq '-';
 594         }
 595     }
 596
 597     return wantarray ? @align : \@align;
 598 }
 599
 600
 601 sub kiss_align_dec
 602 {
 603     # Martin A. Hansen, November 2009.
 604
 605     # Test routine of correct resolve of ALIGN descriptors.
 606
 607     # S.aur_COL       41      75      5_vnlh2ywXsN1/1 1       -       .       17:A>T,31:A>N   .       .       .       .
 608
 609     my ( $s_seqref,   # subject sequence reference
 610          $entry,      # KISS entry
 611        ) = @_;
 612
 613     # Returns a string.
 614
 615     my ( $align, $pos, $s_symbol, $q_symbol, $s_seq, $q_seq, $insertions );
 616
 617     $s_seq = substr ${ $s_seqref }, $entry->{ 'S_BEG' }, $entry->{ 'S_END' } - $entry->{ 'S_BEG' } + 1;
 618     $q_seq = $s_seq;
 619
 620     $insertions = 0;
 621
 622     foreach $align ( split /,/, $entry->{ 'ALIGN' } )
 623     {
 624         if ( $align =~ /(\d+):(.)>(.)/ )
 625         {
 626             $pos      = $1;
 627             $s_symbol = $2;
 628             $q_symbol = $3;
 629
 630             if ( $s_symbol eq '-' ) # insertion
 631             {
 632                 substr $s_seq, $pos + $insertions, 0, $s_symbol;
 633                 substr $q_seq, $pos + $insertions, 0, $q_symbol;
 634
 635                 $insertions++;
 636             }
 637             elsif ( $q_symbol eq '-' ) # deletion
 638             {
 639                 substr $q_seq, $pos + $insertions, 1, $q_symbol;
 640             }
 641             else # mismatch
 642             {
 643                 substr $q_seq, $pos + $insertions, 1, $q_symbol;
 644             }
 645         }
 646         else
 647         {
 648             Maasha::Common::error( qq(Bad alignment descriptor: "$align") );
 649         }
 650     }
 651
 652     Maasha::Align::align_print_pairwise( [ $entry->{ 'S_ID' }, $s_seq ], [ $entry->{ 'Q_ID' }, $q_seq ] );
 653 }
 654
 655
 656 sub kiss2biopiece
 657 {
 658     # Martin A. Hansen, November 2009.
 659
 660     # Converts a KISS entry to a Biopiece record.
 661
 662     my ( $entry,   # KISS entry
 663        ) = @_;
 664
 665     # Returns a hashref
 666
 667     my ( %record );
 668
 669     Maasha::Common::error( qq(BAD kiss entry) ) if not scalar @{ $entry } == 12;
 670
 671     $record{ 'S_ID' }        = $entry->[ S_ID ];
 672     $record{ 'S_BEG' }       = $entry->[ S_BEG ];
 673     $record{ 'S_END' }       = $entry->[ S_END ];
 674     $record{ 'Q_ID' }        = $entry->[ Q_ID ];
 675     $record{ 'SCORE' }       = $entry->[ SCORE ];
 676     $record{ 'STRAND' }      = $entry->[ STRAND ];
 677     $record{ 'HITS' }        = $entry->[ HITS ];
 678     $record{ 'ALIGN' }       = $entry->[ ALIGN ];
 679     $record{ 'BLOCK_COUNT' } = $entry->[ BLOCK_COUNT ];
 680     $record{ 'BLOCK_BEGS' }  = $entry->[ BLOCK_BEGS ];
 681     $record{ 'BLOCK_LENS' }  = $entry->[ BLOCK_LENS ];
 682     $record{ 'BLOCK_TYPE' }  = $entry->[ BLOCK_TYPE ];
 683
 684     return wantarray ? %record : \%record;
 685 }
 686
 687
 688 sub biopiece2kiss
 689 {
 690     # Martin A. Hansen, November 2009.
 691
 692     # Converts a Biopiece record to a KISS entry.
 693
 694     my ( $record,   # Biopiece record
 695        ) = @_;
 696
 697     # Returns a hashref
 698
 699     my ( $entry );
 700
 701     if ( not defined $record->{ 'S_ID' }  and
 702          not defined $record->{ 'S_BEG' } and
 703          not defined $record->{ 'S_END' } )
 704     {
 705         return undef;
 706     }
 707
 708     $entry->[ S_ID ]        = $record->{ 'S_ID' };
 709     $entry->[ S_BEG ]       = $record->{ 'S_BEG' };
 710     $entry->[ S_END ]       = $record->{ 'S_END' };
 711     $entry->[ Q_ID ]        = $record->{ 'Q_ID' }        || ".";
 712     $entry->[ SCORE ]       = $record->{ 'SCORE' }       || $record->{ 'BIT_SCORE' } || $record->{ 'ID' } || ".";
 713     $entry->[ STRAND ]      = $record->{ 'STRAND' }      || ".";
 714     $entry->[ HITS ]        = $record->{ 'HITS' }        || ".";
 715     $entry->[ ALIGN ]       = $record->{ 'ALIGN' }       || $record->{ 'DESCRIPTOR' } || ".";
 716     $entry->[ BLOCK_COUNT ] = $record->{ 'BLOCK_COUNT' } || ".";
 717     $entry->[ BLOCK_BEGS ]  = $record->{ 'BLOCK_BEGS' }  || $record->{ 'Q_BEGS' } || ".";
 718     $entry->[ BLOCK_LENS ]  = $record->{ 'BLOCK_LENS' }  || ".";
 719     $entry->[ BLOCK_TYPE ]  = $record->{ 'BLOCK_TYPE' }  || ".";
 720
 721     return wantarray ? @{ $entry } : $entry;
 722 }
 723
 724
 725 # >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
 726
 727 1;
 728
 729 __END__
 730
 731 sub kiss_index_nc
 732 {
 733     # Martin A. Hansen, February 2010.
 734
 735     # Creates a NC list index of a sorted KISS file.
 736
 737     my ( $file,         # path to KISS file
 738        ) = @_;
 739
 740     # Returns nothing.
 741
 742     my ( $fh, $line, @fields, $nc_list );
 743
 744     $fh = Maasha::Filesys::file_read_open( $file );
 745
 746     while ( $line = <$fh> )
 747     {
 748         chomp $line;
 749
 750         @fields = split "\t", $line;
 751
 752         if ( not defined $nc_list ) {
 753             $nc_list = [ [ @fields ] ];
 754         } else {
 755             Maasha::NClist::nc_list_add( $nc_list, [ @fields ], INDEX_END, INDEX );
 756         }
 757     }
 758
 759     close $fh;
 760
 761     Maasha::NClist::nc_list_store( $nc_list, "$file.json" );
 762 }
 763
 764
 765 sub kiss_index_get_entries_nc
 766 {
 767     # Martin A. Hansen, November 2009.
 768
 769     # Given a path to a KISS file and a KISS index
 770     # along with a beg/end interval, locate all entries
 771     # in that interval and return those.
 772
 773     my ( $index,   # KISS index
 774          $beg,     # interval begin
 775          $end,     # interval end
 776        ) = @_;
 777
 778     # Returns a list.
 779
 780     my ( $features );
 781
 782     $features = Maasha::NClist::nc_list_get_interval( $index, $beg, $end, INDEX_BEG, INDEX_END, INDEX );
 783
 784     return wantarray ? @{ $features } : $features;
 785 }
 786
 787
 788 sub kiss_index_retrieve_nc
 789 {
 790     # Martin A. Hansen, November 2009.
 791
 792     # Retrieves a KISS index from a file.
 793
 794     my ( $path,   # Path to KISS index
 795        ) = @_;
 796
 797     # Returns a data structure.
 798
 799     my ( $index );
 800
 801     $index = Maasha::NClist::nc_list_retrieve( $path );
 802
 803     return wantarray ? @{ $index } : $index;
 804 }