Mercurial > repos > marpiech > norwich_tools_docking

comparison tools/rdock/lib/run_rbfuncs.pl @ 3:b02d74d22d05 draft default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
planemo upload
author marpiech
date Mon, 29 Aug 2016 08:23:52 -0400
parents
children
comparison
equal deleted inserted replaced
2:bd50f811878f 3:b02d74d22d05
1 #!/usr/bin/perl
2 # Perl functions for the run_rb* collection of automated docking scripts
3
4 use strict;
5
6 ################################################################################
7 # sub get_prm_table
8 #
9 # Purpose: return a hash table of
10 # key=parameter file name, value = file title
11 # for all .prm files in a directory
12 #
13 # Usage: %prm_table = get_prm_table($dir)
14 #
15 # Arguments:
16 # $prmDir - directory to search for .prm files
17 #
18 # Return parameters:
19 # %prm_table - hash table
20 #
21 sub get_prm_table {
22 #Arguments
23 my $prm_dir = shift;
24
25 #Local variables
26 my @prm_list;
27 my %prm_table;
28 my $TITLEREC = "TITLE ";
29 my $file;
30 my $title;
31 my @titleLines;
32
33 #Get the list of files ending in .prm
34 @prm_list = glob "$prm_dir/*.prm";
35
36 #Read each file and extract the title record
37 foreach $file (@prm_list) {
38 open PRMHANDLE,$file;
39 @titleLines = grep /^$TITLEREC/,<PRMHANDLE>;
40 close PRMHANDLE;
41 #Extract just the file name from the full path
42 my $prmName = substr($file, rindex($file,"/")+1);
43 #Check if a title record was found
44 if (scalar @titleLines) {
45 $title = substr $titleLines[0],length($TITLEREC);
46 chomp $title;
47 $prm_table{$prmName} = $title;
48 }
49 else {
50 $prm_table{$prmName} = "No title";
51 }
52 }
53 return %prm_table;
54 }
55 ################################################################################
56 # sub get_dock_table
57 #
58 # Purpose: Modified version of get_prm_table
59 # specific for the RBT_LIGDB docking database
60 # Return a hash table of
61 # key=docking library, value = expression for all sd files in that library
62 #
63 # Assumes that all subdirs within $db_dir are separate vendor libraries,
64 # and that each subdir contains a set of compressed .sd.gz files
65 #
66 # Usage: %dock_table = get_dock_table($dir)
67 #
68 # Arguments:
69 # $db_dir - directory to search for docking libraries
70 #
71 # Return parameters:
72 # %dock_table - hash table#
73 #
74 sub get_dock_table {
75 #Arguments
76 my $db_dir = shift;
77
78 #Local variables
79 my ($lib,$sdfiles);
80 my (@lib_list,@sd_list);
81 my %dock_table;
82
83 opendir DBDIR,$db_dir;
84 @lib_list = readdir DBDIR;
85 closedir DBDIR;
86
87 foreach $lib (sort @lib_list) {
88 if (-d "$db_dir/$lib") {
89 $sdfiles = "$db_dir/$lib/*.sd*";
90 @sd_list = glob $sdfiles;
91 my $n = scalar(@sd_list);
92 if ($n > 0) {
93 $dock_table{"$lib ($n files)"} = $sdfiles;
94 }
95 }
96 }
97
98 return %dock_table;
99 }
100 #
101 ################################################################################
102 # sub get_selection
103 #
104 # Purpose: allow a user to select from
105 # a list of parameter files.
106 #
107 # Usage: $receptor = get_selection(\%prm_table,"receptor")
108 #
109 # Arguments:
110 # $prm_table_ref - reference to hash table returned by get_prm_table
111 # $name - descriptive name for items (e.g. "receptor" or "script"
112 #
113 # Return parameters:
114 # $item - selected items (key into %prm_table)
115 #
116 sub get_selection {
117 #Arguments
118 my $prm_table_ref = shift;
119 my $name = shift;
120
121 #Local variables
122 my @items = sort keys %$prm_table_ref;
123 my $nItems = scalar @items;
124 my ($i,$itemNum,$item);
125 my $inRange;
126
127 print "\n\n$name selection:\n\n";
128 $i=1;
129 foreach $item (@items) {
130 print "$i\t$item\t$$prm_table_ref{$item}\n";
131 $i++;
132 }
133 do {
134 print "\nEnter the $name number: ";
135 $itemNum = <STDIN>;
136 chomp $itemNum;
137 print "\n";
138 $inRange = (($itemNum >= 1) && ($itemNum <= $nItems));
139 print "$itemNum is out of range\n" if (!$inRange);
140 } until ($inRange);
141
142 print "\nYou have selected the following $name\n";
143 $item = $items[$itemNum-1];
144 print "$itemNum\t$item\t$$prm_table_ref{$item}\n";
145 return $item;
146 }
147
148 ################################################################################
149 # sub get_multiple_selection
150 #
151 # Purpose: allow a user to multiply select from the docking library list
152 #
153 # Usage: $receptor = get_selection(\%prm_table,"receptor")
154 #
155 # Arguments:
156 # $prm_table_ref - reference to hash table returned by get_prm_table
157 # $name - descriptive name for items (e.g. "receptor" or "script"
158 #
159 # Return parameters:
160 # $item - selected items (key into %prm_table)
161 #
162 sub get_multiple_selection {
163 #Arguments
164 my $prm_table_ref = shift;
165 my $name = shift;
166
167 #Local variables
168 my @items = sort keys %$prm_table_ref;
169 my $nItems = scalar @items;
170 my ($i,$idstring,$itemNum,$item);
171 my @itemNums;
172 my @selectedItems;
173 my $inRange;
174 my $allInRange;
175
176 print "\n\n$name selection:\n\n";
177 $i=1;
178 foreach $item (@items) {
179 print "$i\t$item\t$$prm_table_ref{$item}\n";
180 $i++;
181 }
182 do {
183 print "\nEnter the $name number(s): ";
184 my $idstring = <STDIN>;
185 chomp $idstring;
186 @itemNums = get_ids($idstring);
187 print "\n";
188 $allInRange = 1;
189 foreach $itemNum (@itemNums) {
190 $inRange = (($itemNum >= 1) && ($itemNum <= $nItems));
191 print "$itemNum is out of range\n" if (!$inRange);
192 $allInRange = $allInRange && $inRange;
193 }
194 } until ($allInRange);
195
196 print "\nYou have selected the following $name(s)\n";
197 foreach $itemNum (@itemNums) {
198 $item = $items[$itemNum-1];
199 push @selectedItems,$item;
200 print "$itemNum\t$item\t$$prm_table_ref{$item}\n";
201 }
202 return @selectedItems;
203 }
204
205 ################################################################################
206 # sub get_input
207 #
208 # Purpose: get user input, or returns default if no response given
209 #
210 # Usage: $nRuns = get_input("Enter no. of runs per ligand",10)
211 #
212 # Arguments:
213 # $question - text of question to ask
214 # $defResponse - default answer
215 #
216 # Return parameters:
217 # $response - user response, or default
218
219 sub get_input {
220 #Arguments
221 my $question = shift;
222 my $defResponse = shift;
223 print "$question [$defResponse]: ";
224 my $response = <STDIN>;
225 chomp $response;
226 $response = $defResponse if ($response eq "");
227 return $response;
228 }
229
230 # Based on //depot/intranet/1.0/lib/rbt_func.pl#1
231 # this function converts a list of ids in one string
232 # in the format 1,2,4-6,8,15-20
233 # and returns an @array with the unique ids
234 sub get_ids {
235 my $idstring = shift;
236 my %ids;
237
238 foreach my $id (split (',',$idstring)){
239 if ( grep (/-/,$id)){
240 (my $low, my $up) = split ('-',$id);
241 for ( my $co = $low; $co <= $up; $co++ ){
242 $ids{$co}=$co;
243 }
244 }
245 else {
246 $ids{$id}=$id;
247 }
248 }
249
250 return (sort {$a<=>$b} keys %ids);
251 }
252 ################################################################################
253 # sub get_filter_table
254 #
255 # Purpose: return a hash table of
256 # key=filter file name, value = file title
257 # for all .filter files in a directory
258 #
259 # Usage: %filter_table = get_filter_table($dir)
260 #
261 # Arguments:
262 # $filterDir - directory to search for .filter files
263 # $tmp - temperature for first filter
264 # Note:
265 # The first two filters are not in a file, but are created here
266 #
267 # Return parameters:
268 # %filter_table - hash table
269 #
270 sub get_filter_table {
271 #Arguments
272 my $filter_dir = shift;
273 my $tmp = shift;
274
275 #Local variables
276 my $pwd = $ENV{"PWD"};
277 my @filter_list;
278 my %filter_table;
279 my $file;
280
281 #Get the list of files ending in .filter
282 @filter_list = ((glob "$pwd/*.filter"), (glob "$filter_dir/*.filter"));
283 $filter_table{"1no_other_filters"} = "";
284 # $filter_table{"1threshold"} = "\tSCORE.INTER < $tmp";
285 # $filter_table{"2cavity"} = "\t\tSCORE.RESTR.CAVITY < 1 ";
286
287 #Read each file and extract the title record
288 foreach $file (@filter_list) {
289 #Extract just the file name from the full path
290 my $filterName = substr($file, rindex($file,"/")+1);
291 #Check if a title record was found
292 $filter_table{$filterName} = "No title";
293 }
294 return %filter_table;
295 }
296 1;