Here's the residue renumbering perl script some people have
asked me for (provided as is, i.e., no guarantee, no support,
etc.):
MH
------------------------------cut-----------------------------------
#!/usr/bin/perl
############################################################################
####
# pdbresrenum3.pl
#
# Author:
# Mark Hsieh
# 8/19/02
#
# Description:
# This script renumbers the residue numbers in a pdb file so that there
# are no discontinuities in the numbering within each chain.
# Any numbering that involves letters in column 26 such as 100A, 100B,
100C,
# get renumbered sequentially as well (101, 102, 103,...)
# Atom numbers are not renumbered.
#
# Usage:
# pdbresrenum3.pl <input_pdbfile>
# pdbresrenum3.pl <input_pdbfile> [ > output_pdbfile ]
#
############################################################################
####
use strict;
my $res_count=0;
my $old_resname;
my $old_chain;
my $old_resnum;
my $new_resnum;
my $head;
my $tail;
my $resname;
my $chain;
my $resnum;
if (! $ARGV[0]) {
print "Usage:\n";
print "\tpdbresrenum3.pl <input_pdbfile>\n";
print "\tpdbresrenum3.pl <input_pdbfile> [ > output_pdbfile ]\n";
exit;
}
my $infile=$ARGV[0];
open(INFILE,"<$infile");
while (<INFILE>) {
if (/^ATOM|^HETATM|^TER/) {
chomp;
if (/^ATOM|^HETATM/) {
$head = substr($_,0,17);
$tail = substr($_,27,);
$resname = substr($_,17,4);
$chain = substr($_,21,1);
$resnum = substr($_,22,5);
}
if (($resname eq $old_resname) && ($chain eq $old_chain) && ($resnum eq
$old_resnum)) {
if (/^TER/) {
# Use and modify data from previous record.
my $atom=substr($head,12,5);
my $atomnum=substr($head,7,4);
my $new_atomnum=$atomnum+1;
my $new_atomnum=sprintf "%4i",$new_atomnum;
$head=~s/$atom/ /;
$head=~s/$atomnum/$new_atomnum/;
$head=~s/ATOM/TER /;
print $head.$resname.$chain.$new_resnum,"\n";
}
else {
print $head.$resname.$chain.$new_resnum.$tail,"\n";
}
next;
}
else {
if ($chain ne $old_chain) {
$res_count=0;
}
$res_count++;
$new_resnum=sprintf "%4s ",$res_count;
print $head.$resname.$chain.$new_resnum.$tail,"\n";
$old_resnum = $resnum;
$old_chain = $chain;
$old_resname = $resname;
}
}
}
Received on Tue Aug 20 2002 - 09:52:24 PDT
