# Churn.pm ("Crosspeak Handling Utilities for RNA NMR") v. 20 Jul 1996,
#     Dave Schweisguth <dcs@proton.chem.yale.edu>
# Module required by most parts of CHURN

### Preliminaries

package Churn;
$^W = 1;			    # Turn on -w checking
require 5.002;			    # Perl 5.002 required
use strict;			    # Require optional-but-desirable practices
use vars qw(@matrix_params %spins %schema);
				    # Exempt globals from 'use strict'
require Exporter;
@Churn::ISA = qw(Exporter);
@Churn::EXPORT = ();
@Churn::EXPORT_OK = qw(
    @matrix_params
    %spins
    %schema
    is_num
    partner
    retrieve_cpd
    retrieve_ssd
    store_fd
);
use Storable qw(retrieve store_fd);

### Definitions

# Matrix parameter keys in Felix' order

@matrix_params = qw(sfreq swidth refpt refsh datsiz);

# Each residue type's spins.

%spins = (
    a => {qw(
	h1'	?
	h2'	?
	h3'	?
	h4'	?
	h5'	?
	h5''	?
	h2	?
	h8	?
	h61	?
	h62	?
	p	?
    )},
    c => {qw(
	h1'	?
	h2'	?
	h3'	?
	h4'	?
	h5'	?
	h5''	?
	h5	?
	h6	?
	h41	?
	h42	?
	p	?
    )},
    g => {qw(
	h1'	?
	h2'	?
	h3'	?
	h4'	?
	h5'	?
	h5''    ?
	h8	?
	h1	?
	h21	?
	h22	?
	p	?
    )},
    u => {qw(
	h1'	?
	h2'	?
	h3'	?
	h4'	?
	h5'	?
	h5''    ?
	h5	?
	h6	?
	h3	?
	p	?
    )},
);

# Each residue type's spins, listed in the order in which they're entered in
# the standard assignment table.

%schema = (
    a => [qw(
	na
	h61
	h62
	h8
	h2
	h1'
	h2'
	h3'
	h4'
	h5'
	h5''
	p
    )],
    c => [qw(
	na
	h41
	h42
	h6
	h5
	h1'
	h2'
	h3'
	h4'
	h5'
	h5''
	p
    )],
    g => [qw(
	h1
	h21
	h22
	h8
	na
	h1'
	h2'
	h3'
	h4'
	h5'
	h5''
	p
    )],
    u => [qw(
	h3
	na
	na
	h6
	h5
	h1'
	h2'
	h3'
	h4'
	h5'
	h5''
	p
    )],
);

### Subroutines

# Return 1 if all args are numeric, 0 otherwise

sub is_num {

    foreach (@_) {
	unless (/^[+-]?(\d*(?:\.\d*)?)(?:e[+-]?\d+)?$/i && $1 ne '.') {
	    return 0;
	}
    }
    1;

}

# Given a pointer to an ssd and a residue number, return the residue number
# of the residue's base-pairing partner, if any.

sub partner {
    my($ssd, $res) = @_;
    my $pair;

    foreach $pair (@{$$ssd{pairs}}) {
	if ($$pair[1] == $_[1]) {
	    return $$pair[3];
	} elsif ($$pair[3] == $_[1]) {
	    return $$pair[1];
	}
    }
    undef;
}

# retrieve() a cpd and see if it really is one

sub retrieve_cpd {
    my $cpd = &retrieve($_[0]);
    (
	ref $cpd eq 'HASH' &&
	ref $$cpd{'dim'} eq 'ARRAY' && ref $$cpd{'peaks'} eq 'ARRAY'
    )
    ? $cpd
    : (warn("$::whatami: $_[0] doesn't appear to be a crosspeak database!\n"), 0);
}

# retrieve() an ssd and see if it really is one

sub retrieve_ssd {
    my($seg, $res);
    my $ssd = &retrieve($_[0]);

    (
	ref $ssd eq 'HASH' &&
	ref $$ssd{'segs'} eq 'HASH' && ref $$ssd{'pairs'} eq 'ARRAY'
    )
    ? $ssd
    : (warn("$::whatami: $_[0] doesn't appear to be a spin system database!\n"), 0);

}

1;