#!/usr/bin/perl
# project.: x-on
# author..: Sebastian Kreß
# email...: lepidium@hotmail.com
# started.: 18.05.2005 
# finished: 28.01.2006

package Xon::quant;
use strict;
                            
# --- <options> ----------------------------------------
my $log    = 0; #logfile?
# --------------------------------------- </options> ---


# --- <vars> -------------------------------------------
my $fMesh   = $ARGV[0]; #d2005.bin
my $fPub    = $ARGV[1]; #pubmed-file
my $out     = $ARGV[2]; #new xml file
my $fMtree  = $ARGV[3]; #mtree, optional

die "$0 mesh pubmed out (mtree)\n" unless ($out);

my %mtree  = ();       #mtree{key}{position} = concept
my %mesh   = ();       #mesh{part of entry}{heading} = mesh-number
my %cls    = ();       #cls{concept} = number of words

my $lf     = $/;

my %pTexts     = ();   #$pTexts{pmid} = text
my %pAbstracts = ();   #$pAbstracts{pmid} = abstract
my %pTitles    = ();   #$pTitles{pmid}= title
my %pWords     = ();   #$pWords{pmid}{word number} = word
my %pHeadings  = ();   #$pHeadings{pmid}{heading} =? major

my $frame = 40; #frame for multiwords
# ------------------------------------------ </vars> ---


# --- <main> -------------------------------------------
# ------------------------------------------------------
open(LOG, ">sk_log.txt") if ($log);
&read_mesh();
&annotate_corpus($out);
# ------------------------------------------------------
# ------------------------------------------ </main> ---


# --- <subs> -------------------------------------------
sub read_mtrees{  #reads the mesh tree structure
    print STDERR "reading $fMtree..\n";
    my $lines = 0;
    open(MTREE, $fMtree);
    while (my $line = <MTREE>){
	$lines++;
	chomp($line);
	my @entry = split(/;/, $line);
	my @tree  = split(/\./, $entry[1]) if(@entry);
	if ($#entry == 1){
	    printf STDERR "\r  %s -- %s", $entry[1], $entry[0];
	    my $c = 0;
	    foreach my $pos(@tree){
		$c++;
		$mtree{$pos}{$c} = $entry[0];
	    }
	}
    }
    close(MTREE);
    print STDERR "\n$lines nodes read.\n";
}

# ---
sub read_mesh{
    $/ = "*NEWRECORD";
    open(MESH, $fMesh);
    my $c = 0; 
    my $failed = 0;
    #read all headings
    while (my $record = <MESH>){
	my $suffix = 0;
	$c++;
	print LOG "$c\n" if($log);
	my $mh = ();
	my $mn = ();
	if($record =~ /MH = (.*?)\n/og){
	    $mh = $1;
	}
	else{
	    #print STDERR "\nNO MESH-HEADING FOUND IN THIS ENTRY\n";
	}
	
	print STDERR "\rreading mesh-entry $c" if ($mh);
	
	my %entries = ();
	#read all entries for the heading
	while ($record =~ /ENTRY = (.*)\n/og){
	    $suffix++;
	    my @temp = ();
	    my $e = $1;
	    $e =~ s/\. |, / /og;
	    $e =~ s/(\|.*)//og;
	    $e =~ s/( )+/ /og;
	    @temp = split(/ /, $e);
	    if ($#temp < 1){
		#print STDERR "\nskipped $e\n";
	    }
	    else{
		#print STDERR "\nused $e\n";
		foreach my $word(@temp){
		    $entries{$suffix}{$word} = 1; #unless (($word =~ /^(\d*|we|I|you|a|in|and|of|the|to|for|as|an|by|there|is)$/ogis));
		}
	    }	    
	}
	if($record =~ /MN = (.*?)\n/og){
	    $mn = $1;
	}
	else{
	    $failed++;
	    $mn = "no mesh number";
	    #print STDERR "\nNO MESH-NUMBER FOUND IN ENTRY $mh\n";
	}
	
	foreach my $suff(keys %entries){
	    foreach my $w(keys %{$entries{$suff}}){
		my $mhTemp = "$mh ($suff)";
		$mesh{lc($w)}{$mhTemp} = $mn;
		$cls{$mhTemp}++;
		print LOG "  $cls{$mhTemp}: $w --> $mhTemp\n" if($log);
	    }
	}
	print LOG "$mn --> $mh\n" if($log && $mn && $mh);	
	print LOG "\n\n" if($log);
    }
    close(MESH);
    $/ = $lf;
    print STDERR "\ndone reading: $c records read from $fMesh ($failed failed)\n"
    }

# ---
sub get_concepts{
    my $term = shift;
    $term = lc($term);
    my @result = ();
    if ($mesh{$term}){
	foreach my $concept(keys %{$mesh{$term}}){
	    push @result, "$mesh{$term}{$concept}/$concept";
	}
    }
    return @result;
}

# ---
sub annotate_corpus{
    print STDERR "\n";
    my $file = shift;
    $/ = "</PubmedArticle>";
    open(PUB, $fPub);
    open(OUT, ">$file");
    print OUT "<xon-mwt corpus=\"$fPub\">\n";
    my $dcount = 0;    
    while (my $article = <PUB>){
	my %wLattice = (); #word lattice
	my %cLattice = (); #concept lattice
	my $pmid = $1 if ($article =~ /<PMID>(.*?)<\/PMID>/ogs);
	$dcount++;
	if ($pmid){
	    my $title    = "";
	    my $abstract = "";
	    if ($article =~ /<ArticleTitle>(.*?)<\/ArticleTitle>/ogs){
		$title = $1;
	    }
	    if ($article =~ /<AbstractText>(.*?)<\/AbstractText>/ogs){
		$abstract = $1;
	    }
	    print STDERR "\rparsing document $dcount  with PMID=$pmid";
	    my $text = "$title\n$abstract";
	    print OUT "<doc id=\"$pmid\">\n";
	    print OUT "   <text>$text</text>\n" if ($log);
	    $text =~ s/\. |, |-|:|\"/ /ogs;
	    $text =~ s/\s+/ /ogs;
	    my @words = split(/ /, $text);
	    my %concepts = ();

	    my $wc = 0;
	    my %nodoubles = ();
	    foreach my $word(@words){
		$wc++;
		my @cs = &get_concepts($word);
		foreach my $c(@cs){
		    $concepts{$c}++;
		    $cLattice{$c}{$wc} = 1;
		    $wLattice{$wc} = $c;
		}		
	    }
	    
	    foreach my $concept(keys %cLattice){
		my @temp = ();
		my $tc = 0;
		foreach my $l (keys %{$cLattice{$concept}}){
		    $tc++;
		    push @temp, $l;
		}
		next if ($tc < 2);
		@temp = sort { $a <=> $b} @temp;
		my $coAndNr = ();
		my $nr      = ();
		my $co      = ();
		if ($concept =~ /(.*?)\/((.*) \(\d*\))/og){
		    $coAndNr = $2;
		    $nr      = $1;
		    $co      = $3;
		}
		my %oneWordPerConcept = ();
		my @newTemp = ();
		foreach my $test(@temp){
		    #print STDERR "\n$co -> $test: $words[$test]";
		    if($oneWordPerConcept{lc($words[$test-1])}){
			#print STDERR "    skipped";
		    }
		    else{
			$oneWordPerConcept{lc($words[$test-1])}++;
			push(@newTemp, $test);
		    }
		}
		if (($#newTemp > 0) && ($#newTemp > ($cls{$coAndNr}-2)) && (($newTemp[$#newTemp] - $newTemp[0]) < $frame)){
		    if($nodoubles{$co}{@newTemp}){
		    }
		    else{
			$nodoubles{$co}{@newTemp}++;
			print OUT "   <mwt name=\"$co\" textPos=\"@newTemp\">\n";
			print OUT "      <nr>$nr</nr>\n";
			if($log){
			    foreach my $w(@newTemp){
				print OUT "       <word>$words[$w-1]</word>\n";
			    }
			}
			print OUT "   </mwt>\n";
		    }
		}
	    }
	    print OUT "</doc>\n";
	}
	else{
	    #malformed (or last) article
	}
	
    }
    close(PUB);
    print OUT "</xon>\n";
    close(OUT);
    $/ = $lf;
}

# ------------------------------------------ </subs> ---


1;

__END__

=head1 NAME

Xon::quant - Quantitative Approach to Automatic Pattern Matching

=head2 Author

Sebastian Kreß, lepidium@hotmail.com

=head2 Project

xon, Seminar für Computerlinguistik der Ruprecht-Karls-Universität Heidelberg

=head1 DESCRIPTION

This module provides the qantitative approach to automatic pattern matching
with multiword patterns as entry terms for biomedical entities.

=head2 Functions

=over

=item read_mtrees( )

This (optional) function reads the mesh-tree structure from a file like mtrees2005.bin
in order to map tree positions to their names

=item read_mesh( )

Here, a mesh thesaurus like d2005.bin is analysed. Each concept with a multiword entry-term
is mapped to every part of the entry term: $mesh{part of entry}{heading} = mesh-number.

    <example>
    MeSH-heading: Magnetic Resonance Imaging
    entry terms:  Chemical Shift Imaging, MR Tomography, Magnetization Transfer Contrast Imaging
    mapping:      chemical -> MRI, shift -> MRI, imaging -> MRI ...
    </example> 

=item get_concepts( $term )

Returns all concepts that have $term as a part of their entry terms.

=item annotate_corpus( $file )

Annotates a medline-corpus $file with identified multiword entry terms within a given
frame $frame.

=head2 Input and output files

=head3 MeSH thesaurus

The MeSH thesaurus (d2005.bin) looks like the following:

    *NEWRECORD
    RECTYPE = D
    MH = Abducens Nerve
    AQ = AB AH BS CH CY DE EM EN GD IM ME MI PA PH PP PS RA RE RI SE SU TR UL US VI
    PRINT ENTRY = Cranial Nerve VI|T023|NON|EQV|NLM (1998)|960731|abcdef
    PRINT ENTRY = Sixth Cranial Nerve|T023|NON|EQV|NLM (1998)|960731|abcdef
    ENTRY = Abducent Nerve|T023|NON|EQV|UNK (19XX)|760526|abcdef
    ENTRY = Abducens Nerves
    ENTRY = Abducent Nerves
    ENTRY = Cranial Nerve VIs
    ENTRY = Cranial Nerve, Sixth
    ENTRY = Cranial Nerves, Sixth
    ENTRY = Nerve VI, Cranial
    ENTRY = Nerve VIs, Cranial
    ENTRY = Nerve, Abducens
    ENTRY = Nerve, Abducent
    ENTRY = Nerve, Sixth Cranial
    ENTRY = Nerves, Abducens
    ENTRY = Nerves, Abducent
    ENTRY = Nerves, Sixth Cranial
    ENTRY = Sixth Cranial Nerves
    ENTRY = VI, Cranial Nerve
    ENTRY = VIs, Cranial Nerve
    MN = A08.800.800.120.030
    EC = injuries:Abducens Nerve Injury
    MH_TH = NLM (1966)
    ST = T023
    AN = neopl = ABDUCENS NERVE DISEASES (IM) + CRANIAL NERVE NEOPLASMS (IM) + histol type of neopl (IM)
    MS = The 6th cranial nerve. The abducens nerve originates in the abducens nucleus of the pons and sends motor fibers to the lateral rectus muscles of the eye. Damage to the nerve or its nucleus disrupts horizontal eye movement control.
    OL = use ABDUCENS NERVE to search ABDUCENT NERVE 1966-76
    PM = 77; was ABDUCENT NERVE 1963-76
    HN = 77; was ABDUCENT NERVE 1963-76
    MED = *71
    MED = 119
    M90 = *114
    M90 = 165
    M85 = *159
    M85 = 238
    M80 = *122
    M80 = 211
    M75 = *95
    M75 = 202
    M66 = *154
    M66 = 314
    M94 = *129
    M94 = 185
    MR = 19991103
    DA = 19990101
    DC = 1
    UI = D000010

read_mesh( ) takes the field MH (mesh heading) and maps it to the content of  PRINT ENTRY, ENTRY and MN (mesh number) as described above.

=head3 Pubmed Corpus

The Pubmed corpus is taken from http://www.ncbi.nlm.nih.gov/entrez/query.fcgi?DB=pubmed. Each article looks like te following:

  <PubmedArticle>
    <MedlineCitation Owner="NLM" Status="MEDLINE">
        <PMID>15971341</PMID>
        <DateCreated>
            <Year>2005</Year>
            <Month>06</Month>
            <Day>22</Day>
        </DateCreated>
        <DateCompleted>
            <Year>2005</Year>
            <Month>07</Month>
            <Day>12</Day>
        </DateCompleted>
        <Article PubModel="Print">
            <Journal>
                <ISSN>0167-8140</ISSN>
                <JournalIssue>
                    <Volume>73 Suppl 2</Volume>
                    <PubDate>
                        <Year>2004</Year>
                        <Month>Dec</Month>
                    </PubDate>
                </JournalIssue>
            </Journal>
            <ArticleTitle>CNAO--The Italian Centre for Light-Ion Therapy.</ArticleTitle>
            <Pagination>
                <MedlinePgn>S191-201</MedlinePgn>
            </Pagination>
            <Abstract>
                <AbstractText>In 1991 the author involved the Italian institute of nuclear physics (INFN) in R&amp;D work in the field of hadrontherapy. In 1992 the TERA Foundation was created with the purpose of forming and employing people fully devoted to the design, promotion and construction of hadrontherapy centres in Italy and in Europe. The present contribution describes the main project of TERA, the CNAO (Centro Nazionale di Adroterapia Oncologica), and the status of its construction in Pavia. The Italian Centre is based on the optimised medical synchrotron designed in the framework of the "Proton Ion Medical Machine Study" (PIMMS) carried out at CERN from 1996 to 2000 with CERN, the Med-AUSTRO project, Oncology 2000 (Prague) and TERA as partners. In the following years TERA introduced modifications and improvements in the original PIMMS design producing what is now dubbed the PIMMS/TERA design. Since 2001 the construction of CNAO has been endorsed by the Italian government to the CNAO Foundation formed by five major hospitals, seated in Milan and Pave, and by TERA. Since 2003 INFN is an Institutional Participant. The site chosen at the beginning of 2003 (37,000 m2) is in the close vicinities of one of the five hospitals, the San Matteo University Hospital of Pave. The construction plan foresees the treatment of the first patient at the end of 2007.</AbstractText>
            </Abstract>
            <Affiliation>University of Milano Bicocca, Milan and TERA Foundation, Via Puccini 11, 28100 Novara, Italy. ugo.amaldi@cern.ch</Affiliation>
            <AuthorList CompleteYN="Y">
                <Author ValidYN="Y">
                    <LastName>Amaldi</LastName>
                    <ForeName>Ugo</ForeName>
                    <Initials>U</Initials>
                </Author>
            </AuthorList>
            <Language>eng</Language>
            <PublicationTypeList>
                <PublicationType>Journal Article</PublicationType>
            </PublicationTypeList>
        </Article>
        <MedlineJournalInfo>
            <Country>Ireland</Country>
            <MedlineTA>Radiother Oncol</MedlineTA>
            <NlmUniqueID>8407192</NlmUniqueID>
        </MedlineJournalInfo>
        <ChemicalList>
            <Chemical>
                <RegistryNumber>0</RegistryNumber>
                <NameOfSubstance>Protons</NameOfSubstance>
            </Chemical>
        </ChemicalList>
        <CitationSubset>IM</CitationSubset>
        <MeshHeadingList>
            <MeshHeading>
                <DescriptorName MajorTopicYN="N">Humans</DescriptorName>
            </MeshHeading>
            <MeshHeading>
                <DescriptorName MajorTopicYN="N">Italy</DescriptorName>
            </MeshHeading>
            <MeshHeading>
                <DescriptorName MajorTopicYN="N">Neoplasms</DescriptorName>
                <QualifierName MajorTopicYN="Y">radiotherapy</QualifierName>
            </MeshHeading>
            <MeshHeading>
                <DescriptorName MajorTopicYN="N">Protons</DescriptorName>
                <QualifierName MajorTopicYN="Y">therapeutic use</QualifierName>
            </MeshHeading>
            <MeshHeading>
                <DescriptorName MajorTopicYN="N">Synchrotrons</DescriptorName>
            </MeshHeading>
        </MeshHeadingList>
    </MedlineCitation>
    <PubmedData>
        <History>
            <PubMedPubDate PubStatus="pubmed">
                <Year>2005</Year>
                <Month>6</Month>
                <Day>23</Day>
                <Hour>9</Hour>
                <Minute>0</Minute>
            </PubMedPubDate>
            <PubMedPubDate PubStatus="medline">
                <Year>2005</Year>
                <Month>7</Month>
                <Day>13</Day>
                <Hour>9</Hour>
                <Minute>0</Minute>
            </PubMedPubDate>
        </History>
        <PublicationStatus>ppublish</PublicationStatus>
        <ArticleIdList>
            <ArticleId IdType="pubmed">15971341</ArticleId>
            <ArticleId IdType="medline">102307079</ArticleId>
        </ArticleIdList>
    </PubmedData>
  </PubmedArticle>

For the retrieval of multiword entry terms both the text in the fields <ArticleTitle> and in <Abstract> were used.

=head3 Result file

For each Pubmed article an entry in the output file is created like the following:

 <doc id="15971336">
   <mwt name="Cellular Structures" textPos="69 76">
      <nr>A11.284</nr>
   </mwt>
   <mwt name="Gamma Rays" textPos="63 64">
      <nr>H01.671.768.513.400</nr>
   </mwt>
   <mwt name="Models, Theoretical" textPos="183 192">
      <nr>H01.770.461</nr>
   </mwt>
   <mwt name="DNA Damage" textPos="3 14">
      <nr>C21.111</nr>
   </mwt>
   <mwt name="Chromosome Structures" textPos="69 91">
      <nr>A11.284.430.106.279.345.190.160</nr>
   </mwt>
   <mwt name="Chromosome Breakage" textPos="61 91">
      <nr>C21.111.099</nr>
   </mwt>
   <mwt name="Chromosome Aberrations" textPos="91 92">
      <nr>C23.550.210</nr>
   </mwt>
 </doc>

Each <mwt> shows the name of the identified MeSH heading, its MeSH number and the word numbers that indicated it.

=back



