File Coverage

blib/lib/openStatisticalServices.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package OpenStatisticalServices;
2            
3             our $VERSION = '0.022';
4            
5 1     1   24292 use 5.008008;
  1         3  
  1         39  
6 1     1   5 use strict;
  1         2  
  1         29  
7 1     1   5 use warnings;
  1         5  
  1         34  
8            
9 1     1   4 use File::Find;
  1         1  
  1         83  
10 1     1   430 use Math::Expression;
  0            
  0            
11             use Data::Dumper;
12            
13             require Exporter;
14            
15             our @ISA = qw(Exporter);
16            
17             our %EXPORT_TAGS = ( 'all' => [ qw(
18            
19             ) ] );
20            
21             our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
22            
23             our @EXPORT = qw(
24             Util_convertToLambdaExpression
25             Util_convertLambdaExpressionToCSVForm
26             Util_convertNONMEMInputFileToCSVForm
27             Util_convertDirectoryOfNONMEMInputFilesToCSVForm
28             Util_convertDirectoryOfTypedLambdaCalculusFilesToCSVForm
29             Util_convertDirectoryOfNONMEMInputFilesToStatML
30             Util_convertDirectoryOfStatMLDataFilesToTypedLambdaCalculus
31             Util_optimizeDirectoryOfTypedLambdaCalculusFiles
32             Util_convertNONMEMDataFilesToTypedLambdaCalculus
33             Util_convertStatMLDataToTypedLambdaCalculus
34             Util_getSomeTypeOfDataFromStatMLInDirectory
35             Util_convertStatMLDataToCSVForm
36             Util_isInList
37             TLC_getModel
38             TLC_getSetOfEquations
39             TLC_getExpression
40             TLC_getSubExpression
41             TLC_getVector
42             TLC_getSetOfVectors
43             TLC_getSingleVector
44             TLC_getLengthOfFirstDimension
45             TLC_OptimizeTLCFile
46             PK_regularizeFileName
47             PK_regularizeFileNamesInGivenDirectory
48             NONMEM_convertCSVDataToNONMEMForm
49             NONMEM_doSetOfRuns
50             NONMEM_getHypernormalizedVersionOfDatasets
51             NONMEM_convertParsedNONMEMOutputsToTypedLambdaCalculus
52             NONMEM_removeHeaderlinesFromTABFiles
53             MONOLIX_splitModelsAccordingToDosing
54             MONOLIX_formatMonolixFilesInGivenDirectory
55             parseModelFile
56             );
57            
58             # Preloaded methods go here.
59            
60             =head1 NAME
61            
62             OpenStatisticalServices - Perl extension for representation and use of systems of statistical models using algebraic methods.
63            
64             =head1 SYNOPSIS
65            
66             use OpenStatisticalServices;
67            
68             =head1 DESCRIPTION
69            
70             This module gives a set of tools for representing and using statistical models using algebraic theories; we also make use of
71             what is called the functorial semantics of algebraic theories.
72            
73             =head2 EXPORT
74            
75             None by default.
76            
77             =head1 SEE ALSO
78            
79             Mention other useful documentation such as the documentation of
80             related modules or operating system documentation (such as man pages
81             in UNIX), or any relevant external documentation such as RFCs or
82             standards.
83            
84             If you have a mailing list set up for your module, mention it here.
85            
86             Please see the web site http://openServices.SourceForge.net for details.
87            
88             =head1 AUTHOR
89            
90             Rich Haney@rhaney@cellularStatistics.com
91            
92             =head1 COPYRIGHT AND LICENSE
93            
94             Copyright (C) 2004 - 2008 by Rich Haney
95            
96             All rights reserved.
97            
98             You may freely distribute and/or modify this module under the terms of the GNU General Public License (GPL).
99            
100             =cut
101            
102             #-----------------------------------------------------------------------
103            
104            
105             sub new {
106             my $package = shift;
107             return bless({}, $package);
108             }
109            
110             sub verbose {
111             my $self = shift;
112             if ($_) {
113             $self->{'verbose'} = shift;
114             }
115             return $self->{'verbose'};
116             }
117            
118             sub hoot {
119             my $self = shift;
120             return "Don't pollute!" if $self->{'verbose'};
121             return;
122             }
123            
124             #---------------------------------------------------------------------------------
125            
126             my $improveThis; #this is an indication that I need to improve some aspect of coding.
127            
128             #---------------------------------------------------------------------------------
129             #package OpenStatisticalServices::Util
130            
131             sub Util_optimizeDirectoryOfTypedLambdaCalculusFiles
132             {
133             if ( scalar(@_) < 4 )
134             {
135             print "Sorry, error - usage is Util_optimizeDirectoryOfTypedLambdaCalculusFiles(inputsDirectory,extension,outputsDirectory,outExtension)\n";
136             exit;
137             }
138             my ( $inputsDirectory,$extension,$outputsDirectory, $outExtension ) = @_;
139            
140             my $oldFileInputSeparator = $/;
141            
142             $/ = "\n";
143            
144             opendir(RUNDIR,$inputsDirectory) or die("Could not open run directory $inputsDirectory\n");
145             my @files = grep ( /\.$extension/i, readdir(RUNDIR));
146             close(READDIR);
147            
148             foreach my $fileIn ( @files )
149             {
150             print $fileIn,"\n";
151             my $fileOut = $fileIn;
152             $fileOut =~ s/\.$extension/\.$outExtension/ig;
153             TLC_OptimizeTLCFile("$inputsDirectory/$fileIn","$outputsDirectory/$fileOut");
154             }
155            
156             $/ = $oldFileInputSeparator;
157            
158             }
159            
160             sub Util_convertDirectoryOfNONMEMInputFilesToStatML
161             {
162             if ( scalar(@_) < 3 )
163             {
164             print "Sorry, error - usage is Util_convertDirectoryOfNONMEMInputFilesToStatML(inputsDirectory,extension,outputsDirectory)\n";
165             exit;
166             }
167             my ( $inputsDirectory,$extension,$outputsDirectory ) = @_;
168            
169             my $oldFileInputSeparator = $/;
170            
171             $/ = "\n";
172            
173             opendir(RUNDIR,$inputsDirectory) or die("Could not open run directory $inputsDirectory\n");
174             my @files = grep ( /$extension$/i, readdir(RUNDIR));
175             close(READDIR);
176            
177             foreach my $fileIn ( @files )
178             {
179             print $fileIn,"\n";
180             my $fileOut = $fileIn;
181             $fileOut =~ s/$extension$/\.xml/ig;
182             $fileOut =~ s/\.\./\./g;
183             Util_convertNONMEMInputFileToStatML("$inputsDirectory/$fileIn",$outputsDirectory, "$fileOut");
184             }
185            
186             $/ = $oldFileInputSeparator;
187            
188             }
189            
190             sub Util_convertNTupleAsStringToVector
191             {
192             my $infoString = $_[0];
193             $infoString =~ s/.*=//g;
194             $infoString =~ s/\[|\]//g;
195             $infoString =~ s/,/ /g;
196             $infoString =~ s/^\s+|\s+$//g;
197             my @parameters = split(/\s+/,$infoString);
198             return (@parameters);
199            
200             }
201            
202            
203             sub Util_convertNONMEMInputFileToStatML
204             {
205             my ( $file, $outputsDirectory, $fileOut ) = @_;
206            
207             my @overallDatasetTypes = ("primary","secondary");
208             my @overallFieldTypes = ("observations","inputs");
209            
210             open (INPUTFILE,"$file") or die ("Could not open input file $file\n");
211            
212             my @data = ;
213             chomp @data;
214             close(INPUTFILE);
215            
216             $| = 1;
217            
218             my @dataLinesSplitRefs = ();
219             my @firstLineForSubject;
220             my $iSubject = -1;
221            
222             $data[0] =~ s/^[\s#]+//g;
223             $data[0] = uc ($data[0]);
224             my @headerHere = split(/\s+|,/,$data[0]);
225            
226             my $items = scalar(@headerHere);
227            
228             my $iEventFieldId = -1;
229             my $iDoseFieldId = -1;
230             my $iRateFieldId = -1;
231             my @inputs = ();
232            
233             my @outputs = ();
234             my @rates = ();
235             my @excluded = ();
236             my @fieldLengths = ();
237             my @isVector = ();
238             my @fieldTypes = ();
239             my @attributeStringsForSubjects = ();
240             my @dataIsDifferentForIndividuals = ();
241            
242             for ( my $iHeader = 0; $iHeader < $items; $iHeader++ )
243             {
244             $isVector[$iHeader] = 0;
245             $excluded[$iHeader] = 0;
246             $fieldTypes[$iHeader] = 'fn(AMT) ';
247             $fieldLengths[$iHeader] = 3;
248             $dataIsDifferentForIndividuals[$iHeader] = 0;
249            
250             my $headerLabel = uc($headerHere[$iHeader]);
251            
252             if ( $headerLabel =~ /EVID.*/i )
253             {
254             $iEventFieldId = $iHeader;
255             $excluded[$iHeader] = 1;
256             }
257             elsif ( $headerLabel =~ /MDV.*/i )
258             {
259             $excluded[$iHeader] = 1;
260             }
261             elsif ( $headerLabel =~ /TIME.*/i )
262             {
263             $fieldTypes[$iHeader] = "indepen ";
264             $isVector[$iHeader] = 1;
265             push(@inputs, $iHeader);
266             push(@outputs,$iHeader);
267             }
268             elsif ( $headerLabel =~ /AMT.*/i )
269             {
270             $iDoseFieldId = $iHeader;
271             $fieldTypes[$iHeader] = "ind(TIME)";
272             push(@inputs,$iDoseFieldId);
273             }
274             elsif ( $headerLabel =~ /RATE.*/i )
275             {
276             $iRateFieldId = $iHeader;
277             $fieldTypes[$iHeader] = "ind(TIME)";
278             push(@inputs,$iRateFieldId);
279             $dataIsDifferentForIndividuals[$iHeader] = 1;
280             }
281             elsif ( $headerLabel =~ /LNDV.*/i )
282             {
283             $fieldTypes[$iHeader] = "fn(DV)";
284             push(@outputs,$iHeader);
285             }
286             else
287             {
288             push(@outputs,$iHeader);
289             }
290             }
291            
292             my $iMaxSubject = 0;
293             my $iMaxLines = 0;
294             my $zeroSubject = 0;
295            
296             for ( my $i = 0; $i <= $#data; $i++ )
297             {
298             my @eachLine;
299             next unless $data[$i] =~ /\w/;
300            
301             $data[$i] =~ s/^[\s#]+//g;
302             @eachLine = split(/\s+|,/,$data[$i]);
303             $dataLinesSplitRefs[$iMaxLines] = \@eachLine;
304             if ( $eachLine[0] eq '0' )
305             {
306             if ( $zeroSubject == 0 )
307             {
308             $zeroSubject = $iMaxSubject+1;
309             }
310             $eachLine[0] = $zeroSubject;
311             }
312             if ( $iEventFieldId > -1 && $eachLine[$iEventFieldId] eq '2' )
313             {
314             $eachLine[$iEventFieldId] = 0;
315             }
316             my $iSubjectHere = $eachLine[0];
317             if ( $iSubject ne $iSubjectHere )
318             {
319             $iSubject = $iSubjectHere;
320             push(@firstLineForSubject,$iMaxLines);
321             }
322             $dataLinesSplitRefs[$iMaxLines] = \@eachLine;
323             if ( $iSubject =~ /\d+/ && $iSubject > $iMaxSubject )
324             {
325             $iMaxSubject = $iSubject;
326             }
327             $iMaxLines++;
328             }
329            
330             my @subjects;
331             for ( my $iSubject1 = 1; $iSubject1 <= $iMaxSubject; $iSubject1++)
332             {
333             $subjects[$iSubject1] = $iSubject1;
334             }
335            
336             push ( @firstLineForSubject, $iMaxLines);
337            
338             my $lastLineRef = $dataLinesSplitRefs[$#dataLinesSplitRefs];
339             my @lastLine = @$lastLineRef;
340            
341             my @firstDoseForIndividuals = ();
342            
343             for ( my $iEventId = 0; $iEventId <= 1; $iEventId++ )
344             {
345             for ( my $id = 1; $id <= $iMaxSubject; $id++)
346             {
347             for ( my $iField = 0; $iField < $items; $iField++ )
348             {
349             my $aName = $headerHere[$iField];
350             $aName =~ s/\"//g;
351             my $iFirstLine = $firstLineForSubject[$id];
352             my $lineRef = $dataLinesSplitRefs[$iFirstLine];
353             unless ( $lineRef =~ /ARRAY/)
354             {
355             print "Error at subject $id, field $iField, lineRef $lineRef \n";
356             exit;
357             }
358             my @dataForLine = @$lineRef;
359             my @inputsHere = $dataForLine[$iDoseFieldId];
360             if ( $iRateFieldId > -1 )
361             {
362             push(@inputsHere, $dataForLine[$iRateFieldId]);
363             }
364            
365             $firstDoseForIndividuals[$id-1] = \@inputsHere;
366             my $iLastLine = $firstLineForSubject[$id+1]-1;
367             my $numItems = $iLastLine - $iFirstLine + 1;
368             my @dataList = ();
369            
370             my $value = "";
371             for ( my $iLine = $iFirstLine; $iLine <= $iLastLine; $iLine++ )
372             {
373             my $lineNextRef = $dataLinesSplitRefs[$iLine];
374             my @dataForNextLine = @$lineNextRef;
375             my $iEventIdForLine = 0;
376             if ( $iEventFieldId > -1 )
377             {
378             $iEventIdForLine = toInteger($dataForNextLine[$iEventFieldId]);
379             }
380             next unless ( $iEventIdForLine eq $iEventId);
381            
382             my $datum = $dataForNextLine[$iField];
383            
384             if ( $value eq "" )
385             {
386             $value = $datum;
387             next;
388             }
389             elsif ( $value ne $datum)
390             {
391             $isVector[$iField] = 1;
392             }
393             my $len = length($datum);
394             if ( $len > $fieldLengths[$iField])
395             {
396             $fieldLengths[$iField] = $len;
397             }
398             }
399             }
400             }
401             }
402            
403             my $recordsPerSubject = $firstLineForSubject[2] - $firstLineForSubject[1];
404             for ( my $iEventId = 0; $iEventId <= 1; $iEventId++ )
405             {
406             for ( my $iField = 0; $iField < $items; $iField++ )
407             {
408             for ( my $iLine = 1; $iLine <= $recordsPerSubject; $iLine++ )
409             {
410             my $value = "";
411            
412             for ( my $iSubject = 1; $iSubject <= $iMaxSubject; $iSubject++ )
413             {
414             my $i = $iLine + ($iSubject-1) * $recordsPerSubject;
415             my $lineRef = $dataLinesSplitRefs[$i];
416             unless ( $lineRef =~ /ARRAY/)
417             {
418             $dataIsDifferentForIndividuals[$iField] = 1;
419             last;
420             }
421             my @data = @$lineRef;
422             my $iEventIdForLine = 0;
423             if ( $iEventFieldId > -1 )
424             {
425             $iEventIdForLine = toInteger($data[$iEventFieldId]);
426             }
427            
428             next unless ($iEventIdForLine eq $iEventId);
429            
430             my $datum = $data[$iField];
431             if ( $value eq "" )
432             {
433             $value = $datum;
434             next;
435             }
436             elsif ( $value ne $datum)
437             {
438             $dataIsDifferentForIndividuals[$iField] = 1;
439             last;
440             }
441             }
442             last if ( $dataIsDifferentForIndividuals[$iField]);
443             }
444             }
445             }
446            
447             my $alsoWriteXMLTabFile = 0;
448             if ( $alsoWriteXMLTabFile )
449             {
450             open(IFILETAB,">$outputsDirectory/$fileOut.tab" ) or die("Count not open data file\n");
451             print IFILETAB join("\t",@headerHere),"\n";
452            
453             for ( my $i = 1; $i <= $#dataLinesSplitRefs; $i++ )
454             {
455             my @data = @{$dataLinesSplitRefs[$i]};
456             for ( my $j = 0; $j < scalar(@data);$j++)
457             {
458             if ( $data[$j] eq "." )
459             {
460             $data[$j] = "nan";
461             }
462             }
463             print IFILETAB join("\t",@data),"\n";
464             }
465             close(IFILETAB);
466             }
467            
468             open(IFILE,">$outputsDirectory/$fileOut" ) or die("Count not open data file $file.xml for outputs in $outputsDirectory\n");
469            
470             print IFILE <
471            
472            
473             TOP
474            
475             for ( my $iDatasetType = 0; $iDatasetType <=1; $iDatasetType++ )
476             {
477             my $indentForDataset = "";
478             if ( $iDatasetType == 1 )
479             {
480             $indentForDataset = " ";
481             print IFILE q(),"\n";
482             }
483            
484             for ( my $iEventType = 1; $iEventType >= 0; $iEventType-- )
485             {
486             my @fields;
487             if ( $iEventType eq 1 )
488             {
489             @fields = @inputs;
490             }
491             else
492             {
493             @fields = @outputs;
494             }
495            
496             print IFILE $indentForDataset,"<", $overallFieldTypes[$iEventType], ">\n";
497             my $iNumHereLast = 0;
498            
499             my $doCompress = 0;
500            
501             for ( my $iFieldInList = 0 ; $iFieldInList < scalar(@fields); $iFieldInList++ )
502             {
503            
504             my $iField = $fields[$iFieldInList];
505             my $aName = $headerHere[$iField];
506            
507             #rph note -- used to have TIME here.
508             next if ( $aName ne "TIME" && ( $iEventType == 1 && ( $iDatasetType == $dataIsDifferentForIndividuals[$iField])));
509             for ( my $id = 1; $id <= $iMaxSubject; $id++)
510             {
511             #Next is for vectors.
512             next unless ( $isVector[$iField] == 1) || $iEventType == 1;
513            
514             last if ( $id > 1 && ! $dataIsDifferentForIndividuals[$iField] );
515            
516             $aName =~ s/\"//g;
517             my $iFirstLine = $firstLineForSubject[$id];
518             my $iLastLine = $firstLineForSubject[$id+1]-1;
519            
520             my $numItems = $iLastLine - $iFirstLine + 1;
521             my @dataList = ();
522            
523             my @dataHere;
524            
525             for ( my $i = $iFirstLine; $i <= $iLastLine; $i++ )
526             {
527             @dataHere = @{$dataLinesSplitRefs[$i]};
528             my $iSubject = $dataHere[0];
529             my $iEvent = $dataHere[$iEventFieldId];
530             my $iEventIdForLine = 0;
531             if ( $iEventFieldId > -1 )
532             {
533             $iEventIdForLine = toInteger($dataHere[$iEventFieldId]);
534             }
535            
536             next unless ($iEventIdForLine eq $iEventType);
537             my $datum = $dataHere[$iField];
538             push(@dataList,$datum);
539             }
540            
541             my $aLine = "";
542             my $numHere = $#dataList+1;
543             my $iFieldLength = $fieldLengths[$iField];
544             if ( $iEventType == 0 )
545             {
546             $iFieldLength = 8;
547             }
548            
549             #$aLine .= "\n";
550             my $bNotFirst = 0;
551             if ( $numHere > 1 )
552             {
553             $aLine .= "\[ ";
554             }
555            
556             for ( my $i = 0; $i <= $numHere; $i++ )
557             {
558             my $datum = $dataList[$i];
559            
560            
561             if ( defined($datum))
562             {
563             my $aFormattedDatum = sprintf("%10.2f",$datum);
564            
565             my $strlen = $iFieldLength - length($aFormattedDatum)+1;
566             if ( $strlen < 1 )
567             {
568             $strlen = 1;
569             }
570             if ( $doCompress & ( $bNotFirst && ! $isVector[$iField]))
571             {
572             $aFormattedDatum = ' ' x length($aFormattedDatum);
573             }
574             else
575             {
576             $bNotFirst = 1;
577             }
578             $aLine .= " " x $strlen;
579             $aLine .= $aFormattedDatum;
580             }
581             }
582             if ( $numHere > 1 )
583             {
584             $aLine .= "\] ";
585             }
586            
587             if ( $iNumHereLast == 0 )
588             {
589             $iNumHereLast = $numHere;
590             }
591             if ( $iNumHereLast != $numHere )
592             {
593             #print IFILE "\n";
594             $iNumHereLast = $numHere;
595             }
596            
597             print IFILE
598             q(
599            
600             my $aName = $headerHere[$iField];
601             my $iPaddingForName = 4 - length($aName);
602             print IFILE "name",
603             "=",
604             q("),
605             $aName,
606             ' ' x $iPaddingForName,
607             q(" );
608            
609             my $idToUse = $id;
610             if ( ! $dataIsDifferentForIndividuals[$iField] )
611             {
612             $idToUse = "*";
613             }
614             my $iPaddingForID = 3 - length($idToUse);
615            
616             print IFILE "ID",
617             "=",
618             q("),
619             $idToUse,
620             ' ' x $iPaddingForID,
621             q(" );
622            
623             my $aString = "";
624             for ( my $iField1 = 0; $iField1 < scalar(@headerHere); $iField1++ )
625             {
626             next if $isVector[$iField1];
627             next if $excluded[$iField1];
628             next if $dataHere[$iField1] eq ".";
629             my $aName = $headerHere[$iField1];
630             if ( ! defined($aName))
631             {
632             print "Warning - no name for field $iField1\n";
633             }
634             #Improve this.
635             next if $aName eq "ID";
636            
637             my $iPaddingForName = 4 - length($aName);
638             if ( ! defined($dataHere[$iField1] ))
639             {
640             $dataHere[$iField1] = "";
641             }
642            
643             my $aFormattedDatum = sprintf("%10.2f",$dataHere[$iField1]);
644             my $iPaddingForValue = $fieldLengths[$iField1] - length($aFormattedDatum);
645            
646             my $totalPaddingForValue = "";
647             if ( $iPaddingForValue > 0 )
648             {
649             $totalPaddingForValue = ' ' x $iPaddingForValue;
650             }
651            
652            
653             $aString .= $aName .
654             "=" .
655             q(") .
656             $aFormattedDatum .
657             $totalPaddingForValue .
658             q(" );
659             }
660             $attributeStringsForSubjects[$id] = $aString;
661            
662             if ( $dataIsDifferentForIndividuals[$iField])
663             {
664             print IFILE $aString;
665             }
666             elsif ( $iEventType == 0 )
667             {
668             print IFILE ' ' x length($aString);
669             }
670            
671             my $iPadding = 3 - length($numHere);
672             my $iPaddingForType = 8 - length($fieldTypes[$iField]);
673             print IFILE
674             q(type="),
675             $fieldTypes[$iField],
676             ' ' x $iPaddingForType,
677             q(" ),
678             q(format="float" dim="),
679             $numHere,
680             ' ' x $iPadding,
681             q(");
682            
683             print IFILE
684             q(>),
685             $aLine;
686            
687             print IFILE
688             " \n";
689            
690            
691             unless ( $dataIsDifferentForIndividuals[$iField])
692             {
693             if ( $iEventType > 0 && $iDatasetType == 1)
694             {
695            
696             for ( my $iDatum = 0; $iDatum <= 1; $iDatum++)
697             {
698            
699             my $inputField = $iDoseFieldId;
700             if ( $iDatum > 0 )
701             {
702             if ( $iRateFieldId == 0 )
703             {
704             next;
705             }
706            
707             $inputField = $iRateFieldId;
708             }
709             my $aLine = Util_getNONMEMDataLine(\@firstDoseForIndividuals,$iDatum,$iFieldLength);
710             my $numHere = scalar(@firstDoseForIndividuals);
711            
712             my $iFieldLength = $fieldLengths[$iDoseFieldId];
713            
714             if ( $iNumHereLast == 0 )
715             {
716             $iNumHereLast = $numHere;
717             }
718             if ( $iNumHereLast != $numHere )
719             {
720             print IFILE "\n";
721             $iNumHereLast = $numHere;
722             }
723             print IFILE
724             q(
725            
726             my $aName = $headerHere[$inputField];
727             my $iPaddingForName = 4 - length($aName);
728             print IFILE "name",
729             "=",
730             q("),
731             $aName,
732             ' ' x $iPaddingForName,
733             q(" ),
734             q(ID="* " );
735            
736             my $iPaddingHere = 3 - length($numHere);
737             my $iPaddingForField = 8 - length($fieldTypes[$inputField]);
738             print IFILE
739             q(type="),
740             $fieldTypes[$inputField],
741             ' ' x $iPaddingForField,
742             q(" ),
743             q(format="float" dim="),
744             $numHere,
745             ' ' x $iPaddingHere ,
746             q(");
747            
748             print IFILE
749             q(>),
750             $aLine;
751            
752             print IFILE
753             " \n";
754            
755             if ( 0 )
756             {
757             open(CSVFILE,">$file.inputs.csv" ) or die("Count not open csv file\n");
758             print CSVFILE $aName,
759            
760             my $iPadding = 3 - length($numHere);
761            
762             print CSVFILE
763             q(format="float" dim="),
764             $numHere,
765             ' ' x $iPadding,
766             q(");
767            
768             print CSVFILE
769             q(>),
770             $aLine;
771            
772             print CSVFILE
773             " \n";
774             }
775            
776             }
777             }
778             }
779             }
780             }
781             print IFILE "$indentForDataset\n\n";
782             }
783            
784             print IFILE $indentForDataset, q(),"\n";
785             foreach my $iSubjectAttributes ( @subjects )
786             {
787             if ( defined($iSubjectAttributes) )
788             {
789             if ( defined($attributeStringsForSubjects[$iSubjectAttributes])) #improve this
790             {
791             if ( $attributeStringsForSubjects[$iSubjectAttributes] ne "" )
792             {
793             print IFILE " \n";
794             }
795             }
796             }
797             }
798             print IFILE "$indentForDataset\n\n";
799             print IFILE "$indentForDataset\n";
800            
801             print IFILE " $indentForDataset TIME >= 0 > \n";
802             print IFILE " $indentForDataset DV >= 0 > \n";
803            
804             print IFILE " $indentForDataset LNDV(TIME) = ln (DV(TIME)) > \n";
805             print IFILE " $indentForDataset DV(TIME) = exp(LNDV(TIME)) > \n";
806             print IFILE " $indentForDataset DOSE(ID) = AMT(ID) > \n";
807            
808             print IFILE $indentForDataset,"\n\n";
809             if ( $iDatasetType == 1 )
810             {
811             print IFILE <
812            
813            
814             AMT*(delta(0)+delta(72)+delta(96)+delta(120)+delta(144)+delta(168)+delta(192)+delta(216))
815            
816            
817            
818            
819             AMT
820             ApplyFunction;
821            
822            
823            
824             delta;
825             ApplyFunction;
826            
827             0
828            
829            
830             +
831            
832             delta;
833             ApplyFunction;
834            
835             72
836            
837            
838             +
839            
840             delta;
841             ApplyFunction;
842            
843             96
844            
845            
846             +
847            
848             delta;
849             ApplyFunction;
850            
851             120
852            
853            
854             +
855            
856             delta;
857             ApplyFunction;
858            
859             144
860            
861            
862             +
863            
864             delta;
865             ApplyFunction;
866            
867             168
868            
869            
870             +
871            
872             delta;
873             ApplyFunction;
874            
875             192
876            
877            
878             +
879            
880             delta;
881             ApplyFunction;
882            
883             216
884            
885            
886            
887            
888            
889            
890            
891             AMT
892            
893            
894            
895             delta
896             0
897            
898            
899             delta
900             72
901            
902            
903             delta
904             96
905            
906            
907             delta
908             120
909            
910            
911             delta
912             144
913            
914            
915             delta
916             168
917            
918            
919             delta
920             192
921            
922            
923             delta
924             216
925            
926            
927            
928            
929             AMT(delta(0)+delta(72)+delta(96)+delta(120)+delta(144)+delta(168)+delta(192)+delta(216))
930            
931            
932            
933            
934            
935             MATHML
936            
937             print IFILE "\n\n";
938             }
939             }
940            
941             print IFILE q();
942             foreach my $line ( @data )
943             {
944             print IFILE $line, "\n";
945             }
946             print IFILE q(),"\n";
947            
948             print IFILE "\n";
949            
950             close(IFILE);
951            
952             }
953            
954             sub Util_convertNONMEMDataFilesToTypedLambdaCalculus
955             {
956             Util_convertDirectoryOfNONMEMInputFilesToStatML("/oss/runs/","DATA", "/oss/runs/","model");
957            
958             Util_getSomeTypeOfDataFromStatML("inputs","","xml1");
959             Util_getSomeTypeOfDataFromStatML("obs","","xml1","append");
960             Util_convertStatMLDataToTypedLambdaCalculus("c:/oss/winBUGS/theo.xml1","c:/oss/winBUGS/theo.tlc","model");
961             }
962            
963             sub Util_convertStatMLDataToTypedLambdaCalculus
964             {
965            
966             my ( $fileInput, $fileOutput, $criterion ) = @_;
967            
968             open(FILE,$fileInput) or die("Could not open file $fileInput\n");
969             open(FILEOUTPUT,">$fileOutput") or die("Could not open file $fileOutput\n");
970            
971             while()
972             {
973             chomp;
974            
975             my ($attributeList,$vector) = split(/\>/,$_);
976             $attributeList =~ s/\//g;
977             $vector =~ s/\<\/vector//g;
978             my $overallType = "";
979             if ( $attributeList =~ /$criterion\=\"(.*)\"\s+/ )
980             {
981             $overallType = $1;
982             $attributeList =~ s/$criterion\=\".*\"\s+//;
983             }
984            
985             $attributeList =~ s/\s+\"/\"/g;
986             my @attributes = split(/\"\s+/,$attributeList);
987            
988             my @rhs = @attributes;
989             my @lhs = @attributes;
990            
991             my @vectorOfAttributesAndData = ();
992             for ( my $i = 0; $i < scalar(@attributes); $i++)
993             {
994             $rhs[$i] =~ s/.*=|\"//g;
995             $lhs[$i] =~ s/=.*|//g;
996             $rhs[$i] =~ s/\s+//g;
997             if ( $i > 1 && ! ( $rhs[$i] =~ /[a-zA-Z]/ ) )
998             {
999             push(@vectorOfAttributesAndData,$rhs[$i]);
1000             }
1001             }
1002             $vector =~ s/\[|\]//g;
1003             $vector =~ s/^\s+|\s+$//g;
1004            
1005             my $vectorOfAll = "";
1006             my $attributesFlag = "";
1007             if ( $vector =~ /\w/)
1008             {
1009             $vectorOfAll = $vector;
1010             }
1011             else
1012             {
1013             $vectorOfAll = join(" ",@vectorOfAttributesAndData);
1014             $attributesFlag = "Attributes";
1015             }
1016             $vectorOfAll =~ s/\s+/ /g;
1017             if ( ! defined($rhs[0]) )
1018             {
1019             $rhs[0] = "";
1020             }
1021             if ( ! defined($rhs[1]) )
1022             {
1023             $rhs[1] = "";
1024             }
1025             if ( ! defined($vectorOfAll))
1026             {
1027             $vectorOfAll = "";
1028             }
1029             if ( ! defined($overallType))
1030             {
1031             $overallType = "";
1032             }
1033             #hack
1034             $rhs[0] =~ s/AMT/ID/g;
1035             print FILEOUTPUT "$rhs[0]$attributesFlag\[$rhs[1]\]:$overallType$attributesFlag = [ $vectorOfAll ] ";
1036            
1037             print FILEOUTPUT "\n";
1038             }
1039             }
1040             sub Util_convertStatMLDataToCSVForm
1041             {
1042            
1043             my ( $fileInput, $fileOutput, $criterion ) = @_;
1044            
1045             open(FILE,$fileInput) or die("Could not open file $fileInput\n");
1046             open(FILEOUTPUT,">$fileOutput") or die("Could not open file $fileOutput\n");
1047            
1048             print FILEOUTPUT "Modelname, FieldName, SubjectID, AsFunction, ElementType, Length, Vector\n";
1049            
1050             while()
1051             {
1052             chomp;
1053            
1054             my ($attributeList,$vector) = split(/\>/,$_);
1055             $attributeList =~ s/\//g;
1056             $vector =~ s/\<\/vector//g;
1057             my $overallType = "";
1058             if ( $attributeList =~ /$criterion\=\"(.*)\"\s+/ )
1059             {
1060             $overallType = $1;
1061             $attributeList =~ s/$criterion\=\".*\"\s+//;
1062             }
1063            
1064             $attributeList =~ s/\s+\"/\"/g;
1065             my @attributes = split(/\"\s+/,$attributeList);
1066            
1067             my @rhs = @attributes;
1068             my @lhs = @attributes;
1069            
1070             print FILEOUTPUT $overallType;
1071            
1072             my $attributesFlag = "";
1073             if ( $vector =~ /\w/)
1074             {
1075             }
1076             else
1077             {
1078             $attributesFlag = "Attributes";
1079             }
1080             print FILEOUTPUT ",$rhs[0]$attributesFlag";
1081            
1082             for ( my $i = 1; $i < scalar(@attributes); $i++)
1083             {
1084             $rhs[$i] =~ s/.*=|\"//g;
1085             $lhs[$i] =~ s/=.*|//g;
1086             print FILEOUTPUT ",", $rhs[$i];
1087             }
1088            
1089             print FILEOUTPUT q(,"\[), $vector, q(\]");
1090            
1091             print FILEOUTPUT "\n";
1092             }
1093             }
1094            
1095             sub Util_getSomeTypeOfDataFromStatMLInDirectory
1096             {
1097             if ( scalar(@_) < 5 )
1098             {
1099             print "Sorry, usage is Util_getSomeTypeOfDataFromStatML(wordForTypeOfData,useFileInsteadOfWord,extension, possibleSecondaryData,fileExtensionForOutput,append)\n";
1100             return;
1101             }
1102            
1103             my ( $wordForTypeOfData, $useFileInsteadOfWord, $extension, $possibleSecondaryData, $fileExtensionForOutput, $append )= @_;
1104            
1105             if ( ! defined($possibleSecondaryData) )
1106             {
1107             $possibleSecondaryData = "";
1108             }
1109            
1110             my $doAppend = 0;
1111             if ( defined($append) && $append =~ /^append/i)
1112             {
1113             $doAppend = 1;
1114             }
1115            
1116             my $ignoreSecondaryData = 1;
1117             my $secondaryFilterToUse = 1;
1118             if( $possibleSecondaryData =~ /"Secondary"/i )
1119             {
1120             $ignoreSecondaryData = 0;
1121             #In this case, get both primary and secondary by default.
1122             $secondaryFilterToUse = 1;
1123             }
1124            
1125             my $primaryFilterToUse = 0;
1126            
1127             foreach my $fileIn( <*.xml>)
1128             {
1129            
1130             my $modelName = $fileIn;
1131             $modelName =~ s/\.xml//g;
1132            
1133             my $fileOut = $fileIn;
1134             $fileOut =~ s/\.xml/\.$fileExtensionForOutput/g;
1135            
1136             my $modelNameToUse = $modelName;
1137             if ( $useFileInsteadOfWord)
1138             {
1139             $modelNameToUse = $modelName;
1140             }
1141             else
1142             {
1143             $modelNameToUse = "";
1144             }
1145             Util_getSomeTypeOfDataFromStatML($fileIn, $fileOut,$modelNameToUse, $extension, $wordForTypeOfData, $possibleSecondaryData, $append);
1146            
1147             }
1148             }
1149            
1150             sub Util_getSomeTypeOfDataFromStatML
1151             {
1152             if ( scalar(@_) < 4 )
1153             {
1154             print "Sorry, usage is Util_getSomeTypeOfDataFromStatML(...)";
1155             return;
1156             }
1157            
1158             my ( $fileIn, $fileOut, $modelNameToUse, $extension, $wordForTypeOfData, $possibleSecondaryData, $append ) = @_;
1159            
1160             if ( ! defined($possibleSecondaryData) )
1161             {
1162             $possibleSecondaryData = "";
1163             }
1164            
1165             my $doAppend = 0;
1166             if ( defined($append) && $append =~ /^append/i)
1167             {
1168             $doAppend = 1;
1169             }
1170            
1171             my $ignoreSecondaryData = 1;
1172             my $secondaryFilterToUse = 1;
1173             if( $possibleSecondaryData =~ /"Secondary"/i )
1174             {
1175             $ignoreSecondaryData = 0;
1176             #In this case, get both primary and secondary by default.
1177             $secondaryFilterToUse = 1;
1178             }
1179            
1180             my $primaryFilterToUse = 0;
1181            
1182             open(FILE,$fileIn) or die("Could not open file $fileIn\n");
1183            
1184             if ( $doAppend )
1185             {
1186             open(FILEOUT,">>$fileOut") or die("Could not open file $fileOut\n");
1187             }
1188             else
1189             {
1190             open(FILEOUT,">$fileOut") or die("Could not open file $fileOut\n");
1191             }
1192            
1193             while()
1194             {
1195             if ( /^\<\/$wordForTypeOfData/ )
1196             {
1197             $primaryFilterToUse = 0;
1198             }
1199            
1200             if ( /^\
1201             {
1202             unless ( $ignoreSecondaryData )
1203             {
1204             $secondaryFilterToUse = 0;
1205             }
1206             }
1207             if ( /^\<\/Secondary/ )
1208             {
1209             unless ( $ignoreSecondaryData )
1210             {
1211             $secondaryFilterToUse = 1;
1212             }
1213             }
1214            
1215             if ( $primaryFilterToUse && $secondaryFilterToUse )
1216             {
1217            
1218             s/^.*\
1219             if ( $modelNameToUse ne "" )
1220             {
1221             s/\>/ modelName=\"$modelNameToUse\" modelType=\"$extension\" \>/i;
1222             }
1223             else
1224             {
1225             s/\>/ stage=\"$wordForTypeOfData\" \>/i;
1226             }
1227             print FILEOUT $_;
1228             }
1229            
1230             if ( /^\<$wordForTypeOfData/ )
1231             {
1232             $primaryFilterToUse = 1;
1233             }
1234            
1235             }
1236             close(FILE);
1237             close(FILEOUT);
1238             }
1239            
1240             sub getCSVFromStatML
1241             {
1242            
1243             my ($fileInput,$fileOutput) = $_;
1244            
1245             open(FILE,$fileInput) or die("Could not open file $fileInput\n");
1246             open(FILEOUTPUT,">fileOutput") or die("Could not open file $fileOutput\n");
1247            
1248             print FILEOUTPUT "Modelname, FieldName, SubjectID, AsFunction, ElementType, Length, Vector\n";
1249            
1250             while()
1251             {
1252             chomp;
1253            
1254             my ($file,$attributeList,$vector) = split(/\/);
1255            
1256             $file =~ s/\_data.txt.*//g;
1257            
1258             $attributeList =~ s/^\s+|\s+$|vector\s+//g;
1259             my @attributes = split(/\"\s+/,$attributeList);
1260            
1261             my @rhs = @attributes;
1262             my @lhs = @attributes;
1263            
1264             for ( my $i = 0; $i < scalar(@attributes); $i++)
1265             {
1266             $rhs[$i] =~ s/.*=|\"//g;
1267             $lhs[$i] =~ s/=.*|//g;
1268             print FILEOUT ",", $rhs[$i];
1269             }
1270            
1271             print FILEOUT q(,"),$vector, q(");
1272             print FILEOUT "\n";
1273            
1274             }
1275             close(FILE);
1276             close(FILEOUTPUT);
1277             }
1278            
1279             sub createCSVForConstraintsFromStatML
1280             {
1281            
1282             my ($fileInput,$fileOutput) = $_;
1283            
1284             open(FILE,$fileInput) or die("Could not open file $fileInput\n");
1285             open(FILEOUTPUT,">fileOutput") or die("Could not open file $fileOutput\n");
1286            
1287             my $oldFile = "";
1288             my $iNumber = 0;
1289            
1290             print FILEOUTPUT "ModelName, Numer, Constraint\n";
1291            
1292             while()
1293             {
1294             chomp;
1295            
1296             my ($file,$equation,$extra) = split(/\|[\>\s+]*\<\/equation\>/,$_,3);
1297             my $attributeList = "";
1298            
1299             $file =~ s/\_data.txt.*//g;
1300            
1301             if ( $oldFile ne $file )
1302             {
1303             $oldFile = $file ;
1304             $iNumber = 1;
1305             }
1306            
1307             print FILEOUTPUT $file, ", ", $iNumber++;
1308            
1309             $attributeList =~ s/^\s+|\s+$|equation\s+//g;
1310             my @attributes = split(/\"\s+/,$attributeList);
1311            
1312             my @rhs = @attributes;
1313             my @lhs = @attributes;
1314            
1315             for ( my $i = 0; $i < scalar(@attributes); $i++)
1316             {
1317             $rhs[$i] =~ s/.*=|\"//g;
1318             $lhs[$i] =~ s/=.*|//g;
1319             print ",", $rhs[$i];
1320             }
1321             print FILEOUTPUT q(,"),$equation, q(");
1322             print FILEOUTPUT "\n";
1323            
1324             }
1325            
1326             close(FILE);
1327             close(FILEOUTPUT);
1328            
1329             }
1330            
1331            
1332            
1333             sub Util_getNONMEMDataLine
1334             {
1335             my ($firstDoseForIndividuals,$iDatum,$iFieldLength ) = @_;
1336             my @firstDoseForIndividuals = @$firstDoseForIndividuals;
1337             my $numHere = scalar(@firstDoseForIndividuals);
1338             my $aLine = "";
1339             if ( $numHere > 1 )
1340             {
1341             $aLine .= "\[ ";
1342             }
1343            
1344             for ( my $i = 0; $i < $numHere; $i++ )
1345             {
1346             my $datumRef = $firstDoseForIndividuals[$i];
1347             my (@datums) = @$datumRef;
1348             if ( $iDatum <= $#datums)
1349             {
1350             my $datum = $datums[$iDatum];
1351             if ( defined($datum) && $datum ne "" )
1352             {
1353             my $strlen = $iFieldLength - length($datum)+1;
1354             if ( $strlen < 1 )
1355             {
1356            
1357             $strlen = 1;
1358             }
1359             $aLine .= " " x $strlen;
1360            
1361             $aLine .= $datum;
1362             }
1363             }
1364             }
1365             if ( $numHere > 1 )
1366             {
1367             $aLine .= "\] ";
1368             }
1369            
1370             return ( $aLine);
1371             }
1372            
1373             sub Util_convertDirectoryOfNONMEMInputFilesToCSVForm
1374             {
1375             my ( $inputDirectory, $outputDirectory ) = @_;
1376            
1377             opendir(READDIR,"$inputDirectory");
1378             my @files = grep { /\.txt/ } readdir(READDIR);
1379             close(READDIR);
1380            
1381             for my $fileIn ( <@files>)
1382             {
1383             my $fileOut = $fileIn;
1384             $fileOut =~ s/txt/csv/g;
1385            
1386             print $fileIn, "\n";
1387            
1388             Util_convertNONMEMInputFileToCSVForm("$inputDirectory/$fileIn","$outputDirectory/$fileOut");
1389             }
1390            
1391             }
1392            
1393            
1394             sub NONMEM_removeHeaderLineFromTABFiles
1395             {
1396             my ( $inputDirectory, $extension, $outputDirectory ) = @_;
1397            
1398             opendir(READDIR,"$inputDirectory") or die("Could not open input directory $inputDirectory\n");
1399            
1400             if ( $extension =~ /^\./)
1401             {
1402             $extension =~ s/\.//g;
1403             }
1404            
1405             my @files = grep { /\.$extension/ } readdir(READDIR);
1406             close(READDIR);
1407            
1408             for my $fileIn ( <@files>)
1409             {
1410             my $fileOut = $fileIn;
1411            
1412             open(FILE,$fileIn) or die("Could not read in input file $fileIn\n");
1413             my @lines = ;
1414             close(FILE);
1415            
1416             my $iStartingLine = 0;
1417             if ( $lines[0] =~ /TABLE/i)
1418             {
1419             $iStartingLine = 1;
1420             }
1421             if ( $iStartingLine == 1 or ( $inputDirectory ne $outputDirectory ) )
1422             {
1423             open(FILEOUT,">$fileOut") or die("Could not open output file $fileOut\n");
1424             print FILEOUT @lines[$iStartingLine .. $#lines];
1425             close(FILEOUT);
1426             }
1427             }
1428            
1429             }
1430            
1431            
1432             sub Util_convertNONMEMInputFileToCSVForm
1433             {
1434            
1435             my ( $fileInput, $fileOutput ) = @_;
1436            
1437             open(FILE,$fileInput) or die("Could not open file\n");
1438             open(FILEOUTPUT,">$fileOutput") or die("Could not open output file\n");
1439            
1440             my @data = ;
1441             $data[0] =~ s/^[\s|\#]+//g;
1442             $data[0] =~ s/\,/ /g;
1443            
1444             my @headerHere = split(/\s+|\,/,$data[0]);
1445            
1446             print FILEOUTPUT join(",",@headerHere), "\n";
1447             for ( my $i = 1; $i <= $#data; $i++ )
1448             {
1449            
1450             my $line = $data[$i];
1451             $line =~ s/^\s+|\#|\[|\]|\"|,/ /g;
1452             my @dataHere = split(/\s+/,$line);
1453             print FILEOUTPUT join(",",@dataHere),"\n";
1454             }
1455            
1456             close(FILE);
1457             close(FILEOUTPUT);
1458            
1459             }
1460            
1461             sub Util_isInList
1462             {
1463             my ( $variable, @variables ) = @_;
1464             my $iFound = -1;
1465            
1466             my $iVar = 0;
1467             for my $testVar ( @variables )
1468             {
1469             if ( $variable eq $testVar )
1470             {
1471             $iFound = $iVar;
1472             }
1473             $iVar++;
1474             }
1475             return ($iFound);
1476             }
1477            
1478             sub Util_stripPrefixes
1479             {
1480             my $iFound = -1;
1481             my ( $variablesRef, $prefix ) = @_;
1482            
1483             my @newVariables = ();
1484            
1485             my $iVar = 0;
1486             my @variables = @$variablesRef;
1487             for my $testVar ( @variables )
1488             {
1489             $testVar =~ s/^$prefix//ig;
1490             push(@newVariables,$testVar);
1491             }
1492             return (\@newVariables);
1493             }
1494            
1495             #Hack - use grep.
1496             sub Util_isInListWithPrefix
1497             {
1498             my $iFound = -1;
1499             my ( $variable, $prefix, @variables ) = @_;
1500             my $iVar = 0;
1501             for my $testVar ( @variables )
1502             {
1503             if ( uc($prefix . $testVar) eq uc($variable) )
1504             {
1505             $iFound = $iVar;
1506             }
1507             $iVar++;
1508             }
1509             return ($iFound);
1510             }
1511            
1512             sub Util_convertLambdaExpressionToCSVForm
1513             {
1514             my ( $lambdaExpression ) = $_[0];
1515            
1516             my $CSVForm = "";
1517            
1518             my $relationalOperator = "\=";
1519             if ( $lambdaExpression =~ /\~/)
1520             {
1521             $relationalOperator = "\~";
1522             }
1523             my @parts = split(/$relationalOperator/,$lambdaExpression,2);
1524             if ( ! defined($parts[1]))
1525             {
1526             $parts[1] = "";
1527             }
1528            
1529             my ($name,$type);
1530             if ( defined($parts[0]))
1531             {
1532             ($name,$type) = split(/:/,$parts[0]);
1533             }
1534             if ( !defined($name))
1535             {
1536             return "";
1537             }
1538             if ( !defined($type))
1539             {
1540             return "";
1541             }
1542            
1543             $CSVForm = $type . ", " . $name . "," . $relationalOperator . "," . "\"" . $parts[1] . "\"" ;
1544            
1545             return $CSVForm;
1546             }
1547            
1548            
1549             sub Util_convertToLambdaExpression
1550             {
1551             my ( $string ) = $_[0];
1552            
1553             my $lambdaExpressions = "";
1554            
1555             if ( $string =~ /[a-zA-Z]/)
1556             {
1557             my @strings = split(/\n/, $string);
1558            
1559             foreach my $string1 ( @strings )
1560             {
1561             $string1 =~ s/^\s+|\s+$//g;
1562             $string1 =~ s/\"//g;
1563             my $lambdaExpression = $string1;
1564             unless ( $string1 =~ /:/)
1565             {
1566             my @parts = split(/,/,$string1,4);
1567             my $nParts = scalar(@parts);
1568            
1569             if ( ! defined($parts[0]))
1570             {
1571             $parts[0] = "";
1572             }
1573             if ( ! defined($parts[1]))
1574             {
1575             $parts[1] = "";
1576             }
1577             if ( ! defined($parts[2]))
1578             {
1579             $parts[2] = "";
1580             }
1581             if ( ! defined($parts[3]))
1582             {
1583             $parts[3] = "";
1584             }
1585             if ( $parts[1] eq "" )
1586             {
1587             $parts[1] = $parts[0];
1588             }
1589             if ( $nParts > 0 )
1590             {
1591             $parts[0] =~ s/^\s+|\s$//g;
1592             if ( $nParts > 1 )
1593             {
1594             $parts[1] =~ s/^\s+|\s$//g;
1595             if ( $nParts > 2 )
1596             {
1597             $parts[2] =~ s/^\s+|\s$//g;
1598             if ( $nParts > 3 )
1599             {
1600             $parts[3] =~ s/^\s+|\s$//g;
1601             $improveThis = 1;
1602             $parts[3] =~ s/^,//g;
1603             $parts[3] =~ s/,\s+\]/\]/g;
1604             }
1605             }
1606             }
1607             }
1608            
1609             $lambdaExpression = "$parts[1]:$parts[0]$parts[2]$parts[3]\n";
1610            
1611             }
1612            
1613             $lambdaExpressions .= $lambdaExpression;
1614             }
1615             }
1616             return $lambdaExpressions;
1617             }
1618            
1619            
1620            
1621             #-----------------------------------------------------------------------
1622             #package PK
1623            
1624             sub PK_sortVariableNamesInDottedList
1625             {
1626             my $variablesInDottedList = $_[0];
1627            
1628             my $UCVariablesInDottedList = uc ($variablesInDottedList);
1629            
1630             my @variables = split(/\./,$UCVariablesInDottedList);
1631            
1632             my @newVariables = PK_sortVariableNames(@variables);
1633            
1634             my $newDotList = join(".",@newVariables);
1635            
1636             return ( $newDotList );
1637            
1638             }
1639            
1640             sub PK_sortVariableNames
1641             {
1642             my @variables = @_;
1643             my @orderOfVariables = ("ALPHA","BETA","AB", "A","B","TI", "D1", "TLAG", "ALAG1","V", "V1", "V2", "V3", "KA", "Q", "CL", "K", "K12","VM","KM","K21","W","RSV","IND");
1644            
1645             my @newVariables = ();
1646            
1647             my $VFound = Util_isInList("V", @variables);
1648             my $V1Found = Util_isInList("V1",@variables);
1649             my $V2Found = Util_isInList("V2",@variables);
1650             my $V3Found = Util_isInList("V3",@variables);
1651            
1652             my $myList = join(",", @variables);
1653            
1654             foreach my $variable ( @orderOfVariables )
1655             {
1656             my $variableUsed = $variable;
1657             my $iFound = Util_isInList($variableUsed,@variables );
1658            
1659             if ( $variableUsed eq "V1" && ($VFound) < 0 && ($V2Found < 0) )
1660             {
1661             $variableUsed = "V";
1662             }
1663            
1664             if ( $variableUsed eq "V2" && ($VFound) < 0 && ( $V1Found < 0 ) && ( $V3Found >= 0 ))
1665             {
1666             $variableUsed = "V1";
1667             }
1668             if ( $variableUsed eq "V3" && ($VFound) < 0 && ( $V1Found < 0 ) && ( $V2Found >= 0 ))
1669             {
1670             $variableUsed = "V2";
1671             }
1672            
1673             if ( $variableUsed eq "V2" && ($VFound) < 0 && ( $V1Found < 0 ) && ( $V3Found < 0 ))
1674             {
1675             $variableUsed = "V";
1676             }
1677            
1678             if ( $variableUsed eq "ALAG1")
1679             {
1680             $variableUsed = "TLAG";
1681             }
1682            
1683             if ( $iFound >= 0)
1684             {
1685             push(@newVariables,$variableUsed);
1686             }
1687             }
1688             return ( @newVariables);
1689            
1690             }
1691            
1692             sub PK_regularizeFileNamesInGivenDirectory
1693             {
1694            
1695             my ( $inputDirectory, $extension ) = @_;
1696            
1697             opendir(RUNDIR,$inputDirectory) or die("Could not open input directory $inputDirectory\n");
1698             my @files = grep ( /\.$extension/i, readdir(RUNDIR));
1699             close(READDIR);
1700            
1701             foreach my $fileName ( @files )
1702             {
1703             my $newName = uc(PK_regularizeFileName($fileName,".$extension"));
1704            
1705             if ( $fileName ne $newName)
1706             {
1707             print "mv $inputDirectory\\$fileName $inputDirectory\\$newName\n";
1708             }
1709            
1710             }
1711             }
1712            
1713             sub MONOLIX_formatMonolixFilesInGivenDirectory
1714             {
1715            
1716             my ( $directoryToUse, $replaceFunctionsWithFunctionContents ) = @_;
1717            
1718             my @files = <*.M>;
1719            
1720             my @functionNames = @files;
1721             my %actualFileNames = ();
1722            
1723             my $oldSeparator = $/;
1724             $/ = "\n";
1725            
1726             my $functionName;
1727            
1728             for ( my $i = 0; $i < scalar(@functionNames); $i++ )
1729             {
1730             my $fileName = $functionNames[$i];
1731             $functionName = $fileName;
1732             $functionName =~ s/\.m//ig;
1733             $functionName =~ s/\_SD|\_MD|\_SS//ig;
1734             $functionName =~ s/\.//g;
1735             $functionNames[$i] = $functionName;
1736             $actualFileNames{$functionName} = $fileName;
1737            
1738             }
1739             foreach my $file ( @files )
1740             {
1741            
1742             print $file, "\n";
1743             $functionName = $file;
1744            
1745             my $firstFunction = 1;
1746            
1747             $functionName =~ s/\.m//ig;
1748             my $dosingType = substr($functionName,length($functionName)-2,2);
1749             if ( $dosingType ne "SD" && $dosingType ne "MD" && $dosingType ne "SS" )
1750             {
1751             $dosingType = "SD";
1752             }
1753             if ( $dosingType ne "" )
1754             {
1755             $dosingType = "_" . $dosingType;
1756             }
1757            
1758             $/ = "\n";
1759             open(FILE,$file) or die ("Could not open $file\n");
1760             my @lines = ;
1761             close(FILE);
1762            
1763             my @newLines = ();
1764             my $lastLine;
1765            
1766             my $alreadyReplacedAFunction = 0;
1767            
1768             foreach my $line ( @lines)
1769             {
1770             next if $line =~ /\-\-\-\-\-\-\-\-\-\-\-\-/;
1771             $line =~ s/^\s+//g;
1772             $line =~ s/\%.*//g;
1773             unless ( $line =~ /\w/)
1774             {
1775             unless ( $lastLine =~ /\w/ )
1776             {
1777             next;
1778             }
1779             }
1780            
1781             $line =~ s/^\s+|\s+$//g;
1782            
1783             if ( $line =~ /^function/ && $firstFunction )
1784             {
1785             unless ( $dosingType eq "" or $line =~ /\_$dosingType/)
1786             {
1787             $line =~ s/\(/\_$dosingType\(/o;
1788             }
1789             $firstFunction = 0;
1790             $line =~ s/\_\_/\_/g;
1791            
1792             }
1793             elsif ( ( ! $firstFunction ) && $replaceFunctionsWithFunctionContents && ( ! $alreadyReplacedAFunction) )
1794             {
1795             if ( $line =~ /VK12/i)
1796             {
1797             #$line =~ s/[V]+K12/VKK12/i;
1798             }
1799             my $lineBeforeComment = $line;
1800             $lineBeforeComment =~ s/\%.*//g;
1801             foreach $functionName ( @functionNames )
1802             {
1803             if ( $lineBeforeComment =~ /$functionName/i )
1804             {
1805             my $fileName = $actualFileNames{$functionName};
1806             $fileName = substr($fileName,0,length($fileName)-5);
1807             my $completeName ="${fileName}${dosingType}.M";
1808             print ", function: $functionName,filename: $completeName\n";
1809             open(FILEINPUT,$completeName) or die("Could not open $completeName for $file");
1810             my @otherFunctionLines = ;
1811            
1812             if ( scalar(@otherFunctionLines) > 1 )
1813             {
1814             for ( my $iNew = 1; $iNew < scalar(@otherFunctionLines); $iNew++ )
1815             {
1816             push(@newLines,$otherFunctionLines[$iNew]);
1817             }
1818             #Forget the original line;
1819             $line = "";
1820             }
1821             $alreadyReplacedAFunction = 1;
1822             last;
1823             }
1824             }
1825             $line = "\t" . $line;
1826            
1827             }
1828            
1829             $line .= "\n";
1830             push(@newLines,$line);
1831            
1832             $lastLine = $line;
1833             }
1834            
1835             open(FILE,">$file") or die("Could not open output\n");
1836             print FILE @newLines;
1837             close(FILE);
1838            
1839             }
1840            
1841             $/ = $oldSeparator;
1842            
1843             }
1844            
1845            
1846             sub PK_regularizeFileName
1847             {
1848             my ($newName, $extension ) = @_;
1849            
1850             $newName =~ s/$extension$//ig;
1851             if ( $newName =~ /\.$/)
1852             {
1853             $newName =~ s/\.$//g;
1854             }
1855             if ( $newName =~ /\_$/)
1856             {
1857             $newName =~ s/\_$//g;
1858             }
1859             $newName = uc($newName);
1860            
1861             $newName =~ s/(ALPHA|BETA|TLAG|KA|K12|VM|K21|TI|TK0|KA|CL|V1|V2|KM|EMAX|GAMMA|IMAX|BMAX|PK|PD|VK)/\.$1\./g;
1862             $newName =~ s/\.VK\./\.V\.K\./g;
1863             $newName =~ s/\.VK\_/\.V\.K\_/g;
1864             #Replace instances of K together with K21, with K12 and K21
1865             if ( $newName =~ /K21/)
1866             {
1867             if ( $newName =~ /K\./)
1868             {
1869             unless( $newName =~ /K12/)
1870             {
1871             $newName =~ s/K\./K12\./g;
1872             }
1873             }
1874             }
1875             $newName =~ s/\.\_|\_\./\_/g;
1876             $newName =~ s/\.\./\./g;
1877            
1878             $newName =~ s/\.$//g;
1879            
1880             my @nameParts = split(/\_/,$newName);
1881             my $routing = $nameParts[0];
1882             my $compartments = $nameParts[1];
1883             my $dosingType = $nameParts[$#nameParts];
1884            
1885             if ( $dosingType ne "SD" && $dosingType ne "MD" && $dosingType ne "SS" )
1886             {
1887             $dosingType = "";
1888             }
1889             else
1890             {
1891             $dosingType = "_" . $dosingType;
1892             }
1893             my $parameters = $nameParts[2];
1894            
1895             my $revisedParameters = "";
1896            
1897             my $reviseParameters = 1;
1898             if ( $reviseParameters )
1899             {
1900             $revisedParameters = PK_sortVariableNamesInDottedList($parameters);
1901             }
1902             else
1903             {
1904             $revisedParameters = $parameters;
1905             }
1906            
1907             if ( $revisedParameters ne "" )
1908             {
1909             $revisedParameters = "_" . $revisedParameters;
1910             }
1911            
1912             $newName = "${routing}_${compartments}${revisedParameters}${dosingType}";
1913            
1914             $newName .= ".$extension";
1915             $newName =~ s/\.\./\./g;
1916             $newName =~ s/\_\.|\.\_/\_/g;
1917            
1918             $newName = uc($newName);
1919            
1920             return $newName;
1921            
1922             }
1923            
1924             #------------------------------------------------------------------------------
1925             #package OpenStatisticalServices::NONMEM
1926            
1927             #Add MDV, EVID and possibly other elements to data that is not in "NONMEM" form.
1928             sub NONMEM_convertCSVDataToNONMEMForm
1929             {
1930             my ($fileIn, $fileOut) = @_;
1931            
1932             open(FILE,$fileIn) or die("Could not open $fileIn\n");
1933             open(FILEOUT,">$fileOut") or die("Could not open $fileOut\n");
1934            
1935             my $header = ;
1936             chomp $header;
1937             print FILEOUT "$header AMT MDV EVID\n";
1938             my $iSubject = 0;
1939             while()
1940             {
1941             chomp;
1942             my @data = split(/\s+/,$_);
1943            
1944             if ( $data[1] ne $iSubject )
1945             {
1946             $data[5] = 0;
1947             my $newData = join(" ",@data[1 .. $#data]);
1948             print FILEOUT "$newData $data[3] 1 1\n";
1949             $iSubject = $data[1];
1950             next;
1951             }
1952             my $newData = join(" ",@data[1 .. $#data]);
1953            
1954             print FILEOUT "$newData 0 0 0\n";
1955             }
1956            
1957             close(FILE);
1958             close(FILEOUT);
1959            
1960             }
1961            
1962             sub NONMEM_convertParsedNONMEMOutputsToTypedLambdaCalculus
1963             {
1964             my $fileOfAllResults = $_[0];
1965            
1966             my $currentModel = "";
1967             my $objectiveFunction = 0;
1968             my @parameterNames = ();
1969             my @thetaValues = ();
1970             my @etaValues = ();
1971             my @sigmaValues = ();
1972             my @sigmaErrors = ();
1973             my @thetaErrors = ();
1974             my @etaErrors = ();
1975             my @covrMatrix = ();
1976             my @corrMatrix = ();
1977             my @invMatrix = ();
1978            
1979             open(FILEOFALLRESULTS,$fileOfAllResults ) or die ("Could not open file of all results\n");
1980             while(my $line = )
1981             {
1982             $line =~ s/\s+//g;
1983             my @parts = split(/,/,$line);
1984            
1985             my $model = $parts[0];
1986             $model =~ s/\.out//i;
1987            
1988             if ( $model ne $currentModel)
1989             {
1990             if ( $currentModel ne "" )
1991             {
1992             print "$model, Objective Function,=, $objectiveFunction\n";
1993             print "$model, Parameters,=,\" \[ ", join(", ", @parameterNames) , "\]\"\n";
1994             print "$model, Fixed Effects,=,\" \[ ", join(", ", @thetaValues), "\]\"\n";
1995             print "$model, Covariance Matrix for Random Effects - Etas,=,\" \[ ", join(", ", @etaValues), "\]\"\n";
1996             print "$model, Sigmas,=,\" \[ ", join(", ", @sigmaValues) , "\]\"\n";
1997             print "$model, Theta - Standard Errors for Estimates,=,\" \[ ", join(", ", @thetaErrors), "\]\"\n";
1998             print "$model, Omega - Standard Errors for Random Effects,=,\" \[ ", join(", ", @etaErrors), "\]\"\n";
1999             print "$model, Sigma - Covariance Matrix,=,\" \[ ", join(", ", @sigmaErrors) , "\]\"\n";
2000             print "$model, Covariance Matrix for Random Effects,=,\" \[ ", join(", ", @covrMatrix), "\]\"\n";
2001             print "$model, Correlation Matrix of Estimate,=,\" \[ ", join(", ", @corrMatrix), "\]\"\n";
2002             print "$model, Inverse Covariance Matrix of Estimate,=,\" \[ ", join(", ", @invMatrix), "\]\"\n";
2003             }
2004            
2005             $objectiveFunction = 0;
2006             @parameterNames = ();
2007             @thetaValues = ();
2008             @etaValues = ();
2009             @sigmaValues = ();
2010             @sigmaErrors = ();
2011             @thetaErrors = ();
2012             @etaErrors = ();
2013             @covrMatrix = ();
2014             @corrMatrix = ();
2015             @invMatrix = ();
2016            
2017             $currentModel = $model;
2018            
2019             }
2020            
2021             my $outputType = $parts[1];
2022             my $token = $parts[2];
2023             my $runNumber = $parts[3];
2024             my $iLength = $parts[4];
2025             my @vector = @parts[5 .. $#parts];
2026            
2027             if ( $token eq "OBJ" )
2028             {
2029             $objectiveFunction = $vector[0];
2030             }
2031             if ( $token eq "PRED_LABELS" )
2032             {
2033             @parameterNames = @vector;
2034             }
2035             if ( $token eq "THETA" )
2036             {
2037             if ( $outputType eq "1" )
2038             {
2039             @thetaValues = @vector;
2040             }
2041             else
2042             {
2043             @thetaErrors = @vector;
2044             }
2045            
2046             }
2047             if ( $token eq "OMEGA" )
2048             {
2049             if ( $outputType eq "2" )
2050             {
2051             @etaValues = @vector;
2052             }
2053             else
2054             {
2055             @etaErrors = @vector;
2056             }
2057             }
2058             if ( $token eq "SIGMA" )
2059             {
2060             if ( $outputType eq "1" )
2061             {
2062             @sigmaValues = @vector;
2063             }
2064             else
2065             {
2066             @sigmaErrors = @vector;
2067             }
2068             }
2069             if ( $token eq "COVR" )
2070             {
2071             @covrMatrix = @vector;
2072             }
2073             if ( $token eq "CORR" )
2074             {
2075             @corrMatrix = @vector;
2076             }
2077             if ( $token eq "CORR" )
2078             {
2079             @invMatrix = @vector;
2080             }
2081            
2082            
2083             }
2084             }
2085            
2086             sub NONMEM_doSetOfRuns
2087             {
2088            
2089             my $oldSeparator = $/;
2090             $/ = "\n";
2091            
2092             my ($directoryWithControlFiles, $NONMEMRunDirectory, $targetDirectory ) = @_;
2093            
2094             if ( $improveThis )
2095             {
2096             `cd $directoryWithControlFiles`;
2097             }
2098            
2099             my @files = <*.ctl>;
2100            
2101             foreach my $file ( @files )
2102             {
2103            
2104             open(INPUTFILE,"$file") or die("Could not open file name for input $file\n");
2105             my @copy = ;
2106             close(INPUTFILE);
2107            
2108             my $dataFileName = "";
2109             my $regularizedFilename = "";
2110             foreach my $line ( @copy )
2111             {
2112             if ( $line =~ /^\$DATA/)
2113             {
2114             my @parts = split(/\s+/,$line);
2115             $dataFileName = $parts[1];
2116             $regularizedFilename = $dataFileName;
2117             unless ( open(DATAFILE,$dataFileName))
2118             {
2119             unless ( open(DATAFILE,"../data/$dataFileName"))
2120             {
2121             my $regularizedFilename = PK_regularizeFileName($dataFileName,".data.txt");
2122             unless ( open(DATAFILE,"../data/$regularizedFilename"))
2123             {
2124             die("Could not open data file $dataFileName or $regularizedFilename for $file\n");
2125             }
2126             }
2127            
2128             print "Copying file $NONMEMRunDirectory\\$regularizedFilename to $dataFileName\n";
2129             my $ok = `copy /y \\oss\\data\\$regularizedFilename $dataFileName`;
2130            
2131             print $ok;
2132             print "done\n";
2133             }
2134            
2135             $/ = "\n";
2136            
2137             my @dataLines = ;
2138             close(DATAFILE);
2139            
2140             $dataLines[0] =~ s/^[\s]*[\#]*[\s]*//g;
2141             my $header = $dataLines[0];
2142            
2143             unless ( $dataLines[0] =~ /\#/)
2144             {
2145             open(DATAFILE,">$dataFileName") or die("Could not open data file to write\n");
2146             $dataLines[0] = "\# " . $dataLines[0];
2147             print DATAFILE @dataLines;
2148             #print DATAFILE "\n";
2149             close(DATAFILE);
2150             }
2151             }
2152             }
2153            
2154             my $generateInvalidModelToTestEngines = 0;
2155             if ( $generateInvalidModelToTestEngines )
2156             {
2157             #This generated a bogus ( additive type ) model in order to see if the
2158             #see if the engine can process it without hanging.
2159             for ( my $i = 0; $i < scalar(@copy); $i++ )
2160             {
2161             if ( $copy[$i] =~ /\*EXP/)
2162             {
2163             $copy[$i] =~ s/\*EXP/\+EXP/g;
2164             }
2165             }
2166             }
2167             open(INPUTFILE,">$file") or die("Could not open file name for input $file\n");
2168             print INPUTFILE @copy;
2169             close(INPUTFILE);
2170            
2171             if ( $dataFileName eq "" )
2172             {
2173             print "Could not find input file for $file with contents\n@copy\n";
2174             exit;
2175             }
2176            
2177             #print "Running $file\n";
2178            
2179             #my $message = `nmfe6.bat $file $file.out > $file.log`;
2180             print "nmfe6.bat $file $file.out > $file.log \n";
2181            
2182             }
2183            
2184             $/ = $oldSeparator;
2185             }
2186            
2187             sub NONMEM_getHypernormalizedVersionOfDatasets
2188             {
2189            
2190             use Text::CSV::Simple;
2191             use integer;
2192            
2193             my ( $dataType, $extension ) = @_;
2194            
2195             my $iHeaderLine = 0;
2196             my $iTime = 2;
2197             my @files = <*.$extension>;
2198             my $runType = "NONMEM";
2199            
2200             if ( $dataType =~ "Input" )
2201             {
2202             $extension = "data";
2203             $dataType = "Inputs";
2204             $iHeaderLine = 0;
2205             $iTime = 1;
2206             @files = <*.$extension>;
2207             $runType = "NONMEM";
2208            
2209             }
2210            
2211             my @headers = ();
2212            
2213             print "Study, Model, ModelType, RunType, ID, Field, Time, Value\n";
2214            
2215             foreach my $file ( @files )
2216             {
2217             my @fields = split(/\_/,$file);
2218            
2219             open(FILE,$file) or die("Could not open file\n");
2220            
2221             $file =~ s/\.$extension//ig;
2222             my @data = ;
2223            
2224             for ( my $i = $iHeaderLine; $i < $iHeaderLine+1; $i++ )
2225             {
2226             my $line = $data[$i];
2227             $line =~ s/\#|^\s+//g;
2228             $line =~ s/\#|^\s+//g;
2229            
2230             @headers = split(/\s+/,$line);
2231             #print $file,",", join(",", @headers);
2232             #print "\n";
2233            
2234             }
2235            
2236             for ( my $i = $iHeaderLine+1; $i < scalar(@data); $i++ )
2237             {
2238             my $line = $data[$i];
2239             $line =~ s/\#|^\s+//g;
2240             $line =~ s/\#|^\s+//g;
2241            
2242             my @items = split(/\s+/,$line);
2243             for ( my $j = $iTime+1; $j < scalar(@items); $j++ )
2244             {
2245             my $iSubject = sprintf("%d",$items[0]);
2246             my $time = sprintf("%10.2f",$items[$iTime]);
2247             next if ( $items[$j] eq "." );
2248             my $datum = sprintf("%f", $items[$j]);
2249            
2250             print "$file, $file, $runType, $dataType, $iSubject, $headers[$j], $time, $datum\n";
2251             }
2252            
2253             }
2254             }
2255             }
2256            
2257             sub MONOLIX_installMatlabMFiles
2258             {
2259             my ( $outputDirectory ) = $_[0];
2260            
2261             open ( MFILE, "$outputDirectory/parseMonolixDotMatFiles.m");
2262            
2263             print MFILE <
2264            
2265             function matFileNames = parseMonolixDotMatFiles(directory)
2266            
2267             matFiles = dir
2268            
2269             doseTypes = {'sd','md','ss'};
2270            
2271             iDoseTypeFound = 0;
2272             iDoseType = 1;
2273             for iName = 1: length(matFiles)
2274             aName = matFiles(iName).name;
2275             doseType = doseTypes(iDoseType);
2276             if regexp(aName,'mexw3')
2277             ;
2278             elseif regexp(aName,'.mat')
2279             modelName = strrep(aName,'.mat','')
2280             my = load(aName);
2281             modelInfoFileName = strcat('c:/monolix/modelInfo/',modelName,'.data')
2282             fid = fopen(modelInfoFileName,'wt');
2283             if ( fid > 0 )
2284             fprintf(fid,'%s\n','-------------------------Data-----------------');
2285             fprintf(fid,'nb_param=%i\n', my.nb_param);
2286             fprintf(fid,'logstruct=%s\n',mat2str(my.logstruct));
2287             fprintf(fid,'nb_varex=%i\n',my.nb_varex);
2288            
2289             fprintf(fid,'desc=''%s''\n',my.desc);
2290             temp = joinStrings(my.phi_names)
2291             fprintf(fid,'phi_names=[%s]\n',strcat(temp));
2292             if isfield(my,'phi_tex')
2293             fprintf(fid,'tex_names=[%s]\n',strcat(joinStrings(my.phi_tex)));
2294             end;
2295             if isfield(my,'tex_names')
2296             fprintf(fid,'tex_names=[%s]\n',strcat(joinStrings(my.tex_names)));
2297             end;
2298             if isfield(my,'phi_names')
2299             fprintf(fid,'phi_names=[%s]\n',strcat(joinStrings(my.phi_names)));
2300             end;
2301             if isfield(my,'nb_outputs')
2302             fprintf(fid,'nb_outputs=%i\n',my.nb_outputs);
2303             end;
2304            
2305             fprintf(fid,'dose=%i\n',my.dose);
2306             fprintf(fid,'ode=%i\n',my.ode);
2307             fprintf(fid,'cat_model=%s\n',my.cat_model);
2308             fprintf(fid,'nb_ode=%i\n',my.nb_ode);
2309            
2310             fclose(fid);
2311             end;
2312            
2313             elseif regexp(aName,'.m')
2314             modelName = strrep(aName,'.m','')
2315             modelInfoFileName = strcat('c:/monolix/modelInfo/',modelName,'.txt')
2316             fid = fopen(modelInfoFileName,'wt');
2317            
2318             fid1 = fopen(aName);
2319             if ( fid > 0 && fid1 > 0 )
2320             fprintf(fid,'%s\n','-------------------------Model-----------------')
2321             %---------------------------------------------------------------------
2322             %Note on the coding here: I do the real splitting of models by dosing
2323             %( sd, md, ss ) using PERL. However, for the time being, I am keeping
2324             %this code here in case it is helpful to make use of later -- rph
2325             %---------------------------------------------------------------------
2326             while 1,
2327             aCharacterString = fgetl(fid1);
2328             if ferror(fid) ~= 0
2329             break;
2330             end;
2331             if aCharacterString == -1
2332             break;
2333             end
2334             regExpPattern = strcat('if.*','''',doseType,'''');
2335             aString = strvcat(aCharacterString);
2336             regFound = regexp(aString,regExpPattern);
2337             if length(regFound ) > 0
2338             iDoseTypeFound = iDoseType;
2339             %continue;
2340             end
2341             elseFound = regexp(aString,'else');
2342             if (length(elseFound)>0)
2343             iDoseTypeFound = 3;
2344             % continue;
2345             end
2346             %if ( iDoseTypeFound == iDoseType )
2347             fprintf(fid,'%s',aString);
2348             fprintf(fid,'\n');
2349             %end
2350             end;
2351             fclose(fid1);
2352             fclose(fid);
2353             end;
2354            
2355             end;
2356             matFileNames = 'OK';
2357             end
2358            
2359             END_OF_MFILE
2360            
2361             close(MFILE);
2362            
2363             open(MFILE, "$outputDirectory/getAsciiVersionsOfAllDotMatFiles.m" ) or die("Could not open file in M-file output directory\n");
2364            
2365             print MFILE <
2366            
2367             function [files] = getAsciiVersionsOfAllMonolixDotMatFiles
2368            
2369             files = dir('*.mat');
2370             mSizes = size(files);
2371             msize = mSizes(1)*mSizes(2);
2372            
2373             for i = 1:msize
2374             file = files(i);
2375             fileName = file.name;
2376            
2377             fileName
2378            
2379             myData = load(fileName)
2380             fileExport = strrep(fileName,'.mat','')
2381             fileExport = strcat(fileExport,'.csv')
2382             saveSAEMFields(fileName,fileExport)
2383            
2384             end
2385            
2386             END_OF_MFILE1
2387            
2388             close(MFILE);
2389            
2390             open(MFILE, "$outputDirectory/getMonolixDataStruct.m" ) or die("Could not open file in M-file output directory\n");
2391            
2392             print MFILE <
2393            
2394             function [vData] = getMonolixDataStruct(arrayOfCells,fieldName,fieldType)
2395            
2396             [rows, cols] = size(arrayOfCells);
2397            
2398             iIndex = 0;
2399             thisData = 0;
2400            
2401             for i = 1:rows
2402            
2403             item = arrayOfCells(i,1);
2404             item1 = item{1};
2405            
2406             if ( ischar(item1))
2407             charItem = char(item1);
2408             if (strcmp(charItem,fieldName ) == 1)
2409             iIndex = i;
2410             end
2411             end
2412            
2413             end
2414            
2415             if ( strcmp(fieldType,'char') == 1 )
2416             vData = getCharArray(arrayOfCells,iIndex);
2417             else
2418             vData = getNumericArray(arrayOfCells,iIndex);
2419             end
2420            
2421             function [vData] = getNumericArray(arrayOfCells,iIndex)
2422            
2423             vData = 0;
2424            
2425             if ( iIndex > 0 )
2426             thisArray = arrayOfCells(iIndex,1:4);
2427             thisData = thisArray{1,4};
2428            
2429             if (iscellstr(thisData))
2430            
2431             myLength = numel(thisData);
2432            
2433             vData = 0;
2434             vData = zeros(1,myLength);
2435             for i = 1:myLength
2436             temp = char(thisData(i))
2437             vData(1,i) = str2num(temp)
2438             end
2439             elseif (iscell(thisData))
2440            
2441             myLength = numel(thisData);
2442            
2443             vData = 0;
2444             vData = zeros(1,myLength);
2445             for i = 1:myLength
2446             vData(i) = str2num(thisData{i});
2447             end
2448             else
2449            
2450             myLength = 1
2451            
2452             vData = 0;
2453             vData = zeros(1,myLength);
2454             for i = 1:myLength
2455             vData(i) = str2num(thisData);
2456             end
2457             end
2458             end
2459            
2460             function [vData] = getCharArray(arrayOfCells,iIndex)
2461            
2462             vData = 0;
2463            
2464             if ( iIndex > 0 )
2465             thisArray = arrayOfCells(iIndex,1:4);
2466             thisData = thisArray{1,4};
2467            
2468             if (iscell(thisData))
2469            
2470             vData = thisData{1}
2471             cellData = textscan(vData,'%s','delimiter',',')
2472             vData = cellData{1}
2473            
2474             end
2475             end
2476            
2477             END_OF_MFILE2
2478            
2479             open(MFILE, "$outputDirectory/getMonolixProjectInfo.m" ) or die("Could not open file in M-file output directory\n");
2480            
2481             print MFILE <
2482            
2483             function [newArray] = getMonolixProjectInfo(fileName)
2484            
2485             fid = fopen(fileName);
2486             info = textscan(fid, '%q', 'delimiter', ',');
2487             lines = info{1};
2488            
2489             j = 1
2490            
2491             lineSize = size(lines);
2492             numLines = lineSize(1) * lineSize(2);
2493             newArrayDim = lineSize/4+10;
2494             newArray = cell(newArrayDim,4);
2495            
2496             k = 0
2497             for i = 1:numLines
2498            
2499             k = k + 1;
2500             if k > newArrayDim
2501             break
2502             end
2503             if j > numLines
2504             break
2505             end
2506             Fieldname = lines(j);
2507             Fieldname
2508            
2509             if class(Fieldname) ~= 'char'
2510             break
2511             end
2512             if ( strcmp(Fieldname,''))
2513             k = k - 1;
2514             j = j + 2;
2515             continue
2516             end
2517            
2518             if isEOL(Fieldname)
2519             j = j + 1;
2520             continue
2521             end
2522            
2523             newArray(k,1) = Fieldname;
2524            
2525             FieldType = lines(j+1);
2526            
2527             if isEOL(FieldType)
2528             j = j + 1;
2529             continue
2530             end
2531             newArray(k,2) = FieldType;
2532            
2533             FieldLength = lines(j+2);
2534            
2535             if isEOL(FieldLength)
2536             j = j + 1;
2537             continue
2538             end
2539             newArray(k,3) = FieldLength;
2540            
2541             length = str2num(FieldLength{1});
2542            
2543             j = j + 3;
2544            
2545             if ( length == 1 )
2546             aString = lines(j);
2547             newArray(k,4) = aString;
2548             elseif (length > 1 )
2549             myArray = lines(j:(j+length-1));
2550             newArray(k,4) = {myArray};
2551             end
2552            
2553             j = j + length;
2554            
2555             if ( j > numLines)
2556             break
2557             end
2558            
2559             while ( j > 0 )
2560             aCell = lines(j);
2561             if isEOL(aCell)
2562             break;
2563             end
2564             j = j - 1;
2565             end
2566            
2567             j = j + 1;
2568            
2569             end
2570            
2571             newArray = newArray(1:k-1,1:4)
2572            
2573             fclose(fid);
2574            
2575             function [result] = isEOL(aCell)
2576            
2577             result = 0;
2578            
2579             if numel(aCell) > 0
2580            
2581             aString = aCell{1};
2582            
2583             if class(aString) == 'char'
2584             if strcmp(aString, 'EOL')
2585             result = 1;
2586             end
2587             end
2588             end
2589            
2590             END_OF_MFILE3
2591            
2592             }
2593            
2594             sub MONOLIX_splitModelsAccordingToDosing
2595             {
2596            
2597             my ( $inputDirectory, $outputDirectory ) = @_;
2598            
2599             opendir(RUNDIR,$inputDirectory) or die("Could not open input directory $inputDirectory\n");
2600             my @files = grep ( /\.m/i, readdir(RUNDIR));
2601             close(READDIR);
2602             my $dose = '';
2603             foreach my $file ( @files )
2604             {
2605            
2606             my $sd = '';
2607             my $md = '';
2608             my $ss = '';
2609            
2610             open(INPUT,"$inputDirectory/$file") or die("Could not open input file $file in $inputDirectory\n");
2611            
2612             while()
2613             {
2614            
2615             next if /^\%/g;
2616             if (/.*if.*X\.type_dose.*\'sd\'.*/)
2617             {
2618             $dose = 'SD' ; next;
2619             }
2620            
2621             if (/.*elseif.*X.*type_dose.*\'md\'.*/)
2622             {
2623             $dose = 'MD'; next;
2624             }
2625            
2626             if (/.*if.*X\.type_dose.*\'ss\'|else\W.*/)
2627             {
2628             $dose = 'SS'; next;
2629             }
2630            
2631             if (/^end\W/)
2632             {
2633             $dose = '';next;
2634             }
2635            
2636             $sd .= $_ if ( $dose eq 'SD' or $dose eq '' );
2637             $md .= $_ if ( $dose eq 'MD' or $dose eq '');
2638             $ss .= $_ if ( $dose eq 'SS' or $dose eq '');
2639             }
2640            
2641             $file =~ s/\.m//g;
2642            
2643             $file = uc( $file);
2644            
2645             open(FILE,">$outputDirectory/${file}_SD.M");
2646             print FILE $sd;
2647             close( FILE);
2648            
2649             open(FILE,">$outputDirectory/${file}_MD.M");
2650             print FILE $md;
2651             close(FILE);
2652            
2653             open(FILE,">$outputDirectory/${file}_SS.M");
2654             print FILE $ss;
2655             close(FILE);
2656             }
2657             }
2658            
2659            
2660             #---------------------------------------------------------------------------
2661             #Package Models
2662            
2663            
2664             #-----------------Some variables for parsing -----------------------
2665            
2666             $improveThis = 1; #limitation of variables 1-9.
2667            
2668             $| = 1;
2669            
2670             my @DATAAttributes = ("IGNORE");
2671             my @SUBROUTINEAttributes = ("TOL");
2672             my $state = "None";
2673             my $columnString = "";
2674             my %globalAST;
2675             my $globalASTRef = \%globalAST;
2676            
2677             my %derivationsForVariables;
2678             my $derivationsForVariablesRef;
2679            
2680             my %reverseDerivationsForVariables = ();
2681            
2682             my %IfThenExpressionsForVariables;
2683             my $IfThenExpressionsForVariablesRef;
2684            
2685             my %variablesWithNumericSuffixes ;
2686             my $variablesWithNumericSuffixesRef;
2687             my %variablesWithoutNumericSuffixes ;
2688             my $variablesWithoutNumericSuffixesRef;
2689            
2690             my %logitFunctions;
2691             my %inverseLogitFunctions;
2692            
2693             my $commentCharacter;
2694             my $patternForFileName;
2695             my $patternForDirectoryName;
2696             my $assignmentOperator;
2697             my $leftParens;
2698             my $rightParens;
2699             my $lineSeparator;
2700            
2701             my @arrayOfInfoAsSideEffectsYesThisIsBad = ();
2702            
2703             my $modelType = "";
2704             my $notFirstProblem = 0;
2705            
2706             my $runsDirectory;
2707            
2708             my $writeNonmem;
2709             my $writeMaple;
2710             my $writeAsAlgebraicTheory;
2711             my $writeWinbugs;
2712             my $useWinBugs;
2713             my $writeTLC;
2714             my $useMATLAB;
2715            
2716             my $outputFileHandle = "";
2717             my $logFileHandle = "";
2718             my $mapleFileHandle = "";
2719             my $printHandle = "";
2720            
2721             my $debug = 1;
2722            
2723             my $NONMEMSourceDirectory = '/oss/';
2724             my $dataDirectory = '/oss/data';
2725             my $NONMEMDataFilesDirectory = 'c:/monolix/';
2726            
2727             #$patternForDirectoryName = "WINBUGS";
2728             #$patternForDirectoryName = "both";
2729            
2730             #$patternForFileName = ".*CTL";
2731             $runsDirectory = '/oss/runs';
2732            
2733             my $monolixSourceDirectory = 'c:/monolix/monolix_V23_1/libraries';
2734             my $monolixTargetDirectory = '/oss/monolixModels/';
2735            
2736             #-----------------------------------------------------------------------
2737            
2738             sub parseModelFile
2739             {
2740            
2741             my $selfRef;
2742             ( $patternForFileName, $patternForDirectoryName,
2743             $writeNonmem, $writeMaple, $writeAsAlgebraicTheory, $writeWinbugs, $writeTLC,
2744             $useWinBugs, $useMATLAB ) = @_;
2745            
2746             if ( $useWinBugs )
2747             {
2748             $commentCharacter = ";\#";
2749             #$patternForFileName = "\.bugs";
2750             #$patternForFileName = "model1\*";
2751             $assignmentOperator = "\<\-|\~|=";
2752             $leftParens = "\(";
2753             $rightParens = "\)";
2754             $lineSeparator = "\\n|;";
2755             $modelType = "WinBUGS";
2756             #$patternForDirectoryName = "";
2757             $runsDirectory = 'c:/algebraic/algebraicNONMEM/winRuns';
2758             }
2759             elsif ( $useMATLAB )
2760             {
2761             $commentCharacter = "%";
2762             #$patternForFileName = "sd\.m";
2763             #$patternForDirectoryName = ".";
2764             $assignmentOperator = "=";
2765             $leftParens = "\(";
2766             $rightParens = "\)";
2767             $lineSeparator = "\\n";
2768             $modelType = "MATLAB";
2769             $runsDirectory = 'runs';
2770             $useWinBugs = 0;
2771            
2772             }
2773             else{
2774            
2775             $/ = "\$";
2776            
2777             $commentCharacter = ";";
2778             $assignmentOperator = "=";
2779             $leftParens = "\(";
2780             $rightParens = "\)";
2781             $lineSeparator = "\\n";
2782             $modelType = "NONMEM";
2783             $useWinBugs = 0;
2784             }
2785            
2786             #find(\&getNONMEMDataFiles,$NONMEMDataFilesDirectory, $patternForFileName);
2787             find(\&getNONMEMControlFiles,$NONMEMSourceDirectory, $patternForFileName);
2788             #find(\&getMonolixModelFiles,$monolixSourceDirectory, $monolixTargetDirectory);
2789            
2790             }
2791            
2792            
2793            
2794             sub getRegularizedModelName
2795             {
2796            
2797             my $problemText = getSubTree($globalASTRef,"PROBLEM");
2798            
2799             my $modelName = $problemText;
2800             $modelName =~ s/ .*//g;
2801             #*Improve this* - should have dosing from data file...
2802             my $route = $problemText;
2803             $route =~ s/\_.*//g;
2804             if ( $route eq "ORAL" )
2805             {
2806             $route = "ORAL1";
2807             }
2808            
2809             my @modelParts = split(/\_/,$modelName);
2810             my $compartmentType = $modelParts[1];
2811             my $dosingType = $modelParts[$#modelParts];
2812            
2813             if ( $dosingType ne "SD" && $dosingType ne "MD" && $dosingType ne "SS" )
2814             {
2815             $dosingType = "SD";
2816             }
2817            
2818             my $PKVariableNamesRef = getSubTree($globalASTRef,"PK_VARIABLE_NAMES_FROM_DEPENDENCIES");
2819             my @PKVariableNames = @$PKVariableNamesRef;
2820            
2821             my $PKVariableNamesConcatenated = join("\.",@PKVariableNames);
2822             $PKVariableNamesConcatenated = PK_sortVariableNamesInDottedList($PKVariableNamesConcatenated);
2823             $globalASTRef = insertSubTree($globalASTRef,"PK_VARIABLE_NAMES_CONCATENATED",\$PKVariableNamesConcatenated);
2824            
2825             my $subroutineInfoRef = getSubTree($globalASTRef,"SUBROUTINE");
2826             my @subroutineInfo = @$subroutineInfoRef;
2827             if ( $subroutineInfo[0] eq "ADVAN1" or $subroutineInfo[1] eq "ADVAN2" )
2828             {
2829             $compartmentType = "1CPT";
2830             }
2831             elsif ($subroutineInfo[0] eq "ADVAN3" or $subroutineInfo[1] eq "ADVAN4" )
2832             {
2833             $compartmentType = "2CPT";
2834             }
2835            
2836             my $completeFileName = "${route}_${compartmentType}_${PKVariableNamesConcatenated}_${dosingType}";
2837            
2838             return $completeFileName;
2839            
2840             }
2841            
2842             sub insertFileContentsIntoAbstractSyntaxTree
2843             {
2844             my ( $potentialFileNamesRef, $astRef, $token) = @_;
2845            
2846             my @potentialFileNames = @$potentialFileNamesRef;
2847            
2848             my $linesFound = 0;
2849             my $fileFound = open(INPUTFILE,$potentialFileNames[0]);
2850             if ( ! $fileFound )
2851             {
2852             $fileFound = open(INPUTFILE,$potentialFileNames[1]);
2853             if ( ! $fileFound )
2854             {
2855             print("Could not open file to insert into AST\n");
2856             }
2857             }
2858            
2859             if ( $fileFound )
2860             {
2861             my $oldSeparator = $/;
2862             $/ = "\n";
2863            
2864             my @lines = ;
2865            
2866             my $joinedLines = join("\n", @lines);
2867             my ( $parseTreeRef, $stateForParseDEQ ) = parseEquations($joinedLines,"OK");
2868            
2869             $/ = $oldSeparator;
2870            
2871             $astRef = insertSubTree($astRef,$token,$parseTreeRef,);
2872             $linesFound = scalar(@lines);
2873             }
2874            
2875             return($astRef);
2876            
2877             }
2878            
2879            
2880             sub copyFileToAlgebraicTheoryLines
2881             {
2882             my ( $inputFileName, $AlgebraicTheoryHandle, $token) = @_;
2883            
2884             my $linesFound = 0;
2885             my $fileFound = open(INPUTFILE,$inputFileName);
2886            
2887             if ( $fileFound )
2888             {
2889             my $oldSeparator = $/;
2890             $/ = "\n";
2891            
2892             my @lines = ;
2893             foreach my $line ( @lines )
2894             {
2895             chomp $line;
2896             next unless $line =~ /\w/;
2897             $line =~ s/\s+//g;
2898             my @parts = split(/=/,$line);
2899            
2900             my $relationalOp = "=";
2901            
2902             my $string = "$token,$parts[0],$relationalOp,$parts[1]";
2903            
2904             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($string) . "\n";
2905             }
2906            
2907             close(INPUTFILE);
2908             $/ = $oldSeparator;
2909            
2910             $linesFound = scalar(@lines);
2911             }
2912            
2913            
2914             return ( $linesFound);
2915             }
2916            
2917            
2918             sub ParseMATLABMetadataAndModel
2919             {
2920             my $inputFileHandle = $_[0];
2921             my $outputFileHandle = $_[1];
2922             my $logFileHandle = $_[2];
2923             my $TLCOutputFileName= $_[3];
2924             my $dataFileName = $_[4];
2925            
2926             my @globalASTLines = <$inputFileHandle>;
2927            
2928             my @modelParts = split(/\%[\-]+\w+[\-]+/,$globalASTLines[0]);
2929             my $treeRef = "";
2930             my %treeRefs = ();
2931             my $iTree = 1;
2932            
2933             foreach my $modelPart ( @modelParts )
2934             {
2935             next if $modelPart eq "";
2936             my ($treeRef, $state) = parseMATLABModel($modelPart,$outputFileHandle,$logFileHandle,$TLCOutputFileName,$dataFileName);
2937             $treeRefs{$iTree++} = $treeRef;
2938             }
2939            
2940             $improveThis = 1;
2941             unless ( $improveThis )
2942             {
2943             printResults($derivationsForVariablesRef, $inputFileHandle,$outputFileHandle,
2944             $logFileHandle,$TLCOutputFileName,$dataFileName,$useWinBugs,$useMATLAB);
2945             }
2946            
2947             return ( \%treeRefs, $state );
2948            
2949             }
2950            
2951             sub parseMATLABModel
2952             {
2953             my $modelPart = $_[0];
2954             $outputFileHandle = $_[1];
2955             $logFileHandle = $_[2];
2956             my $TLCOutputFileName= $_[3];
2957             my $dataFileName = $_[4];
2958            
2959             my $i = 0;
2960             my $state = "NULL";
2961            
2962             my $parseRoutine = "parsePK";
2963             my $myTimes = 0;
2964            
2965             my $iLine = 1;
2966            
2967             $improveThis = 1; # just handle as a single line [ maybe?]
2968             my @globalASTLines = split(/\n/,$modelPart);
2969            
2970             my $reassembledModel = "";
2971             foreach my $line ( @globalASTLines )
2972             {
2973             $improveThis = 1;
2974             if ( $line =~ /\[/)
2975             {
2976            
2977             $line =~ s/\[\s*/bracket\(/g;
2978             $line =~ s/\s+/\,/g;
2979             $line =~ s/,\)/\)/g;
2980             $line =~ s/\s*\]/\)/g;
2981             }
2982             if ( $improveThis )
2983             {
2984             $line =~ s/\.\*/\*/g;
2985             $line =~ s/\.\//\//g;
2986             $line =~ s/([A-Za-z]+)\.([A-Za-z])+/$1_$2/g;
2987             $line =~ s/\:/colon/g;
2988             }
2989             $line =~ s/;//g;
2990             $line =~ s/\(\)/\(NULL\)/g;
2991            
2992             if ( $improveThis )
2993             {
2994             if ( $line =~ /function\s+/)
2995             {
2996             my @lineParts = split(/function/,$line);
2997             $line = "function=givenNext\n$lineParts[0] $lineParts[1]";
2998            
2999             }
3000            
3001             }
3002            
3003             $reassembledModel .= $line . "\n";
3004             }
3005            
3006             my $parseTreeRef = "";
3007             ($parseTreeRef,$state) = parseEquations($reassembledModel);
3008            
3009             return($parseTreeRef,"OK");
3010            
3011             }
3012            
3013             sub ParseNONMEMFile
3014             {
3015             my $inputFileHandle = $_[0];
3016             $outputFileHandle = $_[1];
3017             $logFileHandle = $_[2];
3018             my $TLCOutputFileName= $_[3];
3019             my $dataFileName = $_[4];
3020            
3021             my $i = 0;
3022             my $state = "NULL";
3023            
3024             my %headerAbbreviations =
3025             (
3026             "PROBLEM" => "PROBLEM",
3027             "PROB" => "PROBLEM",
3028             "COMMENT" => "COMMENT",
3029             "DATA" => "DATA",
3030             "INPUT" => "INPUT",
3031             "SUBR" => "SUBROUTINE",
3032             "SUBROUTINE"=> "SUBROUTINE",
3033             "SUBROUTINES"=>"SUBROUTINE",
3034             "SUB" => "SUBROUTINE",
3035             "MODEL" => "MODEL",
3036             "PK" => "PK",
3037             "PRED" => "PRED",
3038             "DES" => "DES",
3039             "ERROR" => "ERROR",
3040             "THETA" => "THETA",
3041             "OMEGA" => "ETA",
3042             "SIGMA" => "SIGMA",
3043             "SCAT" => "SCAT",
3044             "EST" => "ESTIMATION",
3045             "ESTIMATION" => "ESTIMATION",
3046             "COVA" => "COVA",
3047             "COVR" => "COVA",
3048             "COV" => "COVA",
3049             "TAB" => "TABLE",
3050             "TABLE" => "TABLE",
3051             "model" => "WinBUGSModel",
3052             "list" => "ListStatement",
3053             "Dog" => "Dog"
3054            
3055             );
3056            
3057             my %parseRoutines =
3058             (
3059             "PROBLEM" => \&parsePROBLEM,
3060             "COMMENT" => \&parseCOMMENT,
3061             "DATA" => \&parseDATA,
3062             "INPUT" => \&parseINPUT,
3063             "SUBROUTINE"=> \&parseSUBROUTINE,
3064             "MODEL" => \&parseMODEL,
3065             "PK" => \&parsePK,
3066             "PRED" => \&parsePRED,
3067             "DES" => \&parseDES,
3068             "ERROR" => \&parseERROR,
3069             "THETA" => \&parseTHETA,
3070             "ETA" => \&parseETA,
3071             "SIGMA" => \&parseSIGMA,
3072             "SCAT" => \&parseSCAT,
3073             "ESTIMATION" => \&parseEST,
3074             "COVA" => \&parseCOVA,
3075             "TABLE" => \&parseTAB,
3076             "model" => \&parseWinBUGSModel,
3077             "list" => \&parseListStatement,
3078             "Dog" => \&parseDog
3079            
3080             );
3081            
3082             my %tokenAttributes =
3083             (
3084             "DATA" => \@DATAAttributes,
3085             "SUBROUTINE" => \@SUBROUTINEAttributes,
3086             "SUB" => \@SUBROUTINEAttributes
3087             );
3088            
3089             my $parseRoutine = "";
3090             my $myTimes = 0;
3091            
3092             my @globalASTLines = <$inputFileHandle>;
3093            
3094             my $lastChar = "";
3095             for ( my $i = 0; $i < scalar(@globalASTLines); $i++)
3096             {
3097            
3098             $_ = $globalASTLines[$i];
3099            
3100             print $logFileHandle $_;
3101            
3102             chomp;
3103             next unless /\w/;
3104             my $nextLastChar = substr($_,-1);
3105            
3106             my $ref = "NULL";
3107             my $state = "NULL";
3108            
3109             my $keepSeparator = 1;
3110             my $headAndTailRef;
3111             ( $headAndTailRef, $state) = parseHeadAndTail($_,"\\s+|\\(",$keepSeparator);
3112             my %headAndTail = %$headAndTailRef;
3113            
3114             $improveThis = 1; #Should map head to common head first.
3115             my $head = $headAndTail{"head"};
3116             my $tail = $headAndTail{"tail"};
3117             my $rightTree = $headAndTail{"right"};
3118            
3119             if ( $head eq "PROB" or $head eq "PROBLEM" )
3120             {
3121             if ( $notFirstProblem )
3122             {
3123             $globalASTRef = \%globalAST;
3124             printResults($derivationsForVariablesRef,
3125             $inputFileHandle,$printHandle,$logFileHandle,$TLCOutputFileName,$dataFileName,$useWinBugs,$useMATLAB);
3126             reinitStates();
3127             }
3128             $notFirstProblem = 1;
3129            
3130             }
3131            
3132             if ( $head eq "" )
3133             {
3134             print "Blank line or comment found, $_\n";
3135             next;
3136             }
3137            
3138             if ( $debug )
3139             {
3140             print $logFileHandle "\n----------------------\n",$head,"\n----------------------\n";
3141             }
3142            
3143             my $finalHead = $headerAbbreviations{$head};
3144             my $parseRoutine = $parseRoutines{$finalHead};
3145            
3146             if ( $finalHead eq "" or $parseRoutine eq "" )
3147             {
3148             print "Error -- No such token $head\n";
3149             return;
3150             }
3151             $improveThis =1; #Use separate variable name here.
3152             $head = $finalHead;
3153            
3154             my $attributes = $tokenAttributes{$head};
3155            
3156             ($ref,$state) = $parseRoutine->($tail,$state,$attributes);
3157            
3158             if ( ref($ref) && $ref =~ /.*HASH.*/)
3159             {
3160             my %parseTreeForRef = %$ref;
3161             $rightTree = $parseTreeForRef{"right"};
3162            
3163             unless ( $rightTree eq "" )
3164             {
3165             $i--;
3166             $globalASTLines[$i] = $rightTree;
3167             $parseTreeForRef{"right"} = "";
3168             $ref = \%parseTreeForRef;
3169             }
3170             }
3171            
3172             if ( $lastChar eq ";" )
3173             {
3174             $globalAST{";" . $head} .= $ref;
3175             }
3176             else
3177             {
3178             $globalAST{$head} = $ref;
3179             }
3180             $lastChar = $nextLastChar;
3181            
3182             if ( $debug )
3183             {
3184             my @myKeys = keys ( %$globalASTRef );
3185             if ( scalar(@myKeys) > 0 )
3186             {
3187             foreach my $key ( @myKeys )
3188             {
3189             print $key;
3190             print ", ";
3191             }
3192             print "\n";
3193             print $logFileHandle "----------------------------\n";
3194             printTree(\%globalAST, 0,$logFileHandle,"");
3195             print $logFileHandle "\n--------------------------\n";
3196             }
3197             }
3198            
3199            
3200             }
3201            
3202             $globalASTRef = \%globalAST;
3203            
3204             printResults($derivationsForVariablesRef, $inputFileHandle,$outputFileHandle,
3205             $logFileHandle,$TLCOutputFileName,$dataFileName,$useWinBugs,$useMATLAB);
3206             }
3207            
3208             sub derivativeFilter
3209             {
3210             my $hashTreeRef = $_[0];
3211            
3212             if ( $debug )
3213             {
3214             printTree($hashTreeRef,0,$logFileHandle,"");
3215             }
3216            
3217             if ( ! ref($hashTreeRef) || $hashTreeRef !~ /HASH/)
3218             {
3219             return 0;
3220             }
3221            
3222             my %hashTree = %$hashTreeRef;
3223            
3224             if ( $hashTree{"oper"} eq "func" && $hashTree{"fname"} eq "D" )
3225             {
3226             return(1);
3227             }
3228             return(0);
3229            
3230             }
3231            
3232             sub obtainDerivatives
3233             {
3234             my $hashTreeRef = $_[0];
3235            
3236             my @array = ();
3237            
3238             #Check pre-conditions
3239             if ( ref($hashTreeRef) && $hashTreeRef =~ /HASH/)
3240             {
3241             my %hashTree = %$hashTreeRef;
3242             my $hashTreeLeftRef = $hashTree{"left"};
3243            
3244             if ( ref($hashTreeLeftRef) && $hashTreeLeftRef =~ /HASH/)
3245             {
3246             my %hashTreeLeft = %$hashTreeLeftRef;
3247             if ( $hashTreeLeft{"oper"} eq "func" && $hashTreeLeft{"fname"} eq "D" )
3248             {
3249             $array[0] = $hashTreeRef;
3250             }
3251             }
3252             }
3253             return(\@array,"OK");
3254            
3255             }
3256            
3257             sub doReplacements
3258             {
3259             my $parseTreeRef = $_[0];
3260             my $variableNamesRef = $_[1];
3261             my $aliasesRef;
3262             my $aliases1Ref;
3263            
3264             $improveThis = 1; #nparams should not be set.
3265             my $nParams = 10;
3266            
3267             my @variableNames = @$variableNamesRef;
3268            
3269             my %inverseMapOfParameters = ();
3270             my $inverseMapOfParametersRef = \%inverseMapOfParameters;
3271             foreach my $variableName ( @variableNames )
3272             {
3273             my %tags = ( label => $variableName, startTag => $variableName, endTag => "\n", routine => \&obtainInverseHashOfValues, subRoutine => \&dummy);
3274             ($inverseMapOfParametersRef,$state) = obtainInverseHashOfValues($derivationsForVariablesRef,\%tags, 0,\%inverseMapOfParameters );
3275             %inverseMapOfParameters = %$inverseMapOfParametersRef;
3276             }
3277            
3278             if ( 1 )
3279             {
3280             open(DOG,">>dog.txt");
3281             print DOG "000000000000000000000000000000000000000000000000000000000000000\n";
3282             printTree($inverseMapOfParametersRef,0,*DOG,"");
3283             }
3284            
3285             my $justModifyRHS = 1;
3286             # ($parseTreeRef,$state) = modifyTree($parseTreeRef,\&checkForNames,\&replaceNamesUsingInverseMap,$inverseMapOfParametersRef,"",0,100,$justModifyRHS);
3287            
3288             if ( 0 )
3289             {
3290             printTree($parseTreeRef,0,*DOG,"");
3291             close(DOG);
3292             }
3293            
3294             my $mapToUseOfVectors = 0;
3295            
3296             if ( $mapToUseOfVectors )
3297             {
3298             my %inverseMap1OfParameters = ();
3299            
3300             my $inverseMap1OfParametersRef = \%inverseMap1OfParameters;
3301             foreach my $variableName ( @variableNames )
3302             {
3303             ($inverseMap1OfParametersRef,$state ) = mapNamesToUseOfVectors($inverseMapOfParametersRef,$variableName,$nParams );
3304             %inverseMap1OfParameters = %$inverseMap1OfParametersRef;
3305             }
3306            
3307             ($parseTreeRef,$state) = modifyTree($parseTreeRef,\&checkForNames,\&replaceNames,$inverseMap1OfParametersRef,"",0,100,$justModifyRHS);
3308            
3309             if ( 0 )
3310             {
3311             open(DOG,">>dog.txt");
3312             print DOG "1111111111111111111111111111111111111111111111111111111111111111111\n";
3313             printTree($parseTreeRef,0,*DOG,"");
3314             close(DOG);
3315             }
3316             }
3317            
3318             return ( $parseTreeRef, $state );
3319             }
3320            
3321             sub doReplacementsForMaple
3322             {
3323             my $parseTreeRef = $_[0];
3324             my $tag = $_[1];
3325             my $useJetNotation = $_[2];
3326            
3327             my $aliasesRef;
3328             my $aliases1Ref;
3329            
3330             my $nParams = 10;
3331             my %tags = ( label => $tag, startTag => $tag, endTag => "\n", routine => \&obtainInverseHashOfValuesForMaple, subRoutine => \&dummy);
3332            
3333             #Improve this -- I don't use it now...
3334             ($aliasesRef,$state) = getInfoFromTree($derivationsForVariablesRef,\%tags,0);
3335            
3336             if ( $tag eq "DADT" )
3337             {
3338             if ( $useJetNotation )
3339             {
3340             ($aliases1Ref,$state ) = mapNamesOfDifferentialsToUseOfJetNotation($aliasesRef,$tag,$nParams );
3341             }
3342             else
3343             {
3344             ($aliases1Ref,$state ) = mapNamesOfDifferentialsToUseOfVectors($aliasesRef,$tag,$nParams );
3345             }
3346             }
3347             elsif ( $tag eq "A")
3348             {
3349             if ( $useJetNotation )
3350             {
3351             ($aliases1Ref,$state ) = mapNamesToUseOfJetNotation($aliasesRef,$tag,$nParams );
3352             }
3353             else
3354             {
3355            
3356             ($aliases1Ref,$state ) = mapNamesToUseOfMapleVectors($aliasesRef,$tag,$nParams );
3357             }
3358             }
3359             else
3360             {
3361             ($aliases1Ref,$state ) = mapNamesToUseOfVectors($aliasesRef,$tag,$nParams );
3362             }
3363            
3364             ($parseTreeRef,$state) = modifyTree($parseTreeRef,\&checkForNames,\&replaceNames,$aliases1Ref,"",0,100,0);
3365            
3366             if ( $debug )
3367             {
3368             printTree($parseTreeRef,0,*STDOUT,"");
3369             }
3370            
3371             return ( $parseTreeRef, $state );
3372             }
3373            
3374             sub getHashValues
3375             {
3376             my $hashTreeRef = $_[0];
3377            
3378             if ( ref($hashTreeRef ) && $hashTreeRef =~ /HASH/ )
3379             {
3380             return $hashTreeRef;
3381             }
3382             else
3383             {
3384             return "";
3385             }
3386             }
3387            
3388             sub getHashOfFunctions
3389             {
3390             my $hashTreeRef = $_[0];
3391             my $tagsRef = $_[1];
3392            
3393             my %tags = %$tagsRef;
3394             my $startTag = $tags{"startTag"};
3395             my $endTag = $tags{"endTag"};
3396             my $separator = $tags{"separator"};
3397            
3398             my $string = "";
3399             if ( ref($hashTreeRef ) && $hashTreeRef =~ /HASH/ )
3400             {
3401             $string = $startTag;
3402            
3403             my %hashTree = %$hashTreeRef;
3404             my $first = 1;
3405             foreach my $key ( keys( %hashTree))
3406             {
3407             $string .= $separator unless ( $first );
3408             $string .= "$key = $hashTree{$key}";
3409             $first = 0;
3410             }
3411            
3412             $string .= $endTag;
3413             }
3414            
3415             return ( $string, "OK");
3416             }
3417            
3418             sub writeMonolixDataFile
3419             {
3420             my $TLCOutputFileName = $_[1];
3421             my $dataFileName = $_[2];
3422            
3423             my %processingMethods = (
3424             getLanguageSpecificVersionOfVariable => \&getNonmemVersionOfVariable,
3425             getIfThenExpression => \&getNonmemIfThenExpression,
3426             modifyDifferentialExpression => \&useNonmemDifferentialExpression,
3427             getForLoopExpression => \&getNonmemForLoopExpression,*
3428             assignmentOperator => " = "
3429             );
3430            
3431             my $NonmemFileName = $TLCOutputFileName;
3432             $NonmemFileName =~ s/\.TLC/\.MONOLIXEXTRA/ig;
3433            
3434             open(NonmemFILE,">>$NonmemFileName" ) or die("Could not open Nonmem file $NonmemFileName\n");
3435             my $NONMEMFileHandle = *NonmemFILE;
3436             $printHandle = $NONMEMFileHandle;
3437            
3438             my $variablesCountTreeRef = getSubTree($globalASTRef,"NB_COUNT");
3439             my %variablesCountTree = %$variablesCountTreeRef;
3440            
3441             print $printHandle "cat_model=","pk", "\n";
3442            
3443             my $problemText = getSubTree($globalASTRef,"PROBLEM");
3444            
3445             print $printHandle "desc=", "'", $problemText, "'", "\n";
3446             print $printHandle "dose=", 1,"\n";
3447            
3448             my $LHSPKDependenciesRef = getSubTree($globalASTRef,"LHS_DEPENDENCIES");
3449             my %LHSPKDependencies = %$LHSPKDependenciesRef;
3450            
3451             my @logStruct = ();
3452            
3453             my $foundExponentiationAndMultiplication = 0;
3454            
3455             my $PKVariableNamesRef = getSubTree($globalASTRef,"PK_VARIABLE_NAMES");
3456             my @PKVariableNames = @$PKVariableNamesRef;
3457            
3458             foreach my $variableName ( @PKVariableNames )
3459             {
3460             my $VTreeRef = $LHSPKDependencies{$variableName};
3461            
3462             if ( ref($VTreeRef) && $VTreeRef =~ /HASH/)
3463             {
3464             my %VTree = %$VTreeRef;
3465             my $operatorsString = $VTree{"operators"};
3466             $foundExponentiationAndMultiplication = $operatorsString =~ /\^/ && $operatorsString =~ /\*/;
3467             }
3468             push(@logStruct,$foundExponentiationAndMultiplication);
3469            
3470             }
3471            
3472             print $printHandle "logStruct=[", join(" ", @logStruct), "]\n";
3473            
3474             my $numDifferentialEquationsRef = getSubTree($globalASTRef,"NUM_DIFFERENTIAL_EQUATIONS");
3475             my $numDifferentialEquations = $$numDifferentialEquationsRef;
3476            
3477             print $printHandle "nb_ode=", $numDifferentialEquations,"\n";
3478             print $printHandle "nb_param=", $variablesCountTree{"length"},"\n";
3479             print $printHandle "nb_varex=1\n";
3480             print $printHandle "ode=", 0,"\n";
3481             print $printHandle "phi_names=[", join(",", @PKVariableNames), "]\n";
3482             print $printHandle "tex_names=[", join(",", @PKVariableNames), "]\n";
3483            
3484             my @xNames;
3485             my @yNames;
3486            
3487             push(@xNames,"time");
3488             push(@yNames,"concentration");
3489             print $printHandle "r=[ ", join(",", @xNames), "]\n";
3490             print $printHandle "y_names=[ ", join(",", @yNames), "]\n";
3491            
3492             close($printHandle);
3493            
3494             }
3495            
3496             sub getNumberOfParams
3497             {
3498             my ( $hashOfAllArraysRef,$variableName) = @_;
3499             my %hashOfAllArrays = %$hashOfAllArraysRef;
3500             my $thisArrayRef = $hashOfAllArrays{$variableName};
3501            
3502             my $iCount = 0;
3503             if ( ref($thisArrayRef) && $thisArrayRef =~ /ARRAY/)
3504             {
3505             my @array = @$thisArrayRef;
3506             $iCount = scalar(@array);
3507             }
3508            
3509             return ( $iCount);
3510            
3511             }
3512            
3513             sub writeMonolixModel
3514             {
3515             my $TLCOutputFileName = $_[1];
3516             my $dataFileName = $_[2];
3517            
3518             my %processingMethods = (
3519             getLanguageSpecificVersionOfVariable => \&getNonmemVersionOfVariable,
3520             getIfThenExpression => \&getNonmemIfThenExpression,
3521             modifyDifferentialExpression => \&useNonmemDifferentialExpression,
3522             getForLoopExpression => \&getNonmemForLoopExpression,*
3523             assignmentOperator => " = "
3524             );
3525            
3526             my $NonmemFileName = $TLCOutputFileName;
3527             $NonmemFileName =~ s/\.TLC/\.MONOLIX/ig;
3528            
3529             open(NonmemFILE,">>$NonmemFileName" ) or die("Could not open Nonmem file $NonmemFileName\n");
3530             my $NONMEMFileHandle = *NonmemFILE;
3531             $printHandle = $NONMEMFileHandle;
3532            
3533             my $variablesCountTreeRef = getSubTree($globalASTRef,"NB_COUNT");
3534             my %variablesCountTree = %$variablesCountTreeRef;
3535            
3536             my $monolixFileName = getRegularizedModelName();
3537             my $fileRoot = "/oss/models/monolix/versionsSplitByDosing/";
3538            
3539             my $fileFound = 1;
3540             unless ( open(MONOLIX,"$fileRoot$monolixFileName.M"))
3541             {
3542             $fileFound = 0;
3543             }
3544            
3545             $NonmemFileName =~ s/.*both\_//g;
3546             $NonmemFileName =~ s/\.Monolix/\.CTL/ig;
3547            
3548             if ( $fileFound )
3549             {
3550             open(LOGSSHERE, ">>ErrorsFile.parseLog") or die("Could not open errors file\n");
3551             print LOGSSHERE "$monolixFileName $NonmemFileName\n";
3552             close(LOGSSHERE);
3553             }
3554             else
3555             {
3556             open(ERRORSHERE, ">>ErrorsFile.err") or die("Could not open errors file\n");
3557             my $varNamesRef = getSubTree($globalASTRef,"PK_VARIABLE_NAMES_ORIGINAL");
3558             my @varNames = @$varNamesRef;
3559             print ERRORSHERE "$monolixFileName $NonmemFileName", join(",",@varNames), "\n";
3560             close(ERRORSHERE);
3561            
3562            
3563             }
3564            
3565             if ( $fileFound )
3566             {
3567             my @monolixLines = ;
3568             print $printHandle @monolixLines;
3569             }
3570            
3571             close($printHandle);
3572            
3573             }
3574            
3575            
3576             sub printResults
3577             {
3578             my ( $derivationsForVariablesRef, $inputFileHandle, $outputFileHandle,
3579             $logFileHandle, $TLCOutputFileName, $dataFileName, $useWinBugs,$useMATLAB ) = @_;
3580            
3581             $improveThis = 1;
3582            
3583             my $derivativesRef = "";
3584            
3585             #Improve this;
3586             my $nameOfModelAccordingToFile = $TLCOutputFileName;
3587             $nameOfModelAccordingToFile =~ s/\.*\///g;
3588             $nameOfModelAccordingToFile =~ s/\.*\\//g;
3589            
3590             $nameOfModelAccordingToFile =~ s/\.[a-zA-Z]+$//i;
3591             #Improve this -- remove the preliminary "Study" name that goes with this model.
3592             $nameOfModelAccordingToFile =~ s/.*both\_//i;
3593             $globalASTRef = insertSubTree($globalASTRef,"MODEL_NAME_FROM_FILE",\$nameOfModelAccordingToFile);
3594            
3595             if ( $modelType eq "WinBUGS")
3596             {
3597            
3598             my @subTreeNames = ("list", "middle", "left", "right");
3599             my %tags = ( label => "MODEL ", startTag => "", endTag => "\n", separator => "\n", routine => \&getSingleString,subRoutine => \&dummy );
3600             my $arrayOfSubstitionsRef;
3601             ( $arrayOfSubstitionsRef, $state ) = getArrayOfInfoFromSubTree($globalASTRef,\@subTreeNames,\%tags,0);
3602             my @arrayOfSubstitions = @$arrayOfSubstitionsRef;
3603             my $substitutionsRef = $arrayOfSubstitions[0];
3604            
3605             my @names = ( "model");
3606             ($globalASTRef,$state) = modifySubTree($globalASTRef,\@names,\&checkForNames,\&replaceNames,$substitutionsRef,"",0,100,0);
3607            
3608             my %processingMethods = (
3609             getLanguageSpecificVersionOfVariable => \&getNonmemVersionOfVariable,
3610             getIfThenExpression => \&getNonmemIfThenExpression
3611             );
3612            
3613             my $problem = ";\# PBPK system equations specified via BUGS language";
3614             $globalASTRef = insertSubTree($globalASTRef,"PROBLEM", \$problem);
3615            
3616             my $variableName = "C";
3617             my $newVariableName = "A";
3618             ($globalASTRef,$state) = modifyTree($globalASTRef,\&checkForUseOfVector,\&renameFunction,$variableName,$newVariableName,0,100,0);
3619            
3620             my @variableNames = ("A","KI","KO","V");
3621             for my $variableName (@variableNames )
3622             {
3623             ($globalASTRef,$state) = modifyTree($globalASTRef,\&checkForUseOfVector,\&replaceUseOfFunctionWithScalar,$variableName,"",0,100,0);
3624             }
3625            
3626             %tags = ( label => "Derivatives ", startTag => "\$MODEL\n", endTag => "\n", separator => "\n", routine => \&obtainDerivatives,subRoutine => \&dummy );
3627             my $arrayOfDerivativesRef;
3628             ( $arrayOfDerivativesRef, $state ) = getArrayOfInfoFromSubTree($globalASTRef,"model",\%tags,0);
3629            
3630             %tags = ( label => "DerivativesHash", startTag => "", separator => "", endTag => "",routine => \&getHashTreeOfDifferentialEquation, getLeftRightOrBothSides => 'Both', ignoreDifferentialEquations => 0, processingMethods => \%processingMethods, subRoutine => "" );
3631             my $winBugsEquationsRef;
3632             ( $winBugsEquationsRef, $state ) = getArrayOfInfoFromTree($arrayOfDerivativesRef,\%tags,0);
3633            
3634             %tags = ( label => "NonDerivativesHash", startTag => "\$PK\n", endTag => "\n", separator => "\n", routine => \&getHashTreeOfDifferentialEquation, ignoreDifferentialEquations => 2, subRoutine => \&dummy );
3635             my $arrayOfNonDerivativesRef;
3636             ( $arrayOfNonDerivativesRef, $state ) = getArrayOfInfoFromTree($globalASTRef,\%tags,0);
3637            
3638             my @treeAddress = ("DES");
3639             $globalASTRef = insertSubTree($globalASTRef,\@treeAddress,$winBugsEquationsRef);
3640            
3641             @treeAddress = ("PK");
3642             $globalASTRef = insertSubTree($globalASTRef,\@treeAddress,$arrayOfNonDerivativesRef);
3643            
3644             }
3645             else
3646             {
3647            
3648             my @variableNames = ("THETA","ETA","A","ERR","DADT");
3649            
3650             for my $variableName (@variableNames )
3651             {
3652             ($globalASTRef,$state) = modifyTree($globalASTRef,\&checkForUseOfVector,\&replaceUseOfVectorWithScalar,$variableName,"",0,100,0);
3653             }
3654            
3655             my %arrayOfAllBounds = ();
3656            
3657             my @arrayOfThetaBounds = ();
3658             my %tags = ( label => "THETA", startTag => "\$THETA\n ", separator =>"\n ", endTag => "\n", routine => \&fillInArrayOfValuesInParentheses, subRoutine => \&getThetaBoundsAsValues );
3659             ( $arrayOfAllBounds{"THETA"}, $state ) = fillInArrayOfInfoFromSubTree($globalASTRef,"THETA",\%tags,\@arrayOfThetaBounds,0);
3660            
3661             my @arrayOfOmegaBounds = ();
3662             %tags = ( label => "ETA", startTag => "\$OMEGA ", separator =>" ", endTag => "\n", routine => \&fillInArrayOfValuesInParentheses, subRoutine => \&getOmegaBoundsAsValues );
3663             ( $arrayOfAllBounds{"ETA"}, $state ) = fillInArrayOfInfoFromSubTree($globalASTRef,"ETA",\%tags,\@arrayOfOmegaBounds,0);
3664            
3665             my @arrayOfSigmaBounds = ();
3666             %tags = ( label => "SIGMA", startTag => "\$SIGMA ", separator =>" ", endTag => "\n",routine => \&fillInArrayOfValuesInParentheses, subRoutine => \&getOmegaBoundsAsValues );
3667             ( $arrayOfAllBounds{"SIGMA"}, $state ) = fillInArrayOfInfoFromSubTree($globalASTRef,"ERROR",\%tags,\@arrayOfSigmaBounds,0);
3668            
3669             $globalASTRef = insertSubTree($globalASTRef,"THETA_BOUNDS",\%arrayOfAllBounds);
3670            
3671             @variableNames = ("THETA","ETA","A","ERR");
3672            
3673             my %allExponentialDependencies;
3674            
3675             for my $variableName (@variableNames )
3676             {
3677            
3678             my $iNumberOfParams = getNumberOfParams(\%arrayOfAllBounds,$variableName);
3679            
3680             for my $subTreeName ( "PK") #, "PRED", "DES")
3681             {
3682             my $subTree = getSubTree($globalASTRef,$subTreeName);
3683             traverseTreeForVectorItemDependencies($subTree,$variableName,0);
3684            
3685             }
3686             ($globalASTRef,$state) = modifyTree($globalASTRef,\&checkForUseOfVector,\&replaceUseOfVectorWithScalar,$variableName,"",0,100,0);
3687            
3688             for ( my $iNumber = 1; $iNumber <= $iNumberOfParams; $iNumber++ )
3689             {
3690             my %tags = ( label => "ParameterDependencies", startTag => "\$exponentialDependencies\n", endTag => "\n", separator => "\n", routine => \&checkForUseOfFunctionAndVariable, nameOfFunction => "exp", nameOfVariable => $variableName . $iNumber, subRoutine => \&dummy );
3691             my( $exponentialDependenciesRef, $state ) = getArrayOfInfoFromTree($globalASTRef,\%tags,0);
3692             $allExponentialDependencies{$variableName . $iNumber} = $exponentialDependenciesRef;
3693             }
3694             }
3695            
3696             $globalASTRef = insertSubTree($globalASTRef,"VECTOR_VARIABLE_DEPENDENCIES",$derivationsForVariablesRef);
3697            
3698             if ( 0 )
3699             {
3700             open(DOG,">>dog.txt" );
3701            
3702             printSubTree($globalASTRef,"PK",0,*DOG);
3703             printSubTree($globalASTRef,"DES",0,*DOG);
3704            
3705             printTree($derivationsForVariablesRef,0,*DOG,"");
3706             close(DOG);
3707             }
3708            
3709             $globalASTRef = insertSubTree($globalASTRef,"EXPONENTIAL_DEPENDENCIES",\%allExponentialDependencies);
3710            
3711            
3712             my %processingMethodsForStateVariables = (
3713             getLanguageSpecificVersionOfVariable => \&getNonmemVersionOfVariable,
3714             getIfThenExpression => \&getNonmemIfThenExpression,
3715             modifyDifferentialExpression => \&adaptDifferentialExpressionForStateVariable,
3716             assignmentOperator => " = "
3717             );
3718            
3719             my $stateVariablesRef = "";
3720            
3721             if ( doesSubTreeExist($globalASTRef,"DES") )
3722             {
3723             %tags = ( label => "DES", startTag => "", separator => ",", endTag => "", routine => \&getDifferentialEquations, processingMethods => \%processingMethodsForStateVariables, getLeftRightOrBothSides => 'Left', subRoutine => "" );
3724             ( $stateVariablesRef, $state ) = getInfoFromSubTree($globalASTRef,"DES",\%tags,0);
3725             }
3726             else
3727             {
3728             my $subroutineSubTreeRef = getSubTree($globalASTRef,"SUBROUTINE");
3729             if ( ref($subroutineSubTreeRef) && $subroutineSubTreeRef =~ /ARRAY/ )
3730             {
3731             my @subroutines = @$subroutineSubTreeRef;
3732             my $modelType = $subroutines[0];
3733             my $parameterization = $subroutines[1];
3734             my $equations = "";
3735             my $stateVariables = "";
3736             if ( $modelType eq "ADVAN1" )
3737             {
3738             if ( $parameterization eq "TRANS1" )
3739             {
3740             $equations = "DADT(1) = -K*A(1)\n";
3741             }
3742             elsif ( $parameterization eq "TRANS2" )
3743             {
3744             $equations = "DADT(1) = -(CL/V)*A(1)\n";
3745             }
3746             $stateVariables = "A1";
3747             }
3748             if ( $modelType eq "ADVAN2" )
3749             {
3750             $stateVariables = "A1";
3751             }
3752            
3753             if ( $modelType eq "ADVAN3" or $modelType eq "ADVAN4" )
3754             {
3755             $stateVariables = "A1,A2";
3756             }
3757            
3758             my $DESRef;
3759             ( $DESRef, $state ) = parseDES($equations);
3760             $globalASTRef = insertSubTree($globalASTRef,"DES",$DESRef);
3761             $stateVariablesRef = \$stateVariables;
3762             }
3763             }
3764            
3765             $globalASTRef = insertSubTree($globalASTRef,"PK_STATE_VARIABLES",$stateVariablesRef);
3766            
3767             my $priorsStringForThetas = constructPriorsForThetas(\%arrayOfAllBounds,\%allExponentialDependencies);
3768             $globalASTRef = insertSubTree($globalASTRef,"PRIORS",\$priorsStringForThetas);
3769            
3770             my @priorsStringsForEtas = constructPriorsForEtas(\%arrayOfAllBounds,\%allExponentialDependencies);
3771             $globalASTRef = insertSubTree($globalASTRef,"PRIORSForEtas",\@priorsStringsForEtas);
3772            
3773             #($globalASTRef,$state) = modifyTree($globalASTRef,,\&identityFunction,"exp","ETA1",0,100,0);
3774            
3775             $stateVariablesRef = getSubTree($globalASTRef,"PK_STATE_VARIABLES");
3776            
3777             $globalASTRef = copySubTree($globalASTRef,"PK","PKScaleFactors");
3778             $globalASTRef = modifySubTree($globalASTRef,"PKScaleFactors",\&checkForLHSVariableAbsent,\&deleteIfLHSVariableAbsent,"S\\d");
3779            
3780             %tags = ( label => "PKScaleFactors", startTag => "", separator => ",", endTag => "", routine => \&getDifferentialEquations, processingMethods => \%processingMethodsForStateVariables, getLeftRightOrBothSides => 'Left', subRoutine => "" );
3781             my $pkScaleFactorsRef;
3782             ( $pkScaleFactorsRef, $state ) = getInfoFromSubTree($globalASTRef,"PKScaleFactors",\%tags,0);
3783             $globalASTRef = insertSubTree($globalASTRef,"PK_SCALE_FACTORS",$pkScaleFactorsRef);
3784            
3785             my $observationFunctionsRef = constructObservationFunctions($stateVariablesRef,$pkScaleFactorsRef);
3786            
3787             $globalASTRef = insertSubTree($globalASTRef,"OBSERVATION_FUNCTIONS",$observationFunctionsRef);
3788            
3789             # for my $variableName (@variableNames )
3790             # {
3791             # ($globalASTRef,$state) = doReplacements($globalASTRef,$variableName);
3792             # }
3793            
3794             my %processingMethods;
3795            
3796             if ( $useWinBugs )
3797             {
3798             %processingMethods = (
3799             getLanguageSpecificVersionOfVariable => \&getWinbugsVersionOfVariable,
3800             getIfThenExpression => \&getWinbugsIfThenExpression
3801             );
3802             }
3803             else
3804             {
3805             %processingMethods = (
3806             getLanguageSpecificVersionOfVariable => \&getMapleVersionOfVariable,
3807             getIfThenExpression => \&getMapleIfThenExpression
3808             );
3809             }
3810            
3811             ($globalASTRef,$state) = modifyTree($globalASTRef,\&checkForTautology,\&deleteTautology,"","",0,100,0);
3812             ($globalASTRef,$state) = modifyTree($globalASTRef,\&checkForIFStatement,\&consolidateAsIfThenExpression,"","",0,100,0);
3813            
3814             my @analysisNames = ("PRED", "DES","PK");
3815             for my $aName ( @analysisNames )
3816             {
3817             ($globalASTRef,$state) = modifySubTree($globalASTRef,$aName, \&checkForArray,\&analyzeLHSVariables,\%processingMethods,"",0,100,0);
3818             #($globalASTRef,$state) = modifySubTree($globalASTRef,$aName,\&checkForVariable,\&analyzeVariable,"","",0,100,0);
3819             }
3820            
3821             ($globalASTRef,$state) = modifyTree($globalASTRef,\&checkForArrayWithOneElement,\&deleteUseOfArrayWithOneElement,"","",0,100,0);
3822            
3823             if ( $debug )
3824             {
3825             printTree($globalASTRef,0,$logFileHandle,"");
3826             }
3827             }
3828            
3829             if ( $debug )
3830             {
3831             print $logFileHandle "\n-----------------------------------------------------\n";
3832             print $logFileHandle "Additional derived information\n";
3833             }
3834            
3835             if ( 0 )
3836             {
3837             my %completeParseTree = %$globalASTRef;
3838             my $PREDTreeRef = $completeParseTree{"PRED"};
3839             modifyTree($PREDTreeRef,\&checkForAssignment,\&storeAssignment,"","",0,100,1);
3840             ($PREDTreeRef,$state) = modifyTree($PREDTreeRef,\&checkForNames,\&replaceNameWithParseTree,$derivationsForVariablesRef,"",0,100,1);
3841             $completeParseTree{"PRED"} = $PREDTreeRef;
3842             $globalASTRef = \%completeParseTree;
3843             }
3844            
3845             my $CATEGORICAL_VARIABLES = determineCATEGORICAL_VARIABLES( $globalASTRef );
3846             $globalASTRef = insertSubTree($globalASTRef,"CATEGORICAL_VARIABLES", \$CATEGORICAL_VARIABLES);
3847            
3848             my $priorsForThetasAsString = getPriorsForThetasAsString( $globalASTRef );
3849             $globalASTRef = insertSubTree($globalASTRef,"PRIORSFORTHETAS", \$priorsForThetasAsString);
3850            
3851             if ( $writeWinbugs )
3852             {
3853             writeWinbugsOut( $globalASTRef, $TLCOutputFileName );
3854             }
3855            
3856             my %processingMethodsForStateVariables = (
3857             getLanguageSpecificVersionOfVariable => \&getNonmemVersionOfVariable,
3858             getIfThenExpression => \&getNonmemIfThenExpression,
3859             modifyDifferentialExpression => \&useNonmemDifferentialExpression,
3860             assignmentOperator => " = "
3861             );
3862            
3863             if ( $writeNonmem )
3864             {
3865            
3866             my %processingMethodsForDependencies = (
3867             getLanguageSpecificVersionOfVariable => \&getLanguageIndependentVersionOfVariable,
3868             getIfThenExpression => \&getNonmemIfThenExpression,
3869             modifyDifferentialExpression => \&useNonmemDifferentialExpression,
3870             assignmentOperator => " = "
3871             );
3872            
3873             my $useJetNotation = 0;
3874            
3875             #Hack/question: should I handle ERR1 and A at this time as well?
3876             my @variableNames = ("THETA","ETA");
3877            
3878             my $PKTreeRef = getSubTree($globalASTRef,"PK");
3879             @arrayOfInfoAsSideEffectsYesThisIsBad = ();
3880             ($PKTreeRef,$state) = doReplacements($PKTreeRef,\@variableNames,$useJetNotation);
3881            
3882             $globalASTRef = insertSubTree($globalASTRef,"PK",$PKTreeRef);
3883            
3884             if ( 0 )
3885             {
3886             my $desRef = getSubTree($globalASTRef,"DES");
3887             ($desRef,$state) = doReplacements($desRef,\@variableNames,$useJetNotation);
3888             $globalASTRef = insertSubTree($globalASTRef,"DES",$desRef);
3889             }
3890            
3891             my %LHSDependencies = ();
3892             my %tags = ( label => "PK", startTag => "", endTag => "\n", processingMethods => \%processingMethodsForDependencies, routine => \&getLHSDependencies, subRoutine => \&dummy);
3893             $PKTreeRef = getSubTree($globalASTRef,"PK");
3894             my $dependenciesOnVectorsRef;
3895             ($dependenciesOnVectorsRef,$state) = getHashOfInfoFromTree($PKTreeRef,\%tags, 0, \%LHSDependencies );
3896            
3897             $globalASTRef = insertSubTree($globalASTRef,"LHS_DEPENDENCIES",$dependenciesOnVectorsRef);
3898             @arrayOfInfoAsSideEffectsYesThisIsBad = ();
3899             ($PKTreeRef,$state) = modifyTree($PKTreeRef,\&checkForNamesUsingOddRules,\&replacePKNamesUsingOddRules,$dependenciesOnVectorsRef,"",0,100,1);
3900             foreach my $variableToDelete ( @arrayOfInfoAsSideEffectsYesThisIsBad )
3901             {
3902             ($PKTreeRef,$state) = modifyTree($PKTreeRef,\&checkForLHSVariableAbsent,\&deleteIfLHSVariablePresent,$variableToDelete,"",0,100);
3903             }
3904            
3905             $globalASTRef = insertSubTree($globalASTRef,"PK",$PKTreeRef);
3906            
3907             my %DESLHSDependencies = ();
3908             my $DESTreeRef = getSubTree($globalASTRef,"DES");
3909             %tags = ( label => "DES", startTag => "", endTag => "\n", processingMethods => \%processingMethodsForDependencies, routine => \&getLHSDependencies, subRoutine => \&dummy);
3910             my ($DESdependenciesRef,$state) = getHashOfInfoFromTree($DESTreeRef,\%tags, 0, \%DESLHSDependencies );
3911             $globalASTRef = insertSubTree($globalASTRef,"DES_LHS_DEPENDENCIES",$DESdependenciesRef);
3912            
3913             %tags = ( label => "DES", startTag => "", endTag => "\n", processingMethods => \%processingMethodsForDependencies, routine => \&getFullRHSForVariable, subRoutine => \&dummy);
3914             my $DESExpandedTreeRef = getSubTree($globalASTRef,"DES");
3915            
3916             ($DESExpandedTreeRef,$state) = modifyTree($DESExpandedTreeRef,\&checkForNames,\&replaceNamesAndStoreThoseUsed,$dependenciesOnVectorsRef,"",0,100,0);
3917             $globalASTRef = insertSubTree($globalASTRef,"PK",$PKTreeRef);
3918            
3919             ($PKTreeRef,$state) = modifyTree($DESExpandedTreeRef,\&checkForLHSVariableAbsent,\&deleteIfLHSVariableAbsent,"DADT","",0,100);
3920             $globalASTRef = insertSubTree($globalASTRef,"JUST_DIFFERENTIAL_EQUATIONS",$DESExpandedTreeRef);
3921            
3922             my $numDifferentialEquations = 0;
3923             if ( ref($DESExpandedTreeRef) && $DESExpandedTreeRef =~ /HASH/)
3924             {
3925             my %DESExpandedTree = %$DESExpandedTreeRef;
3926             $numDifferentialEquations = scalar(keys(%DESExpandedTree));
3927             }
3928             elsif ( ref($DESExpandedTreeRef) && $DESExpandedTreeRef =~ /ARRAY/)
3929             {
3930             my @DESEquations = @$DESExpandedTreeRef;
3931             $numDifferentialEquations = scalar(@DESEquations);
3932             }
3933             $globalASTRef = insertSubTree($globalASTRef,"NUM_DIFFERENTIAL_EQUATIONS",\$numDifferentialEquations);
3934            
3935             my $mapleFileName = $TLCOutputFileName;
3936            
3937             $improveThis = 1;
3938             #Not sure when to do this,actually
3939             if ( $improveThis )
3940             {
3941             $globalASTRef = copySubTree($globalASTRef,"PRED","PK");
3942             }
3943            
3944             #%tags = ( label => "PKScaleFactors", startTag => "", separator => ",", endTag => "", routine => \&getDifferentialEquations, processingMethods => \%processingMethodsForStateVariables, getLeftRightOrBothSides => 'Left', subRoutine => "" );
3945             #my ( $pkScaleFactorsRef, $state ) = getInfoFromSubTree($globalASTRef,"PKScaleFactors",\%tags,0);
3946            
3947             my $derivationsRef = getSubTree($globalASTRef,"VECTOR_VARIABLE_DEPENDENCIES");
3948            
3949             my $useThetas = 0;
3950             my $useEtas = 1;
3951             my @PKVariableNames = ();
3952             if ( $useThetas )
3953             {
3954             my $subTreeForThetaRef = getSubTree($derivationsRef,"THETA");
3955             my %subTreeForTheta = %$subTreeForThetaRef;
3956             foreach my $key ( keys(%subTreeForTheta ))
3957             {
3958             my $value = $subTreeForTheta{$key};
3959             push(@PKVariableNames,$value);
3960             }
3961             }
3962            
3963             if ( $useEtas )
3964             {
3965             my $subTreeForEtaRef = getSubTree($derivationsRef,"ETA");
3966             my %subTreeForEta = %$subTreeForEtaRef;
3967             foreach my $key ( keys(%subTreeForEta ))
3968             {
3969             my $value = $subTreeForEta{$key};
3970             push(@PKVariableNames,$value);
3971             }
3972             }
3973            
3974             $globalASTRef = insertSubTree($globalASTRef,"PK_VARIABLE_NAMES_ORIGINAL",\@PKVariableNames);
3975            
3976             @PKVariableNames = PK_sortVariableNames(@PKVariableNames);
3977             $globalASTRef = insertSubTree($globalASTRef,"PK_VARIABLE_NAMES",\@PKVariableNames);
3978            
3979             my $variablesCount = scalar(@PKVariableNames);
3980             my %variablesCountTree = ();
3981             $variablesCountTree{length} = $variablesCount;
3982             $globalASTRef = insertSubTree($globalASTRef,"NB_COUNT",\%variablesCountTree);
3983            
3984             #improve this
3985             my $arrayOfPKNamesRef = getSubTree($globalASTRef,"PK_VARIABLE_NAMES_ORIGINAL");
3986             my $defaultPrefix = 'tv';
3987             my $vectorVariableDependenciesRef = getSubTree($globalASTRef,"VECTOR_VARIABLE_DEPENDENCIES");
3988             my $PKNamesForThetasRef = getPKVariableNamesFromDependencies($vectorVariableDependenciesRef, "THETA", $arrayOfPKNamesRef, $defaultPrefix );
3989             $globalASTRef = insertSubTree($globalASTRef,"PK_VARIABLE_NAMES_FROM_DEPENDENCIES",$PKNamesForThetasRef);
3990            
3991             my $DESFileName = getRegularizedModelName();
3992             $globalASTRef = insertSubTree($globalASTRef,"REGULARIZED_MODEL_NAME",\$DESFileName);
3993             my $routing = $DESFileName;
3994             my $dosing = $DESFileName;
3995             $dosing =~ s/.*\_//g;
3996             $routing =~ s/\_.*//g;
3997             $globalASTRef = insertSubTree($globalASTRef,"ROUTING",\$routing);
3998             $globalASTRef = insertSubTree($globalASTRef,"DOSING",\$dosing);
3999            
4000             $routing =~ s/.*\_//g;
4001             $globalASTRef = insertSubTree($globalASTRef,"ROUTING",\$routing);
4002            
4003             my $fileRoot = "\\oss\\models\\DifferentialEquations\\";
4004             my $DESModelNameFromFileRef = getSubTree($globalASTRef,"MODEL_NAME_FROM_FILE");
4005             my $DESModelNameFromFile = $$DESModelNameFromFileRef;
4006            
4007             my @potentialFileNames = ("$fileRoot$DESFileName.DES","$fileRoot$DESModelNameFromFile.DES");
4008             $globalASTRef = insertFileContentsIntoAbstractSyntaxTree(\@potentialFileNames,$globalASTRef,"DESMASTER","");
4009            
4010             writeMonolixModel($globalASTRef,$TLCOutputFileName,$dataFileName);
4011             writeMonolixDataFile($globalASTRef,$TLCOutputFileName,$dataFileName);
4012            
4013             writeNonmemFile($globalASTRef,$TLCOutputFileName,$dataFileName);
4014            
4015             $improveThis = 1; # should be separate from nonmem file.
4016            
4017             if ( $writeAsAlgebraicTheory )
4018             {
4019             writeAsAlgebraicTheory($globalASTRef,$TLCOutputFileName,$dataFileName);
4020             }
4021             }
4022             if ( $writeMaple )
4023             {
4024            
4025             my @variableNames = ("THETA","ETA","A","ERR","DADT");
4026            
4027             for my $variableName (@variableNames )
4028             {
4029             ($globalASTRef,$state) = modifyTree($globalASTRef,\&checkForUseOfVector,\&replaceUseOfVectorWithScalar,$variableName,"",0,100,0);
4030             }
4031            
4032             $globalASTRef = modifySubTree($globalASTRef,"DES",\&checkForAssignment,\&storeAssignment,"",0,100,0);
4033            
4034             $globalASTRef = modifySubTree($globalASTRef,"DES",\&checkForNames,&replaceNameWithParseTree,$derivationsForVariablesRef,"",0,100,0);
4035            
4036             my $useJetNotation = 0;
4037             for my $variableName (@variableNames )
4038             {
4039             ($globalASTRef,$state) = doReplacementsForMaple($globalASTRef,$variableName,$useJetNotation);
4040             }
4041            
4042             $globalASTRef = modifySubTree($globalASTRef,"DES",\&checkForLHSVariableAbsent,\&deleteIfLHSVariableAbsent,"diff");
4043            
4044             my $mapleFileName = $TLCOutputFileName;
4045            
4046             writeMapleFile($globalASTRef,$TLCOutputFileName,$dataFileName);
4047            
4048             }
4049            
4050             if ( $writeTLC )
4051             {
4052             my $infoString;
4053             my $state;
4054            
4055             ( $infoString, $state ) = getInfoFromTree($globalASTRef,"PROB",0, "PROBLEM", \&reportProblemTLC,"");
4056             ( $infoString, $state ) = getInfoFromTree($globalASTRef,"THETA",0, "THETA", \&reportHashOfArrayOfValuesInParentheses,\&reportThetaBounds,\&dummy);
4057             ( $infoString, $state ) = getInfoFromTree($globalASTRef,"THETA",0, "THETA", \&reportHashOfArrayOfValuesInParentheses,\&reportThetaInitialValues);
4058             ( $infoString, $state ) = getInfoFromTree($globalASTRef,"OMEGA",0, "OMEGA", \&reportHashOfArrayOfValues,\&reportOmegaInitialValues);
4059             ( $infoString, $state ) = getInfoFromTree($globalASTRef,"SIGMA",0, "ERRORS", \&reportHashOfArrayOfValues,\&reportOmegaInitialValues);
4060             my $DESTempRef = getSubTree($globalASTRef,"DES");
4061            
4062             ($DESTempRef,$state) = modifyTree($DESTempRef,\&reportDifferentialEquations,\&indentityTransform,"A","",0,100,0);
4063            
4064             #For outputs...
4065             ( $infoString, $state ) = getInfoFromTree($derivationsForVariablesRef,"THETA",0, "ThetaNames", \&reportHashOfValues, \&dummy);
4066             ( $infoString, $state ) = getInfoFromTree($derivationsForVariablesRef,"ETA", 0, "EtaNames", \&reportHashOfValues, \&dummy);
4067             ( $infoString, $state ) = getInfoFromTree($derivationsForVariablesRef,"ERR", 0, "ErrNames", \&reportHashOfValues, \&dummy);
4068             ( $infoString, $state ) = getInfoFromTree($derivationsForVariablesRef,"ERR", 0, "ErrNames", \&reportHashOfValues, \&dummy);
4069             ( $infoString, $state ) = getInfoFromTree($derivationsForVariablesRef,"THETA",0, "ThetaNames", \&reportHashOfValues, \&dummy);
4070            
4071             }
4072            
4073             }
4074            
4075             sub MAPLE_getInitialConditionsString
4076             {
4077             my ($differentialEquationsRef, $iDosingCompartment, $dosingType, $routingType ) = @_;
4078             my @differentialEquations = @$differentialEquationsRef;
4079            
4080             my $initialConditionsString = "";
4081            
4082             $initialConditionsString .= "ics:=[ ";
4083            
4084             my $iEquation = 1;
4085             for ( my $i = 0; $i < scalar(@differentialEquations); $i++)
4086             {
4087             my $equation = $differentialEquations[$i];
4088             next unless ( $equation =~ /diff/i );
4089            
4090             my $datum = 0;
4091             if ( $iEquation eq $iDosingCompartment && $dosingType ne "MD" && $routingType ne "INFUSION" )
4092             {
4093             $datum = "AMT";
4094             }
4095             if ( $iEquation == 1 )
4096             {
4097             $initialConditionsString .= " A$iEquation(0) = $datum\n";
4098             }
4099             else
4100             {
4101             $initialConditionsString .= " ,A$iEquation(0) = $datum\n";
4102             }
4103             $iEquation++;
4104             }
4105             $initialConditionsString .= "];";
4106            
4107             return $initialConditionsString;
4108            
4109             }
4110            
4111            
4112            
4113             sub modifySubTree
4114             {
4115            
4116             my $treeRef = $_[0];
4117             my $subTreeName = $_[1];
4118             my $filterFunctionRef = $_[2];
4119             my $functionRef = $_[3];
4120             my $char1 = $_[4];
4121             my $char2 = $_[5];
4122             my $iTreeLevel = $_[6];
4123             my $iTotalLevels = $_[7];
4124             my $justModifyRightSide = $_[8];
4125            
4126             my $subTreeRef = getSubTree($treeRef,$subTreeName);
4127             if ( &$filterFunctionRef($subTreeRef,$char1,$char2))
4128             {
4129             ($subTreeRef,$state) = &$functionRef($subTreeRef,$char1,$char2);
4130             }
4131            
4132             ($subTreeRef, $state ) = modifyTree($subTreeRef, $filterFunctionRef, $functionRef,$char1,$char2,$iTreeLevel,$iTotalLevels,$justModifyRightSide);
4133            
4134             unless ( ref($treeRef) )
4135             {
4136             print "Possible error in modifyTree for $treeRef\n";
4137             return;
4138             }
4139             my %tree = %$treeRef;
4140             $improveThis = 1; #allow 2+ levels here USE inSERT INTO TREE INSTEAD.
4141            
4142             if ( $subTreeName =~ /ARRAY/)
4143             {
4144             my @subTreeNames = @$subTreeName;
4145             $subTreeName = $subTreeNames[0];
4146             }
4147             $tree{$subTreeName} = $subTreeRef;
4148            
4149             $treeRef = \%tree;
4150            
4151             return ( $treeRef);
4152             }
4153            
4154            
4155             sub printSubTree
4156             {
4157             my $subTreeRef = $_[0];
4158             my $subTreeName = $_[1];
4159             my $iStartLevel = $_[2];
4160             my $fileHandle = $_[3];
4161             my $title = $_[4];
4162            
4163             $subTreeRef = getSubTree($subTreeRef,$subTreeName);
4164             printTree($subTreeRef,$iStartLevel,$fileHandle,$title,"");
4165             }
4166            
4167            
4168             sub copySubTree
4169             {
4170             my $treeRef = $_[0];
4171             my $subTreeName = $_[1];
4172             my $subTreeCopyName = $_[2];
4173            
4174             unless ( ref($treeRef ) )
4175             {
4176             print "Possible error in copySubtree for $treeRef\n";
4177             return;
4178             }
4179             my %completeParseTree = %$treeRef;
4180             my $DESTreeRef = $completeParseTree{$subTreeName};
4181            
4182             my $treePossiblyExists = ref($completeParseTree{$subTreeCopyName});
4183             if ( $treePossiblyExists )
4184             {
4185             print "Possible error - tree $subTreeCopyName already exists -- not overwriting with $subTreeName\n";
4186             }
4187             else
4188             {
4189             if ( ref($DESTreeRef))
4190             {
4191             if ( $DESTreeRef =~ /HASH/)
4192             {
4193             my %DESTree = %$DESTreeRef;
4194             $completeParseTree{$subTreeCopyName} = \%DESTree;
4195             }
4196             elsif ($DESTreeRef =~ /ARRAY/)
4197             {
4198             my @DESTree = @$DESTreeRef;
4199             $completeParseTree{$subTreeCopyName} = \@DESTree;
4200             }
4201             }
4202             else
4203             {
4204             $completeParseTree{$subTreeCopyName} = $DESTreeRef;
4205             }
4206            
4207             $globalASTRef = \%completeParseTree;
4208             }
4209            
4210             return ( $globalASTRef);
4211             }
4212            
4213            
4214             sub getInfoFromSubTree
4215             {
4216            
4217             my ($localParseTreeRef, $subTreeName, $tagsRef, $iTreeLevel) = @_;
4218            
4219             my %localParseTree = %$localParseTreeRef;
4220             my %tags = %$tagsRef;
4221            
4222             my $DESTreeRef = $localParseTree{$subTreeName};
4223             my $functionRef = $tags{"routine"};
4224             if ( $functionRef eq "" )
4225             {
4226             print "Error in tags -- no function given for $subTreeName call\n";
4227             exit;
4228             }
4229            
4230             if ( ! ref ( $DESTreeRef ) )
4231             {
4232             print "Note -- use of default in getSubTree for $subTreeName\n";
4233             my $startTag = $tags{"startTag"};
4234             my $endTag = $tags{"endTag"};
4235             my $stringIsHere = $startTag . $DESTreeRef . $endTag;
4236             return ( $stringIsHere );
4237             }
4238            
4239             my $valuesString = "";
4240             if ( $subTreeName eq $tags{"label"} )
4241             {
4242             my ($valuesStringTemp,$state) = &$functionRef($DESTreeRef,\%tags,$iTreeLevel+1);
4243             if ( ref($valuesStringTemp) && $valuesStringTemp =~ /HASH/)
4244             {
4245             $valuesString = $valuesStringTemp;
4246             }
4247             else
4248             {
4249             $valuesString = $valuesStringTemp;
4250             }
4251             }
4252            
4253             $improveThis = 1; #hack noted since hash values or strings could be involved, or multiple hash trees.
4254             my($valuesStringTemp, $state ) = getInfoFromTree($DESTreeRef, $tagsRef, $iTreeLevel);
4255            
4256             if (defined($valuesStringTemp))
4257             {
4258             if ( ref($valuesStringTemp) && $valuesStringTemp =~ /HASH/)
4259             {
4260             $valuesString = $valuesStringTemp;
4261             }
4262             else
4263             {
4264             $valuesString .= $valuesStringTemp;
4265             }
4266             }
4267             return ( $valuesString );
4268             }
4269            
4270            
4271             sub fillInArrayOfInfoFromSubTree
4272             {
4273            
4274             my($ParseTreeRef, $subTreeName, $tagsRef, $arrayOfInfoRef,$iTreeLevel) = @_;
4275            
4276             if ( ref($ParseTreeRef) && $ParseTreeRef =~ /HASH/)
4277             {
4278             my %ParseTree = %$ParseTreeRef;
4279             my %tags = %$tagsRef;
4280            
4281             my $DESTreeRef = $ParseTree{$subTreeName};
4282             my $functionRef = $tags{"routine"};
4283             if ( $functionRef eq "" )
4284             {
4285             print "Error in tags -- no function given for $subTreeName call\n";
4286             exit;
4287             }
4288            
4289             if ( ! ref ( $DESTreeRef ) )
4290             {
4291             print "Note -- use of default in getSubTree for $subTreeName\n";
4292             return ( $tags{"startTag"} . $DESTreeRef . $tags{"endTag"});
4293             }
4294            
4295             my $valuesString = "";
4296             if ( $subTreeName eq $tags{"label"} )
4297             {
4298             ($arrayOfInfoRef,$state) = &$functionRef($DESTreeRef,\%tags,$arrayOfInfoRef,$iTreeLevel+1);
4299             }
4300            
4301             $improveThis = 1; #hack noted since hash values or strings could be involved, or multiple hash trees.
4302             ($arrayOfInfoRef, $state ) = fillInArrayOfInfoFromTree($DESTreeRef, $tagsRef, $arrayOfInfoRef,$iTreeLevel);
4303             }
4304            
4305             return ( $arrayOfInfoRef, "OK" );
4306             }
4307            
4308             sub getArrayOfInfoFromSubTree
4309             {
4310            
4311             my ($subTreeRef, $subTreeName, $tagsRef, $iTreeLevel) = @_;
4312             my %subTree = %$subTreeRef;
4313             my %tags = %$tagsRef;
4314            
4315             $subTreeRef = getSubTree($subTreeRef,$subTreeName);
4316            
4317             my $functionRef = $tags{"routine"};
4318            
4319             my ($arrayRef,$state) = &$functionRef($subTreeRef,\%tags,$iTreeLevel+1);
4320             my $arrayTempRef;
4321             ($arrayTempRef, $state ) = getArrayOfInfoFromTree($subTreeRef, $tagsRef, $iTreeLevel);
4322            
4323             my @array = ();
4324             if ( ref($arrayRef) )
4325             {
4326             if ( $arrayRef =~ /ARRAY/)
4327             {
4328             @array = @$arrayRef;
4329             }
4330             else
4331             {
4332             $array[0] = $arrayRef;
4333             }
4334             }
4335             elsif ( $arrayRef ne "" )
4336             {
4337             $array[0] = $arrayRef;
4338             }
4339            
4340             my @arrayTemp = @$arrayTempRef;
4341             push(@array,@arrayTemp);
4342            
4343             return (\@array);
4344             }
4345            
4346             sub getHashOfInfoFromSubTree
4347             {
4348             my ($subTreeRef, $subTreeName, $tagsRef, $iTreeLevel,$hashRef) = @_;
4349             my %tags = %$tagsRef;
4350            
4351             $subTreeRef = getSubTree($subTreeRef,$subTreeName);
4352            
4353             my $functionRef = $tags{"routine"};
4354            
4355             my $state = "";
4356            
4357             ($hashRef,$state) = &$functionRef($subTreeRef,\%tags,$iTreeLevel+1,$hashRef);
4358             $improveThis = 0;
4359             if ( $improveThis )
4360             {
4361             ($hashRef, $state ) = getHashOfInfoFromTree($subTreeRef, $tagsRef, $iTreeLevel,$hashRef);
4362             }
4363             return ($hashRef);
4364             }
4365            
4366             sub indentityTransform
4367             {
4368             return ($_[0],"OK");
4369             }
4370            
4371             sub doesSubTreeExist
4372             {
4373             my ( $subTreeRef,$subTreeName) = @_;
4374            
4375             my $iFound = 0;
4376            
4377             my @arrayOfNames = ();
4378             unless ( $subTreeName =~ /ARRAY/)
4379             {
4380             $arrayOfNames[0] = $subTreeName;
4381             }
4382             else
4383             {
4384             @arrayOfNames = @$subTreeName;
4385             }
4386            
4387             for ( my $iName =0; $iName <= $#arrayOfNames; $iName++ )
4388             {
4389            
4390             my %subTree;
4391            
4392             my $subTreeName = $arrayOfNames [$iName];
4393             if ( ref($subTreeRef))
4394             {
4395             if ( $subTreeRef =~ /ARRAY/ && $subTreeName =~ /^\d+$/)
4396             {
4397             my @subTrees = @$subTreeRef;
4398             $subTreeRef = $subTrees[$subTreeName];
4399             }
4400             elsif ( $subTreeRef =~ /HASH/)
4401             {
4402             %subTree = %$subTreeRef;
4403             $subTreeRef = $subTree{$subTreeName};
4404             }
4405             }
4406            
4407             if ( ref($subTreeRef))
4408             {
4409             $iFound = 1;
4410             }
4411             }
4412             return ( $iFound);
4413             }
4414            
4415             sub getSubTree
4416             {
4417             my ( $subTreeRef,$subTreeNameRef) = @_;
4418            
4419             my @arrayOfNames = ();
4420             unless ( $subTreeNameRef =~ /ARRAY/)
4421             {
4422             $arrayOfNames[0] = $subTreeNameRef;
4423             }
4424             else
4425             {
4426             @arrayOfNames = @$subTreeNameRef;
4427             }
4428            
4429            
4430             for ( my $iName =0; $iName <= $#arrayOfNames; $iName++ )
4431             {
4432            
4433             my %subTree;
4434            
4435             my $subTreeName = $arrayOfNames [$iName];
4436             if ( ref($subTreeRef))
4437             {
4438             if ( $subTreeRef =~ /ARRAY/ && $subTreeName =~ /^\d+$/)
4439             {
4440             my @subTrees = @$subTreeRef;
4441             $subTreeRef = $subTrees[$subTreeName];
4442             }
4443             elsif ( $subTreeRef =~ /HASH/)
4444             {
4445             %subTree = %$subTreeRef;
4446             $subTreeRef = $subTree{$subTreeName};
4447             }
4448             }
4449            
4450             if ( ref($subTreeRef) && $subTreeRef =~ /HASH/ )
4451             {
4452             %subTree = %$subTreeRef;
4453             }
4454             elsif ( $iName < $#arrayOfNames )
4455             {
4456             my @myKeys = keys(%subTree);
4457             print "\n-----------------------------------------------\n";
4458             print "Error in getSubTree\n";
4459             print "available keys are:", join(",", @myKeys), "\n";
4460             print "\nYou asked for ", join(",",@arrayOfNames), " and currently ", $subTreeName, "for: ", $subTreeRef, "\n";
4461             print "\n-----------------------------------------------\n";
4462             }
4463             }
4464             return ( $subTreeRef);
4465             }
4466            
4467             sub insertSubTree
4468             {
4469             my ( $treeRef,$subTreeName,$newTreeRef) = @_;
4470            
4471             if ( ! ref($treeRef) or ! ($treeRef =~ /HASH/) )
4472             {
4473             print "Error in insertSubTree\n";
4474             exit;
4475             }
4476             my @arrayOfNames = ();
4477             unless ( $subTreeName =~ /ARRAY/)
4478             {
4479             push(@arrayOfNames, $subTreeName);
4480             }
4481             else
4482             {
4483             @arrayOfNames = @$subTreeName;
4484             }
4485            
4486             my %subTree = %$treeRef;
4487            
4488             for ( my $iName =0; $iName < $#arrayOfNames; $iName++ )
4489             {
4490             my $subTreeName = $arrayOfNames [$iName];
4491             my $subTreeRef = $subTree{$subTreeName};
4492             if ( ref($subTreeRef) && $subTreeRef =~ /HASH/ )
4493             {
4494             %subTree = %$subTreeRef;
4495             }
4496             else
4497             {
4498             my @myKeys = keys(%subTree);
4499             print "\n-----------------------------------------------\n";
4500             print "Error in insertSubTree\n";
4501             print "available keys are:", join(",", @myKeys), "\n";
4502             print "\nYou asked for ", join(",",@arrayOfNames), " and currently ", $subTreeName, "for: ", $subTreeRef, "\n";
4503             print "\n-----------------------------------------------\n";
4504             }
4505             }
4506             my %tree = %$treeRef;
4507             $tree{$arrayOfNames[0]} = $newTreeRef;
4508            
4509             return ( \%tree);
4510             }
4511            
4512            
4513            
4514             sub getDifferentialEquations
4515             {
4516             my $arrayRef = $_[0];
4517             my %tags = %{$_[1]};
4518            
4519             my $routine = $tags{"routine"};
4520             my $expression = "";
4521             my $startTag = $tags{"startTag"};
4522             my $processingMethodsRef = $tags{"processingMethods"};
4523             my %processingMethods = ();
4524             if ( $processingMethodsRef )
4525             {
4526             %processingMethods = %$processingMethodsRef;
4527             }
4528            
4529             my $getLeftRightOrBothSides = $tags{"getLeftRightOrBothSides"};
4530            
4531             my @array;
4532             if ( ref($arrayRef))
4533             {
4534             if ($arrayRef =~ /ARRAY/)
4535             {
4536             @array = @$arrayRef;
4537             }
4538             else
4539             {
4540             $array[0] = $arrayRef;
4541             }
4542             }
4543             my $string = "";
4544            
4545             my $first = 1;
4546            
4547             for my $hashTreeRef ( @array )
4548             {
4549            
4550             # if ( ! ref ( $hashTreeRef ) || ! $hashTreeRef =~ /HASH/)
4551             # {
4552             # $expression .= $hashTreeRef;
4553             # }
4554            
4555             my %hashTree = %$hashTreeRef;
4556            
4557             if ( $hashTree{"oper"} =~ /$assignmentOperator/ )
4558             {
4559             if ( $first )
4560             {
4561             $expression = $startTag;
4562             }
4563             unless ( $first )
4564             {
4565             $expression .= $tags{"separator"};
4566             }
4567             $first = 0;
4568            
4569             my $iLevel = 2;
4570            
4571             my $expressionLeft = "";
4572             my $expressionRight = "";
4573            
4574             unless ( defined($getLeftRightOrBothSides) && ( $getLeftRightOrBothSides eq "Right"))
4575             {
4576             $expressionLeft = getExpression($hashTree{"left"},$processingMethodsRef);
4577             my $modifyDifferentialExpressionRef = $processingMethods{"modifyDifferentialExpression"};
4578             if ( $modifyDifferentialExpressionRef )
4579             {
4580             $expressionLeft = &$modifyDifferentialExpressionRef($expressionLeft);
4581             }
4582             }
4583            
4584             unless ( defined($getLeftRightOrBothSides) && ( $getLeftRightOrBothSides eq "Right" or $getLeftRightOrBothSides eq "Left"))
4585             {
4586             my $oper = $hashTree{"oper"};
4587             if ( $oper =~ /$assignmentOperator/)
4588             {
4589             $oper = $tags{"assignmentOperator"};
4590             }
4591             $improveThis = 1;
4592             if ( $improveThis )
4593             {
4594             if ( ( ! defined($oper) ) or ( $oper eq "" ) )
4595             {
4596             $oper = " = ";
4597             }
4598             }
4599            
4600             $expressionLeft .= $oper;
4601             }
4602            
4603             unless ( defined($getLeftRightOrBothSides) && ($getLeftRightOrBothSides eq "Left"))
4604             {
4605             $expressionRight = getExpression($hashTree{"right"},$processingMethodsRef,$expressionLeft);
4606             my $modifyDifferentialExpressionRef = $processingMethods{"modifyDifferentialExpression"};
4607             if ( $modifyDifferentialExpressionRef )
4608             {
4609             $expressionRight = &$modifyDifferentialExpressionRef($expressionRight);
4610             }
4611             }
4612             my @names = ("right","fname");
4613             my $forLoopOrIfThen = getSubTree($hashTreeRef,\@names);
4614             if ( ( defined($forLoopOrIfThen) ) && ( $forLoopOrIfThen eq "FORLOOP" or $forLoopOrIfThen eq "IF" ))
4615             {
4616             $expression .= $expressionRight;
4617             }
4618             else
4619             {
4620             $expression .= $expressionLeft . $expressionRight;
4621             }
4622             }
4623             }
4624            
4625             $expression .= $tags{"endTag"};
4626            
4627             return ( $expression );
4628            
4629             }
4630            
4631            
4632             sub getLHSDependencies
4633             {
4634             my $arrayRef = $_[0];
4635             my %tags = %{$_[1]};
4636             my $iLevel = $_[2];
4637             my $allVariablesRef = $_[3];
4638            
4639             my %allVariables = %$allVariablesRef;
4640            
4641             my $routine = $tags{"routine"};
4642             my $expression = "";
4643             my $startTag = $tags{"startTag"};
4644             my $processingMethodsRef = $tags{"processingMethods"};
4645             my %processingMethods = ();
4646             if ( $processingMethodsRef )
4647             {
4648             %processingMethods = %$processingMethodsRef;
4649             }
4650            
4651             my $getLeftRightOrBothSides = $tags{"getLeftRightOrBothSides"};
4652            
4653             my @array;
4654             if ( ref($arrayRef))
4655             {
4656             if ($arrayRef =~ /ARRAY/)
4657             {
4658             @array = @$arrayRef;
4659             }
4660             else
4661             {
4662             $array[0] = $arrayRef;
4663             }
4664             }
4665             my $string = "";
4666            
4667             my $first = 1;
4668             for my $hashTreeRef ( @array )
4669             {
4670            
4671             my %hashTree = %$hashTreeRef;
4672            
4673             if ( $hashTree{"oper"} =~ /$assignmentOperator/ )
4674             {
4675             my $expressionLeft = "";
4676             my $expressionRight = "";
4677            
4678             $expressionLeft = getExpression($hashTree{"left"}, $processingMethodsRef);
4679             $expressionRight = getExpression($hashTree{"right"},$processingMethodsRef,$expressionLeft);
4680             my @variables = split(/\[|\+|\-|\/|\*|\(|\)|\[|\]|\+|exp|EXP/,$expressionRight);
4681             my $allVariablesString = join(",", @variables);
4682             #hack on next line -- this should not be necessary.
4683             $allVariablesString =~ s/[\,]+/\,/g;
4684            
4685             my @operators = ();
4686             if ( $expressionRight =~ /\Wexp\W/i)
4687             {
4688             push(@operators,"^");
4689             }
4690             if ( $expressionRight =~ /\*/)
4691             {
4692             push(@operators,"\*");
4693             }
4694             if ( $expressionRight =~ /\+/)
4695             {
4696             push(@operators,"\+");
4697             }
4698            
4699             my $allOperators = join(",", @operators);
4700            
4701             my %allForThisLHS = ();
4702             $allForThisLHS{"operators"} = $allOperators;
4703             $allForThisLHS{"variables"} = $allVariablesString;
4704            
4705             $allVariables{$expressionLeft} = \%allForThisLHS;
4706            
4707             }
4708             }
4709            
4710             return ( \%allVariables,"OK");
4711            
4712             }
4713            
4714            
4715             sub getFullRHSForVariable
4716             {
4717             my $arrayRef = $_[0];
4718             my %tags = %{$_[1]};
4719             my $iLevel = $_[2];
4720             my $fullDependenciesRef = $_[3];
4721            
4722             my %fullDependencies = %$fullDependenciesRef;
4723            
4724             my $routine = $tags{"routine"};
4725             my $expression = "";
4726             my $startTag = $tags{"startTag"};
4727             my $processingMethodsRef = $tags{"processingMethods"};
4728             my %processingMethods = ();
4729             if ( $processingMethodsRef )
4730             {
4731             %processingMethods = %$processingMethodsRef;
4732             }
4733            
4734             my $getLeftRightOrBothSides = $tags{"getLeftRightOrBothSides"};
4735            
4736             my @array;
4737             if ( ref($arrayRef))
4738             {
4739             if ($arrayRef =~ /ARRAY/)
4740             {
4741             @array = @$arrayRef;
4742             }
4743             else
4744             {
4745             $array[0] = $arrayRef;
4746             }
4747             }
4748            
4749             my $string = "";
4750             my $first = 1;
4751            
4752             for my $hashTreeRef ( @array )
4753             {
4754            
4755             my %hashTree = %$hashTreeRef;
4756             if ( $hashTree{"oper"} =~ /$assignmentOperator/ )
4757             {
4758             my $expressionLeft = "";
4759             my $expressionRight = "";
4760            
4761             $expressionLeft = getExpression($hashTree{"left"}, $processingMethodsRef);
4762             $expressionRight = getExpression($hashTree{"right"},$processingMethodsRef,$expressionLeft);
4763            
4764             $fullDependencies{$expressionLeft} = $expressionRight;
4765            
4766             }
4767             }
4768            
4769             return ( \%fullDependencies,"OK");
4770            
4771             }
4772            
4773            
4774            
4775            
4776             sub getDifferentialEquation
4777             {
4778             my $hashTreeRef = $_[0];
4779             my %tags = %{$_[1]};
4780            
4781             my $routine = $tags{"routine"};
4782             my $expression = $tags{"startTag"};
4783             my $processingMethodsRef = $tags{"processingMethods"};
4784             my %processingMethods = ();
4785            
4786             if ( $processingMethodsRef )
4787             {
4788             %processingMethods = %$processingMethodsRef;
4789             }
4790            
4791             my $getLeftRightOrBothSides = $tags{"getLeftRightOrBothSides"};
4792            
4793             if ( ref ( $hashTreeRef ) && $hashTreeRef =~ /HASH/)
4794             {
4795             my %hashTree = %$hashTreeRef;
4796            
4797             if ( $hashTree{"oper"} =~ /$assignmentOperator/)
4798             {
4799             $expression = $tags{"startTag"};
4800            
4801             my $iLevel = 2;
4802            
4803             unless ( $getLeftRightOrBothSides eq "Right")
4804             {
4805             my $expressionTemp .= getExpression($hashTree{"left"},$processingMethodsRef);
4806             my $modifyDifferentialExpressionRef = $processingMethods{"modifyDifferentialExpression"};
4807             if ( $modifyDifferentialExpressionRef )
4808             {
4809             $expressionTemp = &$modifyDifferentialExpressionRef($expressionTemp);
4810             }
4811             $expression .= $expressionTemp;
4812            
4813             }
4814            
4815             unless ( $getLeftRightOrBothSides eq "Right" or $getLeftRightOrBothSides eq "Left")
4816             {
4817             my $oper = $hashTree{"oper"};
4818             if ( $oper =~ /$assignmentOperator/)
4819             {
4820             $oper = $tags{"assignmentOperator"};
4821             $improveThis = 1;
4822             if ( $improveThis )
4823             {
4824             if ( $oper eq "" )
4825             {
4826             $oper = " = ";
4827             }
4828             }
4829             }
4830             $expression .= $oper;
4831             }
4832            
4833             unless ( $getLeftRightOrBothSides eq "Left")
4834             {
4835             my $expressionTemp .= getExpression($hashTree{"right"},$processingMethodsRef);
4836             my $modifyDifferentialExpressionRef = $processingMethods{"modifyDifferentialExpression"};
4837             if ( $modifyDifferentialExpressionRef )
4838             {
4839             $expressionTemp = &$modifyDifferentialExpressionRef($expressionTemp);
4840             }
4841            
4842             $improveThis = 0;
4843             #Ignores the possible use of non-nested parentheses.
4844             if ( $improveThis )
4845             {
4846             if ( substr($expressionTemp,0,1) eq "\(" && substr($expressionTemp,-1) eq "\)" )
4847             {
4848             $expressionTemp = substr($expressionTemp,1,length($expressionTemp)-2);
4849             }
4850             }
4851             $expression .= $expressionTemp;
4852             }
4853            
4854             $expression .= $tags{"endTag"};
4855             }
4856             }
4857             return ( $expression );
4858            
4859             }
4860             sub getHashTreeOfDifferentialEquation
4861             {
4862             my $hashTreeRef = $_[0];
4863             my %tags = %{$_[1]};
4864            
4865             my $routine = $tags{"routine"};
4866             my $expression = $tags{"startTag"};
4867             my $processingMethodsRef = $tags{"processingMethods"};
4868             my %processingMethods = ();
4869            
4870             if ( $processingMethodsRef )
4871             {
4872             %processingMethods = %$processingMethodsRef;
4873             }
4874            
4875             my $getLeftRightOrBothSides = $tags{"getLeftRightOrBothSides"};
4876             my $ignoreDifferentialEquations = $tags{"ignoreDifferentialEquations"};
4877            
4878             $expression = "";
4879            
4880             my $hashTreeToReturn = "";
4881             if ( ref ( $hashTreeRef ) && $hashTreeRef =~ /HASH/)
4882             {
4883             my %hashTree = %$hashTreeRef;
4884            
4885             my $hashTreeLeftRef = $hashTree{"left"};
4886             if ( ref ( $hashTreeLeftRef ) && $hashTreeLeftRef =~ /HASH/)
4887             {
4888            
4889             my %hashTreeLeft = %$hashTreeLeftRef;
4890            
4891             if ( ( $hashTreeLeft{"oper"} eq "func" && $hashTreeLeft{"fname"} eq "D" ) xor $ignoreDifferentialEquations )
4892             {
4893             $hashTreeToReturn = $hashTreeRef;
4894             }
4895             }
4896             }
4897             return ( $hashTreeToReturn );
4898            
4899             }
4900            
4901            
4902             sub checkForAssignment
4903             {
4904             my $hashTreeRef = $_[0];
4905             my $tag = $_[1];
4906             my $routine = $_[2];
4907            
4908             my $iFound = 0;
4909            
4910             if ( ref($hashTreeRef ) && $hashTreeRef =~ /HASH/ )
4911             {
4912             my %hashTree = %$hashTreeRef;
4913             if ( $hashTree{"oper"} eq "=" )
4914             {
4915             $iFound = 1;
4916             }
4917             }
4918             return($iFound);
4919             }
4920            
4921             sub storeAssignment
4922             {
4923             my $hashTreeRef = $_[0];
4924             my $tag = $_[1];
4925             my $routine = $_[2];
4926            
4927             my $iFound = 0;
4928            
4929             my %hashTree = %$hashTreeRef;
4930            
4931             if ( $hashTree{"oper"} eq "=" )
4932             {
4933             my $hashTreeLeftRef = $hashTree{"left"};
4934             my %hashTreeLeft = %$hashTreeLeftRef;
4935             my $oper = $hashTreeLeft{"oper"};
4936             my $name = $hashTreeLeft{"name"};
4937            
4938             if ( $oper eq "var")
4939             {
4940             $derivationsForVariables{$name} = $hashTree{"right"};
4941             }
4942             }
4943            
4944             return($hashTreeRef);
4945            
4946             }
4947            
4948             sub printExpression
4949             {
4950             my $hashTreeRef = $_[0];
4951             my $iLevel = $_[1];
4952            
4953             my $stringRef = "";
4954            
4955             if ( !ref($hashTreeRef ) )
4956             {
4957             print $printHandle $hashTreeRef;
4958             }
4959             elsif ($hashTreeRef =~ /SCALAR/)
4960             {
4961             print $printHandle $$hashTreeRef;
4962             }
4963             elsif ( $hashTreeRef =~ /HASH/)
4964             {
4965             my %hashTree = %$hashTreeRef;
4966            
4967             my $infixOperator = $hashTree{"oper"};
4968             my $unaryOperator = $hashTree{"monop"};
4969             my $prefixOperator = $hashTree{"fname"};
4970            
4971             my $leftRef = $hashTree{"left"};
4972             my $rightRef = $hashTree{"right"};
4973            
4974             if ( $infixOperator eq "," or $infixOperator eq "." )
4975             {
4976             printExpression($leftRef,0);
4977             print $printHandle $infixOperator;
4978             printExpression($rightRef,0);
4979             }
4980             elsif ($leftRef ne "" && $rightRef ne "" )
4981             {
4982             if ( ref($leftRef ) && $leftRef =~ /HASH/ &&
4983             ref($rightRef ) && $rightRef =~ /HASH/ )
4984             {
4985             my %leftTree = %$leftRef;
4986             my %rightTree = %$rightRef;
4987            
4988             if ($leftTree{"left"} ne "") { print $printHandle "(" };
4989             printExpression($leftRef,0);
4990             if ($leftTree{"left"} ne "") { print $printHandle ")" };
4991             print $printHandle $infixOperator;
4992             if ($rightTree{"right"} ne ""){ print $printHandle "(" };
4993             printExpression($rightRef,0);
4994             if ($rightTree{"right"} ne "") { print $printHandle ")" };
4995             }
4996             else
4997             {
4998             print "Error in printExpression routine\n";
4999             printTree($hashTreeRef,0,*STDOUT,"");
5000             print "End of error in printExpression routine\n";
5001             }
5002             }
5003            
5004             elsif ( $prefixOperator ne "" && $prefixOperator ne "const" && $prefixOperator ne "var" )
5005             {
5006             print $printHandle $prefixOperator;
5007             print $printHandle "(";
5008             printExpression($rightRef);
5009             print $printHandle ")";
5010             }
5011             elsif ( $unaryOperator ne "" )
5012             {
5013             print $printHandle $hashTree{"monop"};
5014             printExpression( $rightRef,$iLevel+1);
5015             }
5016             else
5017             {
5018             print $printHandle $hashTree{"name"};
5019             print $printHandle $hashTree{"val"};
5020             }
5021            
5022             if ( 0 )
5023             {
5024             foreach my $key ( keys(%hashTree))
5025             {
5026             print $printHandle "\nKey: ", $key, " ";
5027             printExpression($hashTree{$key},$iLevel+1);
5028             }
5029             print $printHandle "(";
5030             my $hashTreeRightRef = $hashTree{"right"};
5031             printExpression($hashTreeRightRef,$iLevel+1);
5032             print $printHandle ")";
5033             }
5034             }
5035            
5036             return $stringRef;
5037            
5038             }
5039            
5040             sub dummy
5041             {
5042             }
5043            
5044             sub getSingleString
5045             {
5046             my $value = $_[0];
5047             my %tags = %{$_[1]};
5048             my $indentLevel = $_[2];
5049             my $routineRef = $tags{"subRoutine"};
5050             my $expressionRef = &$routineRef($value,\%tags);
5051            
5052             my $expression = "";
5053             if ( ref($expressionRef) && $expressionRef =~ /SCALAR/)
5054             {
5055             $expression = $$expressionRef;
5056             }
5057             else
5058             {
5059             $expression = $expressionRef;
5060             }
5061             return ( $expression, "OK" );
5062            
5063             }
5064            
5065             sub getDefaultIfThenExpression
5066             {
5067             my $rightRef = $_[0];
5068             my $processingMethodsRef = $_[1];
5069             my $expressionSoFar = $_[2];
5070             my $string = "";
5071            
5072             printTree($rightRef,0,*STDOUT,"If then expression");
5073            
5074             my @nameAddresses = ("left","left","name");
5075             my @valAddresses = ("left","right","val");
5076             my @secondResultAddresses = ("right","left");
5077             my @firstResultAddresses = ("right","right");
5078             my @testExpressionAddresses = ("left");
5079            
5080             my $name = getSubTree($rightRef, \@nameAddresses);
5081             my $testExpression = getExpression(getSubTree($rightRef, \@testExpressionAddresses));
5082            
5083             my $testVal = getExpression(getSubTree($rightRef, \@valAddresses));
5084             my $firstResult = getExpression(getSubTree($rightRef, \@firstResultAddresses));
5085             my $secondResult= getExpression(getSubTree($rightRef, \@secondResultAddresses));
5086            
5087             $string .= "\n\tIF ($testExpression) \n THEN $firstResult ELSE $secondResult\n END IF\n";
5088             return $string;
5089             }
5090            
5091             sub getMapleIfThenExpression
5092             {
5093             my $rightRef = $_[0];
5094             my $processingMethodsRef = $_[1];
5095             my $expressionSoFar = $_[2];
5096             my $string = "";
5097            
5098            
5099             my @nameAddresses = ("left","left","name");
5100             my @valAddresses = ("left","right","val");
5101             my @secondResultAddresses = ("right","left");
5102             my @firstResultAddresses = ("right","right");
5103             my @testExpressionAddresses = ("left");
5104            
5105             my $name = getSubTree($rightRef, \@nameAddresses);
5106             my $testExpression = getExpression(getSubTree($rightRef, \@testExpressionAddresses));
5107            
5108             my $testVal = getExpression(getSubTree($rightRef, \@valAddresses));
5109             my $firstResult = getExpression(getSubTree($rightRef, \@firstResultAddresses));
5110             my $secondResult= getExpression(getSubTree($rightRef, \@secondResultAddresses));
5111            
5112             $string .= "\n\t$expressionSoFar (1-Heaviside($name-10e-6))*$secondResult + Heaviside($name-10e-6)($firstResult)";
5113            
5114             return $string;
5115             }
5116            
5117            
5118             sub getNonmemIfThenExpression
5119             {
5120             my $rightRef = $_[0];
5121             my $processingMethodsRef = $_[1];
5122             my $expressionSoFar = $_[2];
5123             my $string = "";
5124            
5125             my @nameAddresses = ("left","left","name");
5126             my @valAddresses = ("left","right","val");
5127             my @secondResultAddresses = ("right","left");
5128             my @firstResultAddresses = ("right","right");
5129             my @testExpressionAddresses = ("left");
5130            
5131             my $name = getSubTree($rightRef, \@nameAddresses);
5132             my $testExpression = getExpression(getSubTree($rightRef, \@testExpressionAddresses));
5133             #Improve this-- handle other operators.
5134             $testExpression =~ s/\>/\.GT\./g;
5135            
5136             my $testVal = getExpression(getSubTree($rightRef, \@valAddresses));
5137             my $firstResult = getExpression(getSubTree($rightRef, \@firstResultAddresses));
5138             my $secondResult= getExpression(getSubTree($rightRef, \@secondResultAddresses));
5139            
5140             $string .= "$expressionSoFar $firstResult";
5141             $string .= "\n IF ($testExpression) $expressionSoFar $secondResult\n";
5142             return $string;
5143             }
5144            
5145             sub getExpression
5146             {
5147             my $hashTreeRef = $_[0];
5148             my $processingMethodsRef = $_[1];
5149             my $expressionSoFar = $_[2];
5150            
5151             my %processingMethods = ();
5152             my $getLanguageSpecificVersionOfVariableRef = "";
5153             if ( $processingMethodsRef )
5154             {
5155             %processingMethods = %$processingMethodsRef;
5156             $getLanguageSpecificVersionOfVariableRef = $processingMethods{"getLanguageSpecificVersionOfVariable"};
5157             }
5158            
5159             my $string = "";
5160            
5161             if ( !ref($hashTreeRef ) )
5162             {
5163             $string = $hashTreeRef;
5164             }
5165             elsif ($hashTreeRef =~ /SCALAR/)
5166             {
5167             $string = $$hashTreeRef;
5168             }
5169             elsif ( $hashTreeRef =~ /HASH/)
5170             {
5171             my %hashTree = %$hashTreeRef;
5172            
5173             my $infixOperator = $hashTree{"oper"};
5174             my $unaryOperator = $hashTree{"monop"};
5175             my $prefixOperator = $hashTree{"fname"};
5176            
5177             my $leftRef = $hashTree{"left"};
5178             my $rightRef = $hashTree{"right"};
5179            
5180             if ( defined($infixOperator) && length($infixOperator) > 0 && ( $infixOperator eq "," or $infixOperator eq "." ))
5181             {
5182             $string .= getExpression($leftRef,$processingMethodsRef,$string);
5183             $string .= $infixOperator;
5184             $string .= getExpression($rightRef,$processingMethodsRef,$string);
5185             }
5186             elsif ( defined($leftRef ) && $leftRef ne "" && defined($rightRef) && $rightRef ne "" )
5187             {
5188             my %leftTree = %$leftRef;
5189             my %rightTree = %$rightRef;
5190            
5191             if (defined($leftTree{"left"}) && $leftTree{"left"} ne "") { $string .= "(" };
5192             $string .= getExpression($leftRef,$processingMethodsRef,$string);
5193             if (defined($leftTree{"left"}) && $leftTree{"left"} ne "") { $string .= ")" };
5194             $string .= $infixOperator;
5195             if (defined($rightTree{"right"}) && $rightTree{"right"} ne ""){ $string .= "(" };
5196             $string .= getExpression($rightRef,$processingMethodsRef,$string);
5197             if (defined($rightTree{"right"}) && $rightTree{"right"} ne "") { $string .= ")" };
5198             }
5199             elsif ( defined($prefixOperator) && ( $prefixOperator ne "" ) && $prefixOperator ne "const" && $prefixOperator ne "var" )
5200             {
5201            
5202             my $ifThenElseExpression;
5203            
5204             if ( $prefixOperator eq "IF")
5205             {
5206            
5207             my %right = %$rightRef;
5208             my $rightLeftRef = $right{"left"};
5209             my $rightLeftExpression = getExpression($rightLeftRef,$processingMethodsRef,$string);
5210             if ( !defined( $rightLeftExpression) )
5211             {
5212             $rightLeftExpression = "";
5213             }
5214             my $stepMethodRef = $processingMethods{"getStepExpression"};
5215             if ( $stepMethodRef ne "" && $rightLeftExpression =~ /(.*)\.GT\.0(.*)/)
5216             {
5217            
5218             my $variable = $1;
5219             my $result = $2;
5220             my $expression = &$stepMethodRef($variable,"GT", 0, $result, $expressionSoFar);
5221             $string .= $expressionSoFar . $expression;
5222             }
5223             else
5224             {
5225             my $getIfThenExpressionRef = $processingMethods{"getIfThenExpression"};
5226             if ( ! defined ( $getIfThenExpressionRef ) )
5227             {
5228             print "ERROR: No method for handling if-then expressions\n";
5229             exit;
5230             }
5231             if ( $getIfThenExpressionRef eq "" )
5232             {
5233             $getIfThenExpressionRef = \&getDefaultIfThenExpression;
5234             }
5235             $string = &$getIfThenExpressionRef($rightRef,$processingMethodsRef,$expressionSoFar);
5236             }
5237             }
5238             elsif ( defined($prefixOperator ) && ( $prefixOperator eq "FORLOOP") )
5239             {
5240             my @subNames = ("right","left","left","name");
5241             my $varName = getSubTree($hashTreeRef,\@subNames);
5242            
5243             @subNames = ("right","left","right","left","name");
5244             my $iStartNumber = getSubTree($hashTreeRef,\@subNames);
5245             @subNames = ("right","left","right","right","name");
5246             my $iEndNumber = getSubTree($hashTreeRef,\@subNames);
5247            
5248             @subNames = ("right","right");
5249             my $leftVarRef = getSubTree($hashTreeRef,\@subNames);
5250             my $expression = getExpression($leftVarRef,\%processingMethods,$string);
5251            
5252             my @arrayOfExpressionsSoFar = split(/\n/,$expressionSoFar);
5253             my $lastExpression = $arrayOfExpressionsSoFar[$#arrayOfExpressionsSoFar];
5254             $lastExpression = $expressionSoFar;
5255             #$lastExpression =~ s/=//g;
5256             for ( my $iNumber = $iStartNumber; $iNumber <= $iEndNumber; $iNumber++)
5257             {
5258             my $newExpressionSoFar = $lastExpression;
5259             $newExpressionSoFar =~ s/\($varName\)/$iNumber/ig;
5260             $newExpressionSoFar =~ s/$varName/$iNumber/ig;
5261            
5262             my $newExpression = $expression;
5263             $newExpression =~ s/\($varName\)/$iNumber/g;
5264             $newExpression =~ s/$varName/$iNumber/g;
5265            
5266             my $finalExpression = "$newExpressionSoFar$newExpression";
5267            
5268             $string .= "$finalExpression\n ";
5269             }
5270            
5271             my %right = %$rightRef;
5272             my $rightLeftRef = $right{"left"};
5273             my $rightLeftExpression = getExpression($rightLeftRef,$processingMethodsRef,$string);
5274            
5275             if ( $rightLeftExpression =~ /(.*)\.GT\.0(.*)/)
5276             {
5277             my $variable = $1;
5278             my $result = $2;
5279             my $ifThenMethodRef = $processingMethods{"getIfThenExpression"};
5280             my $expression = &$ifThenMethodRef($variable, "GT", 0, $result, $expressionSoFar);
5281             $string .= $expression;
5282             }
5283             else
5284             {
5285             my %rightLeft = %$rightLeftRef;
5286             my $rightRightRef = $right{"right"};
5287             my %rightRight = %$rightRightRef;
5288             my $rightRightExpression = getExpression($rightRightRef,$processingMethodsRef,$string);
5289             $string .= $expressionSoFar . " = " . $expression;
5290             }
5291             }
5292            
5293             else
5294             {
5295             my $expression = getExpression($rightRef,$processingMethodsRef,$string);
5296            
5297             $string .= $prefixOperator;
5298             $string .= "(";
5299             $string .= $expression;
5300             $string .= ")";
5301             }
5302             }
5303             elsif ( defined($unaryOperator) && ( $unaryOperator ne "" ) )
5304             {
5305             $string .= $hashTree{"monop"};
5306             $string .= getExpression( $rightRef,$processingMethodsRef,$string);
5307             }
5308             else
5309             {
5310             my $name = $hashTree{"name"};
5311             if ( ! defined($name) )
5312             {
5313             #Improve -- do this only if infix operator is "const".
5314             my $val = $hashTree{"val"};
5315             if ( defined($hashTree{"val"}))
5316             {
5317             $string .= $hashTree{"val"};
5318             }
5319             }
5320             else
5321             {
5322             if ( $getLanguageSpecificVersionOfVariableRef )
5323             {
5324             $name = &$getLanguageSpecificVersionOfVariableRef($name);
5325             }
5326            
5327             $string .= $name;
5328             #Improve -- check to see if this needs to be done at all.
5329             if ( defined($hashTree{"val"}))
5330             {
5331             $string .= $hashTree{"val"};
5332             }
5333             }
5334             }
5335             }
5336            
5337             return $string;
5338            
5339             }
5340            
5341             sub processIfThenExpression
5342             {
5343             my $variable = $_[0];
5344             #my $winbugsVariable = getWinbugsVersionOfVariable($variable);
5345             my $expression = "step\($variable-eps\)";
5346             return $expression;
5347            
5348             }
5349            
5350             sub getNonmemStepExpression
5351             {
5352             my $variable = $_[0];
5353             my $stepCondition = $_[1];
5354             my $dataCondition = $_[2];
5355             my $result = $_[3];
5356             my $expressionSoFar = $_[4];
5357            
5358             my $expression = "$expressionSoFar 0; \n\tif ( $variable.$stepCondition.$dataCondition ) then $expressionSoFar $result";
5359             return $expression;
5360            
5361             }
5362            
5363             sub getWinbugsIfThenExpression
5364             {
5365             my $variable = $_[0];
5366             #my $winbugsVariable = getWinbugsVersionOfVariable($variable);
5367             my $expression = "step\($variable-eps\)";
5368             return $expression;
5369            
5370             }
5371            
5372             sub getHashOfArrayOfValuesInParentheses
5373             {
5374             my $valueRef= $_[0];
5375             my %tags = %{$_[1]};
5376             my $startTag = $tags{"startTag"};
5377             my $label = $tags{"label"};
5378             my $routine = $tags{"subRoutine"};
5379            
5380             my $expression = getStartTag($startTag," ");
5381            
5382             my @allHashTrees;
5383             if ( ref($valueRef) && $valueRef =~ /ARRAY/)
5384             {
5385             @allHashTrees = @$valueRef;
5386             }
5387             else
5388             {
5389             $allHashTrees[0] = $valueRef;
5390             }
5391            
5392             my $iTheta = 0;
5393             my $first = 1;
5394            
5395             foreach my $hashTreeRef ( @allHashTrees)
5396             {
5397             next unless (ref($hashTreeRef) && $hashTreeRef =~ /HASH/);
5398            
5399             my %hashTreeForVariable = %$hashTreeRef;
5400             my $hashTreeSetRef = $hashTreeForVariable{"variable"};
5401             if ( defined($hashTreeSetRef) && $hashTreeSetRef eq "" )
5402             {
5403             $hashTreeSetRef = $hashTreeForVariable{"vector"};
5404             }
5405             my @hashTreeSet;
5406             if ( ref($hashTreeSetRef) && $hashTreeSetRef =~ /ARRAY/)
5407             {
5408             @hashTreeSet = @{$hashTreeSetRef};
5409             }
5410             else
5411             {
5412             $hashTreeSet[0] = $hashTreeSetRef;
5413             }
5414             foreach my $unknownRef ( @hashTreeSet )
5415             {
5416             my @array;
5417             if ( ref($unknownRef) && $unknownRef =~ /ARRAY/)
5418             {
5419             @array = @$unknownRef;
5420             }
5421             else
5422             {
5423             $array[0] = $unknownRef;
5424             }
5425            
5426             foreach my $unknownRef1 ( @array )
5427             {
5428             $iTheta++;
5429             if ( ref($unknownRef1) && $unknownRef1 =~ /HASH/)
5430             {
5431             my %hash = %$unknownRef1;
5432            
5433             my @arrayOfValues = $hash{"middle"};
5434             $tags{"label"} = "$label$iTheta";
5435            
5436             unless($first)
5437             {
5438             $expression .= $tags{"separator"};
5439             }
5440             $first = 0;
5441            
5442             $expression .= &$routine(@arrayOfValues,\%tags);
5443             }
5444             else
5445             {
5446             if ( defined($unknownRef1) )
5447             {
5448             $expression .= " " . $unknownRef1;
5449             }
5450             }
5451             }
5452             }
5453             }
5454             $expression .= getEndTag($tags{"endTag"}," ");
5455             return($expression);
5456             }
5457            
5458             sub fillInArrayOfValuesInParentheses
5459             {
5460             my $valueRef = $_[0];
5461             my %tags = %{$_[1]};
5462             my $arrayOfValuesRef = $_[2];
5463            
5464             my $routine = $tags{"subRoutine"};
5465             my @arrayOfValues = @$arrayOfValuesRef;
5466            
5467             my @allHashTrees;
5468             if ( ref($valueRef) && $valueRef =~ /ARRAY/)
5469             {
5470             @allHashTrees = @$valueRef;
5471             }
5472             else
5473             {
5474             $allHashTrees[0] = $valueRef;
5475             }
5476            
5477             my $iTheta = 0;
5478             foreach my $hashTreeRef ( @allHashTrees)
5479             {
5480             next unless (ref($hashTreeRef) && $hashTreeRef =~ /HASH/);
5481            
5482             my %hashTreeForVariable = %$hashTreeRef;
5483             my $hashTreeSetRef = $hashTreeForVariable{"variable"};
5484             if ( defined($hashTreeSetRef) && $hashTreeSetRef eq "" )
5485             {
5486             $hashTreeSetRef = $hashTreeForVariable{"vector"};
5487             }
5488            
5489             my @hashTreeSet;
5490             if ( ref($hashTreeSetRef) && $hashTreeSetRef =~ /ARRAY/)
5491             {
5492             @hashTreeSet = @{$hashTreeSetRef};
5493             }
5494             else
5495             {
5496             $hashTreeSet[0] = $hashTreeSetRef;
5497             }
5498             foreach my $unknownRef ( @hashTreeSet )
5499             {
5500             my @array;
5501             if ( ref($unknownRef) && $unknownRef =~ /ARRAY/)
5502             {
5503             @array = @$unknownRef;
5504             }
5505             else
5506             {
5507             $array[0] = $unknownRef;
5508             }
5509             foreach my $unknownRef1 ( @array )
5510             {
5511             if ( defined($unknownRef1 ) )
5512             {
5513             if ( ref($unknownRef1) )
5514             {
5515             if ( $unknownRef1 =~ /HASH/)
5516             {
5517             my %hash = %$unknownRef1;
5518             my @vector = $hash{"middle"};
5519             $arrayOfValues[$iTheta++] = &$routine(@vector,\%tags);
5520             }
5521             }
5522             elsif ( $unknownRef1 =~ /\w/)
5523             {
5524             $arrayOfValues[$iTheta++] = $unknownRef1;
5525             }
5526             }
5527             }
5528             }
5529             }
5530             return(\@arrayOfValues);
5531             }
5532            
5533            
5534            
5535             sub getHashOfArrayOfValues
5536             {
5537             my $valueRef= $_[0];
5538             my %tags = %{$_[1]};
5539            
5540             my $tag = $tags{"startTag"};
5541             my $routine = $tags{"subRoutine"};
5542            
5543             my $expression = getStartTag($tag," ");
5544            
5545             my @vector;
5546            
5547             if ( ref($valueRef) )
5548             {
5549             if ( $valueRef =~ /HASH/)
5550             {
5551             my %hashTable = %$valueRef;
5552             my $vectorRef = $hashTable{"vector"};
5553             if ( ref($vectorRef) && $vectorRef =~ /ARRAY/ )
5554             {
5555             @vector = @$vectorRef;
5556             }
5557             else
5558             {
5559             print "probable error in reportHashOfArrayOfValues\n";
5560             print "probable error in reportHashOfArrayOfValues\n";
5561             return;
5562             }
5563             }
5564             elsif ( $valueRef =~ /ARRAY/)
5565             {
5566             @vector = @{$valueRef};
5567             my $vector0 = $vector[0];
5568             if ( ref($vector0) && $vector0 =~ /HASH/)
5569             {
5570             my %hash = %$vector0;
5571             @vector = @{$hash{"vector"}};
5572             }
5573             }
5574             }
5575             else
5576             {
5577             $vector[0] = $valueRef;
5578             }
5579            
5580             for ( my $iTheta = 0; $iTheta <= $#vector; $iTheta++)
5581             {
5582             my $iThetaBase1 = $iTheta + 1;
5583             $expression .= $tags{"separator"} if $iTheta > 0;
5584             #printStartTag("$tag$iThetaBase1",1);
5585             #"$tag$iThetaBase1"
5586             $improveThis = 1;
5587             $tags{"iNumber"} = $iThetaBase1;
5588             $expression .= &$routine($vector[$iTheta],\%tags);
5589            
5590             #printEndTag("$tag$iThetaBase1",1);
5591            
5592             }
5593            
5594             $expression .= $tags{"endTag"};
5595             }
5596            
5597            
5598             sub getArrayOfValues
5599             {
5600             my $valueRef= $_[0];
5601             my %tags = %{$_[1]};
5602            
5603             my $startTag = $tags{"startTag"};
5604             my $routine = $tags{"subRoutine"};
5605             my $separator = $tags{"separator"};
5606            
5607             my $expression = getStartTag($startTag," ");
5608            
5609             if (ref($valueRef ) && $valueRef =~ /ARRAY/)
5610             {
5611            
5612             my @vector = @{$valueRef};
5613             my $iFound = 0;
5614            
5615             for ( my $iTheta = 0; $iTheta <= $#vector; $iTheta++)
5616             {
5617             if ( $iFound )
5618             {
5619             $expression .= $separator;
5620             }
5621             $iFound = 1;
5622             my $iThetaBase1 = $iTheta + 1;
5623            
5624             $tags{"internalStartTag"} = " "; # "$startTag$iThetaBase1";
5625             $expression .= &$routine($vector[$iTheta],\%tags);
5626            
5627             #printEndTag("$tag$iThetaBase1",1);
5628            
5629             }
5630             }
5631             else
5632             {
5633             $tags{"startTag"} = " " ; #"${startTag}1";
5634             $expression .= &$routine($valueRef,\%tags);
5635            
5636             }
5637            
5638             $expression .= getEndTag($tags{"endTag"}," ");
5639             return($expression,"OK");
5640             }
5641            
5642            
5643             sub fillInArrayOfValues
5644             {
5645             my $valueRef= $_[0];
5646             my %tags = %{$_[1]};
5647             my $arrayOfValuesRef = $_[2];
5648             my @arrayOfValues = @$arrayOfValuesRef;
5649            
5650             my $routine = $tags{"subRoutine"};
5651            
5652             my $iTheta = 0;
5653             if (ref($valueRef ) && $valueRef =~ /ARRAY/)
5654             {
5655            
5656             my @vector = @{$valueRef};
5657             for ( my $iTheta = 0; $iTheta <= $#vector; $iTheta++)
5658             {
5659             $arrayOfValues[$iTheta] = &$routine($vector[$iTheta],\%tags);
5660             $iTheta++;
5661             }
5662             }
5663             else
5664             {
5665             $arrayOfValues[0] = &$routine($valueRef,\%tags);
5666             }
5667            
5668            
5669             return(\@arrayOfValues,"OK");
5670             }
5671            
5672            
5673             sub mapNamesToUseOfVectors
5674             {
5675             my $hashTreeRef =$_[0];
5676             my $tag = $_[1];
5677             my $nParams = $_[2];
5678            
5679             my %mapOfNames = ();
5680             for ( my $key = 1; $key < $nParams; $key++)
5681             {
5682             my $iFound = 0;
5683             my $name = "$tag$key";
5684             $mapOfNames{$name} = $tag . "(" . $key . ")";
5685             }
5686             return ( \%mapOfNames, "OK");
5687             }
5688            
5689            
5690            
5691             sub mapNamesOfDifferentialsToUseOfVectors
5692             {
5693             my $hashTreeRef =$_[0];
5694             my $tag = $_[1];
5695             my $nParams = $_[2];
5696            
5697             my %mapOfNames = ();
5698             for ( my $key = 1; $key < $nParams; $key++)
5699             {
5700             my $iFound = 0;
5701             my $name = "$tag$key";
5702             my $variable = $name;
5703             $variable =~ s/^D|DT[\d]+$//g;
5704             $mapOfNames{$name} = "diff(" . $variable.$key . "(t),t)";
5705             }
5706             return ( \%mapOfNames, "OK");
5707             }
5708            
5709             sub mapNamesToUseOfMapleVectors
5710             {
5711             my $hashTreeRef = $_[0];
5712             my $tag = $_[1];
5713             my $nParams = $_[2];
5714            
5715             my %mapOfNames = ();
5716             for ( my $key = 1; $key < $nParams; $key++)
5717             {
5718             my $iFound = 0;
5719             my $name = "$tag$key";
5720             $mapOfNames{$name} = "$tag$key" . "(t)";
5721             }
5722            
5723             return ( \%mapOfNames, "OK");
5724             }
5725            
5726            
5727             sub mapNamesOfDifferentialsToUseOfJetNotation
5728             {
5729             my $hashTreeRef =$_[0];
5730             my $tag = $_[1];
5731             my $nParams = $_[2];
5732            
5733             my %mapOfNames = ();
5734             for ( my $key = 1; $key < $nParams; $key++)
5735             {
5736             my $iFound = 0;
5737             my $name = "$tag$key";
5738             my $variable = $name;
5739             $variable =~ s/^D|DT[\d]+$//g;
5740             $mapOfNames{$name} = "$variable$key" . "[t]";
5741             }
5742             return ( \%mapOfNames, "OK");
5743             }
5744            
5745             sub mapNamesToUseOfJetNotation
5746             {
5747             my $hashTreeRef = $_[0];
5748             my $tag = $_[1];
5749             my $nParams = $_[2];
5750            
5751             my %mapOfNames = ();
5752             for ( my $key = 1; $key < $nParams; $key++)
5753             {
5754             my $iFound = 0;
5755             my $name = "$tag$key";
5756             $mapOfNames{$name} = "$tag$key" . "[]";
5757             }
5758            
5759             return ( \%mapOfNames, "OK");
5760             }
5761            
5762             sub obtainInverseHashOfValues
5763             {
5764             my $hashTreeRef = $_[0];
5765             my %tags = %{$_[1]};
5766             my $iLevel = $_[2];
5767             my $mapOfNamesRef = $_[3];
5768             my %mapOfNames = %$mapOfNamesRef;
5769            
5770             # VECTOR_VARIABLE_DEPENDENCIES =>
5771             # HASH = (
5772             # A =>
5773             # HASH = (
5774             # 1 => 'CL'
5775             # 2 => 'V'
5776             # )
5777             # ETA =>
5778             # HASH = (
5779             # 1 => 'CL'
5780             # 2 => 'V'
5781             # )
5782             # THETA =>
5783             # HASH = (
5784             # 1 => 'TVCL'
5785             # 2 => 'TVV'
5786             # )
5787            
5788            
5789             if ( ref($hashTreeRef ) && $hashTreeRef =~ /HASH/)
5790             {
5791             my %hashTree = %$hashTreeRef;
5792             my $tag = $tags{"label"};
5793            
5794             my $treeForThisTagRef = $hashTree{$tag};
5795             my %treeForThisTag = %$treeForThisTagRef;
5796            
5797             for ( my $key = 1; ; $key++)
5798             {
5799             my $value = $treeForThisTag{"$key"};
5800             last if ( ! defined($value) ) or $value eq "";
5801            
5802             my $keyPlusValue = $tag . $key;
5803             my $previous = $mapOfNames{$value};
5804            
5805             if ( defined($previous ) )
5806             {
5807             my @previousOnes = split(/,/,$previous);
5808             my $previouslyThere = 0;
5809             foreach my $previousOne ( @previousOnes)
5810             {
5811             if ( $previousOne eq $keyPlusValue)
5812             {
5813             $previouslyThere = 1;
5814             }
5815             }
5816             next if $previouslyThere;
5817             if ( $previous )
5818             {
5819             $mapOfNames{$value} = $previous . "," . $keyPlusValue;
5820             }
5821             else
5822             {
5823             $mapOfNames{$value} = $keyPlusValue;
5824             }
5825             }
5826             }
5827             }
5828            
5829             return(\%mapOfNames,"OK");
5830            
5831             }
5832            
5833             sub obtainInverseHashOfValuesForMaple
5834             {
5835             my %hashTree = %{$_[0]};
5836             my %tags = %{$_[1]};
5837            
5838             my $tag = $tags{"label"};
5839            
5840             my %mapOfNames = ();
5841            
5842             for ( my $key = 1; ; $key++ )
5843             {
5844             my $value = $hashTree{"$key"};
5845             last if ( ! defined($value) ) or $value eq "";
5846             $mapOfNames{$value} = $tag . $key;
5847             }
5848            
5849             return(\%mapOfNames,"OK");
5850            
5851             }
5852            
5853             sub obtainHashOfValues
5854             {
5855             my %hashTree = %{$_[0]};
5856             my $tag = $_[1];
5857            
5858             my %mapOfNames = ();
5859            
5860             for ( my $key = 1; ; $key++)
5861             {
5862             my $value = $hashTree{"$key"};
5863             last if $value eq "";
5864             $mapOfNames{$tag . $key} = $value;
5865             }
5866            
5867             my $state = "OK";
5868             return(\%mapOfNames,$state);
5869            
5870             }
5871            
5872             sub printTagAndValueOld
5873             {
5874             my $tag = $_[0];
5875             my $indentLevel = $_[1];
5876             my $value = $_[2];
5877            
5878             print $printHandle "\n", " " x ( 4 * $indentLevel );
5879             print $printHandle "<$tag>";
5880            
5881             print $printHandle "\n", " " x ( 4 * ( $indentLevel + 1));
5882             print $printHandle $value;
5883            
5884             print $printHandle "\n", " " x ( 4 * $indentLevel) ;
5885             print $printHandle "";
5886             }
5887            
5888             sub printTagAndValue
5889             {
5890             my $tag = $_[0];
5891             my $indentLevel = $_[1];
5892             my $value = $_[2];
5893            
5894             print $printHandle "\n", " " x ( 4 * $indentLevel );
5895             my $separator = "=";
5896             if ($indentLevel == 0)
5897             {
5898             $separator = " ";
5899             }
5900            
5901             print $printHandle "$tag$separator$value";
5902             }
5903            
5904             sub getMainTagAndValue
5905             {
5906             my $value = $_[0];
5907             my %tags = %{$_[1]};
5908            
5909             if ( ref($value ) && $value =~ /SCALAR/)
5910             {
5911             $value = $$value;
5912             }
5913            
5914             my $startTag = $tags{"startTag"};
5915             if ( ! defined($startTag) )
5916             {
5917             $startTag = "";
5918             }
5919             my $separator = $tags{"separator"};
5920             if ( ! defined($separator) )
5921             {
5922             $separator = "";
5923             }
5924             my $endTag = $tags{"endTag"};
5925             if ( ! defined($endTag) )
5926             {
5927             $endTag = "";
5928             }
5929            
5930             my $expression = $startTag . $separator . $value . $separator . $endTag;
5931             return ( $expression );
5932            
5933             }
5934            
5935             sub getTagAndValue
5936             {
5937             my $value = $_[0];
5938             my %tags = %{$_[1]};
5939            
5940             my $expression = $tags{"startTag"} . $tags{"separator"} . $value . $tags{"separator"} . $tags{"endTag"};
5941             return ( $expression );
5942             }
5943            
5944            
5945             sub getTagAndValueOrHashGeneral
5946             {
5947             my $tag = $_[0];
5948             my $indentLevel = $_[1];
5949             my $value = $_[2];
5950            
5951             my $expression = "";
5952            
5953             my $separator = "=";
5954             if ($indentLevel == 0)
5955             {
5956             $separator = " ";
5957             }
5958            
5959             if ( ref($tag ) && $tag =~ /HASH/)
5960             {
5961             my %hashTree = %$tag;
5962             foreach my $key ( keys ( %hashTree ))
5963             {
5964             $expression .= "$key=$hashTree{$key} ";
5965             }
5966             }
5967             elsif ( ref($tag) && $tag =~ /SCALAR/)
5968             {
5969             $expression .= "$$tag";
5970             }
5971             elsif ( ref($tag) && $tag =~ /ARRAY/)
5972             {
5973             my @array = @$tag;
5974             my $iFirst = 1;
5975             $separator = " ";
5976             foreach my $arrayElement( @array )
5977             {
5978             unless ($iFirst)
5979             {
5980             $expression .= $separator;
5981             }
5982             $iFirst = 0;
5983             $expression .= $arrayElement;
5984             }
5985             #print "\n";
5986             }
5987             else
5988             {
5989             $expression .= "$tag";
5990             }
5991            
5992             return($expression);
5993             }
5994            
5995            
5996            
5997             sub getTagAndValueOrExpressionGeneral
5998             {
5999             my $tag = $_[0];
6000             my $indentLevel = $_[1];
6001             my $value = $_[2];
6002            
6003             my $separator = "=";
6004             my $expression = "";
6005            
6006             if ($indentLevel == 0)
6007             {
6008             $separator = " ";
6009             }
6010            
6011             if ( ref($tag ) && $tag =~ /HASH/)
6012             {
6013             $expression .= getExpression($tag,0);
6014             }
6015             elsif( ref($value ) && $value =~ /HASH/)
6016             {
6017             $expression .= getExpression($value,0);
6018             }
6019             else
6020             {
6021             $expression .= "$tag$separator$value";
6022             }
6023             return($expression);
6024            
6025             }
6026            
6027             sub printStartTag
6028             {
6029             my $tag = $_[0];
6030             my $delimiter = $_[1];
6031             print $printHandle "$tag";
6032             }
6033            
6034             sub getStartTag
6035             {
6036             my $tag = $_[0];
6037             my $delimiter = $_[1];
6038             my $expression = "$tag";
6039             return ( $expression);
6040             }
6041            
6042             sub printValue
6043             {
6044             my $value = $_[0];
6045             print $printHandle $value;
6046             }
6047            
6048             sub getEndTag
6049             {
6050             my $tagRef = $_[0];
6051             my $tag;
6052             if ( ref($tag))
6053             {
6054             $tag = $$tagRef;
6055             }
6056             else
6057             {
6058             $tag = $tagRef;
6059             }
6060            
6061             my $expression = $tag;
6062             return ( $expression);
6063            
6064             }
6065            
6066             sub printEndTag
6067             {
6068             my $tagRef = $_[0];
6069             my $tag;
6070             if ( ref($tag))
6071             {
6072             $tag = $$tagRef;
6073             }
6074             else
6075             {
6076             $tag = $tagRef;
6077             }
6078             print $printHandle $tag;
6079            
6080             }
6081            
6082             sub getThetaGeneral
6083             {
6084             my @arrayOfValues = @{$_[0]};
6085             my $tag = $_[1];
6086            
6087             my $iLengthOfTheta = scalar(@arrayOfValues);
6088            
6089             my $lowValue;
6090             my $mediumValue;
6091             my $highValue;
6092            
6093             my $expression;
6094             if ( $iLengthOfTheta == 1 )
6095             {
6096             $lowValue = 0;
6097             $mediumValue = $arrayOfValues[0];
6098             $expression = " $mediumValue";
6099             }
6100             else
6101             {
6102             $lowValue = $arrayOfValues[0];
6103             $lowValue = "" if ! defined( $lowValue );
6104            
6105             $mediumValue = $arrayOfValues[1];
6106             $mediumValue = "" if ! defined( $mediumValue );
6107            
6108             $highValue = $arrayOfValues[$iLengthOfTheta-1];
6109             $highValue = "" if ! defined( $highValue );
6110            
6111             $expression = "( $lowValue, $mediumValue, $highValue ) ";
6112            
6113             }
6114            
6115             return ( $expression);
6116            
6117             }
6118            
6119             sub getThetaBounds
6120             {
6121             my @arrayOfValues = @{$_[0]};
6122             my %tags = %{$_[1]};
6123            
6124             my $label = $tags{"label"};
6125             my $indentLevel = $tags{"indentLevel"};
6126            
6127             my $lowValue = $arrayOfValues[0];
6128            
6129             my $iLengthOfTheta = $#arrayOfValues;
6130             my $highValue = $arrayOfValues[$iLengthOfTheta];
6131            
6132             my $expression = "\n" . " " x ( 4 * $indentLevel );
6133            
6134             $expression .= "$lowValue < $label, $label < $highValue";
6135             return ( $expression);
6136            
6137             }
6138            
6139            
6140             sub getThetaBoundsForAlgebraicTheories
6141             {
6142             my @arrayOfValues = @{$_[0]};
6143             my %tags = %{$_[1]};
6144            
6145             my $label = $tags{"label"};
6146             my $indentLevel = $tags{"indentLevel"};
6147            
6148             my $lowValue = $arrayOfValues[0];
6149            
6150             my $iLengthOfTheta = $#arrayOfValues;
6151             my $highValue = $arrayOfValues[$iLengthOfTheta];
6152            
6153             $improveThis =1 ; #do this better...
6154             my $baseLabel = substr($label,0,length($label)-1);
6155             my $iNumber = substr($label,-1);
6156            
6157             $improveThis = 1;
6158             my $lcBaseLabel = lc($baseLabel);
6159             $lcBaseLabel = $baseLabel;
6160            
6161             my $expression = "$baseLabel, $lcBaseLabel\[$iNumber\] \> $lowValue\n";
6162             $expression .= "$baseLabel, $lcBaseLabel\[$iNumber\] \< $highValue\n";
6163            
6164             return ( $expression);
6165            
6166             }
6167            
6168             sub getPKVariableNamesOriginal
6169             {
6170             my $arrayRef = $_[0];
6171             my @arrayOfNames = @$arrayRef;
6172            
6173             my $listOfVariables = join(",", @arrayOfNames);
6174             my $expression = "VARIABLE_NAMES_ORIGINAL,PK, =, [ $listOfVariables ]\n";
6175            
6176             return ( $expression);
6177             }
6178            
6179             sub getPKVariableNames
6180             {
6181             my $arrayRef = $_[0];
6182             my @arrayOfNames = @$arrayRef;
6183            
6184             my $listOfVariables = join(",", @arrayOfNames);
6185             my $expression = "VARIABLE_NAMES,PK, =, [ $listOfVariables ]\n";
6186            
6187             return ( $expression);
6188             }
6189            
6190             sub getPKVariableNamesFromGlobal()
6191             {
6192             my $arrayRef = getSubTree($globalASTRef,"PK_VARIABLE_NAMES");
6193             my @arrayOfNames = @$arrayRef;
6194             return(\@arrayOfNames);
6195             }
6196            
6197             sub getPKVariableDependencies
6198             {
6199             my ( $treeRef, $parameter, $arrayOfPKNamesRef, $defaultPrefix ) = @_;
6200            
6201             my %tree = %$treeRef;
6202            
6203             my $treeForParameterRef = $tree{$parameter};
6204             my %treeForParameter = %$treeForParameterRef;
6205             my @arrayOfPKNames = @$arrayOfPKNamesRef;
6206            
6207             my $expression;
6208            
6209             for my $key ( sort(keys ( %treeForParameter ) ))
6210             {
6211             my $variable = $treeForParameter{$key};
6212            
6213             my $variableToUse = "";
6214             my $iVariable = Util_isInList($variable,@arrayOfPKNames);
6215             if ( $iVariable == -1 )
6216             {
6217             $iVariable = Util_isInListWithPrefix($variable,$defaultPrefix,@arrayOfPKNames);
6218             }
6219             $variableToUse = $variable;
6220             if ( $iVariable > -1 )
6221             {
6222             $variableToUse = $defaultPrefix . $arrayOfPKNames[$iVariable];
6223             }
6224             my $lcParameter = lc($parameter);
6225             $improveThis = 1;
6226             $lcParameter = lc($parameter);
6227             $expression .= "PK_VARIABLE_NAMES," . $lcParameter . "[$key\], =, $variableToUse\n";
6228             }
6229            
6230             return ( $expression);
6231            
6232             }
6233            
6234             sub getPKVariableNamesFromDependencies
6235             {
6236             my ( $treeRef, $parameter, $arrayOfPKNamesRef, $defaultPrefix ) = @_;
6237            
6238             my %tree = %$treeRef;
6239            
6240             my $treeForParameterRef = $tree{$parameter};
6241             my %treeForParameter = %$treeForParameterRef;
6242             my @arrayOfPKNames = @$arrayOfPKNamesRef;
6243            
6244             my $lcParameter = lc($parameter);
6245             $improveThis = 1;
6246             $lcParameter = $parameter;
6247            
6248             my @namesFound = ();
6249             my @keys = sort ( keys ( %treeForParameter ) );
6250             for my $key ( @keys )
6251             {
6252             my $variable = $treeForParameter{$key};
6253            
6254             my $variableToUse = "";
6255             my $iVariable = Util_isInList($variable,@arrayOfPKNames);
6256             if ( $iVariable == -1 )
6257             {
6258             $iVariable = Util_isInListWithPrefix($variable,$defaultPrefix,@arrayOfPKNames);
6259             }
6260             $variableToUse = $variable;
6261             if ( $iVariable > -1 )
6262             {
6263             $variableToUse = $arrayOfPKNames[$iVariable];
6264             }
6265            
6266             #Still dumb enough to try the same:
6267             my $lengthOfPrefix = length($defaultPrefix);
6268             if ( uc(substr($variableToUse,0,$lengthOfPrefix)) eq uc($defaultPrefix))
6269             {
6270             $variableToUse = substr($variableToUse,$lengthOfPrefix,length($variableToUse)-2);
6271             }
6272             #check for Duplicate
6273             my $alreadyHere = Util_isInList($variableToUse,$defaultPrefix,@namesFound);
6274             if ( $alreadyHere < 0 )
6275             {
6276             push(@namesFound,$variableToUse);
6277             }
6278            
6279             }
6280            
6281             return ( \@namesFound);
6282            
6283             }
6284            
6285             sub getPKVariableNamesAsNTuple
6286             {
6287             my ( $treeRef, $parameter, $arrayOfPKNamesRef, $defaultPrefix ) = @_;
6288            
6289             my %tree = %$treeRef;
6290            
6291             my $treeForParameterRef = $tree{$parameter};
6292             my %treeForParameter = %$treeForParameterRef;
6293             my @arrayOfPKNames = @$arrayOfPKNamesRef;
6294            
6295             my $lcParameter = lc($parameter);
6296             $improveThis = 1;
6297             $lcParameter = $parameter;
6298            
6299             my $expression = "PK_VARIABLE_NAMES, " . $lcParameter . ', = , [ ';
6300            
6301             my $comma = " ";
6302             my @keys = sort(keys ( %treeForParameter ));
6303             for my $key ( @keys )
6304             {
6305             my $variable = $treeForParameter{$key};
6306            
6307             my $variableToUse = "";
6308             my $iVariable = Util_isInList($variable,@arrayOfPKNames);
6309             if ( $iVariable == -1 )
6310             {
6311             $iVariable = Util_isInListWithPrefix($variable,$defaultPrefix,@arrayOfPKNames);
6312             }
6313             $variableToUse = $variable;
6314             if ( $iVariable > -1 )
6315             {
6316             $variableToUse = $arrayOfPKNames[$iVariable];
6317             }
6318            
6319             #Still dumb enough to try the same:
6320             my $lengthOfPrefix = length($defaultPrefix);
6321             if ( uc(substr($variableToUse,0,$lengthOfPrefix)) eq uc($defaultPrefix))
6322             {
6323             $variableToUse = substr($variableToUse,$lengthOfPrefix,length($variableToUse)-2);
6324             }
6325             $expression .= $comma . $variableToUse;
6326             $comma = ", ";
6327             }
6328            
6329             $expression .= " ]\n";
6330             return ( $expression);
6331            
6332             }
6333            
6334             sub getThetaBoundsAsValues
6335             {
6336             my @arrayOfValues = @{$_[0]};
6337             my %tags = %{$_[1]};
6338            
6339             my $label = $tags{"label"};
6340             my $indentLevel = $tags{"indentLevel"};
6341            
6342             my $lowValue = $arrayOfValues[0];
6343            
6344             my $iLengthOfTheta = $#arrayOfValues;
6345             my $highValue = $arrayOfValues[$iLengthOfTheta];
6346            
6347             my @twoValues = ( $lowValue, $highValue);
6348             return (\@twoValues);
6349            
6350             }
6351            
6352             sub getThetaInitialValues
6353             {
6354             my @arrayOfValues = @{$_[0]};
6355             my $indentLevel = $_[1];
6356             my $tag = $_[2];
6357            
6358             my $iLengthOfTheta = scalar(@arrayOfValues);
6359             my $middleValue;
6360            
6361             if ( $iLengthOfTheta > 2 )
6362             {
6363             $middleValue = $arrayOfValues[1];
6364             }
6365             elsif ( $iLengthOfTheta == 2 )
6366             {
6367             #$middleValue = ($arrayOfValues[0]+$arrayOfValues[1])/2;
6368             $middleValue = ".";
6369            
6370             }
6371             else
6372             {
6373             $middleValue = $arrayOfValues[0];
6374             }
6375            
6376             my $expression = getTagAndValue($tag,1, $middleValue);
6377             return ( $expression);
6378            
6379             }
6380            
6381            
6382             sub getThetaBoundsAndInitialValuesForAlgebraicTheories
6383             {
6384             my @arrayOfValues = @{$_[0]};
6385             my %tags = %{$_[1]};
6386            
6387             my $label = $tags{"label"};
6388             my $indentLevel = $tags{"indentLevel"};
6389            
6390             my $lowValue = $arrayOfValues[0];
6391            
6392             my $iLengthOfTheta = $#arrayOfValues;
6393             my $highValue = $arrayOfValues[$iLengthOfTheta];
6394            
6395             $improveThis =1 ; #do this better...
6396             my $baseLabel = substr($label,0,length($label)-1);
6397             my $iNumber = substr($label,-1);
6398             $iLengthOfTheta = scalar(@arrayOfValues);
6399             my $middleValue;
6400            
6401             if ( $iLengthOfTheta > 2 )
6402             {
6403             $middleValue = $arrayOfValues[1];
6404             }
6405             elsif ( $iLengthOfTheta == 2 )
6406             {
6407             #$middleValue = ($arrayOfValues[0]+$arrayOfValues[1])/2;
6408             $middleValue = ".";
6409            
6410             }
6411             else
6412             {
6413             $middleValue = $arrayOfValues[0];
6414             }
6415            
6416             $improveThis = 1;
6417             my $lowerCaseLabel = $baseLabel;
6418             my $expression = "${baseLabel}BoundsAndInitialValue, " . $lowerCaseLabel . "[$iNumber\], =, [ $lowValue, $middleValue, $highValue]\n";
6419            
6420             return ( $expression);
6421            
6422             }
6423            
6424             sub getThetaInitialValuesForAlgebraicTheories
6425             {
6426             my @arrayOfValues = @{$_[0]};
6427             my %tags = %{$_[1]};
6428            
6429             my $label = $tags{"label"};
6430             my $indentLevel = $tags{"indentLevel"};
6431            
6432             my $lowValue = $arrayOfValues[0];
6433            
6434             my $iLengthOfTheta = $#arrayOfValues;
6435             my $highValue = $arrayOfValues[$iLengthOfTheta];
6436            
6437             $improveThis =1 ; #do this better...
6438             my $baseLabel = substr($label,0,length($label)-1);
6439             my $iNumber = substr($label,-1);
6440             $iLengthOfTheta = scalar(@arrayOfValues);
6441             my $middleValue;
6442            
6443             if ( $iLengthOfTheta > 2 )
6444             {
6445             $middleValue = $arrayOfValues[1];
6446             }
6447             elsif ( $iLengthOfTheta == 2 )
6448             {
6449             #$middleValue = ($arrayOfValues[0]+$arrayOfValues[1])/2;
6450             $middleValue = ".";
6451            
6452             }
6453             else
6454             {
6455             $middleValue = $arrayOfValues[0];
6456             }
6457             my $lcBaseLabel = lc($baseLabel);
6458             my $expression = "${baseLabel}InitialValue," . "${lcBaseLabel}\[$iNumber\][0], =, $middleValue\n";
6459            
6460             return ( $expression);
6461            
6462             }
6463            
6464             sub getOmegaInitialValues
6465             {
6466             my $value = $_[0];
6467             my $tag = $_[1];
6468            
6469             my $expression = getTagAndValue($tag,1, $value);
6470             return ( $expression);
6471            
6472             }
6473            
6474             sub getOmegaInitialValuesGeneral
6475             {
6476             my $value = $_[0];
6477             my $tag = $_[1];
6478            
6479             my $expression = $value;
6480            
6481             return($expression);
6482             }
6483            
6484             sub getOmegaInitialValuesAsValues
6485             {
6486             my $value = $_[0];
6487             my $tagsRef = $_[1];
6488             my %tags = %$tagsRef;
6489             my $tag = $tags{"label"};
6490            
6491             my $expression = $value;
6492            
6493             return($expression);
6494             }
6495            
6496            
6497             sub getOmegaInitialValuesForAlgebraicTheories
6498             {
6499             my $value = $_[0];
6500             my $tagsRef = $_[1];
6501             my %tags = %$tagsRef;
6502             my $tag = lc($tags{"label"});
6503             my $iNumber = $tags{"iNumber"};
6504            
6505             my $expression = "${tag}," . "${tag}I[$iNumber] ,=, $value";
6506            
6507             return($expression);
6508             }
6509            
6510             sub getOmegaInitialValuesAsListForAlgebraicTheories
6511             {
6512             my $value = $_[0];
6513             my $tagsRef = $_[1];
6514             my %tags = %$tagsRef;
6515             my $tag = lc($tags{"label"});
6516             my $iNumber = $tags{"iNumber"};
6517            
6518             my $expression = "$value ";
6519            
6520             return($expression);
6521             }
6522            
6523             sub getOmegaBoundsAsValues
6524             {
6525             my $value = $_[0];
6526             my $tag = $_[1];
6527            
6528             return($value);
6529             }
6530            
6531             sub getNONMEMControlFiles
6532             {
6533             if ( ( $_ =~ /$patternForFileName/i ) )
6534             {
6535             #&& ( ! /\.CTL$|\.bugs$|\.m$/i )
6536             #next unless $File::Find::dir =~ /other/i;
6537             unless ( $File::Find::dir =~ /run/ )
6538             {
6539            
6540             my $inputFileNameComplete = $File::Find::name;
6541            
6542             next if $inputFileNameComplete =~ /\.*TLC/i;
6543            
6544             my $nameForCopyOfFile = $inputFileNameComplete;
6545             $nameForCopyOfFile = substr($nameForCopyOfFile,length($NONMEMSourceDirectory));
6546             $nameForCopyOfFile =~ s/\/|\\/_/g;
6547             $nameForCopyOfFile =~ s/^[\.]//;$nameForCopyOfFile =~ s/^_//i;
6548            
6549             if ( $nameForCopyOfFile =~ /$patternForDirectoryName/i )
6550             {
6551            
6552             print $inputFileNameComplete,"\n";
6553            
6554             $nameForCopyOfFile = "$runsDirectory/" . $nameForCopyOfFile;
6555            
6556             my $TLCOutputFileName = $nameForCopyOfFile;
6557             if ( $TLCOutputFileName =~ /\.CTL/i)
6558             {
6559             $TLCOutputFileName =~ s/\.CTL/\.TLC/ig;
6560             }
6561             else
6562             {
6563             $TLCOutputFileName = $TLCOutputFileName . "\.TLC";
6564             }
6565            
6566             my $dataFileName = "";
6567            
6568             #print $inputFileNameComplete,"\n";
6569            
6570             $improveThis = 1;
6571             $inputFileNameComplete =~ s/\.\/both/D:\\monolixParsing\\both/g;
6572             $inputFileNameComplete =~ s/\//\\/g;
6573             open(INPUTFILE,"$inputFileNameComplete") or die("Could not open NONMEM control file for input $inputFileNameComplete\n");
6574             my @copy = ;
6575             close(INPUTFILE);
6576            
6577             foreach my $line ( @copy )
6578             {
6579             if ( $line =~ /^DATA/)
6580             {
6581             my @parts = split(/\s+/,$line);
6582             $dataFileName = $parts[1];
6583            
6584             unless ( open(DATAFILE,$dataFileName))
6585             {
6586             unless ( open(DATAFILE,"$dataDirectory/$dataFileName"))
6587             {
6588             my $revisedDataFileName = PK_regularizeFileName($dataFileName,".data");
6589             open(DATAFILE,"$dataDirectory/$revisedDataFileName") or die("Could not open $dataDirectory/$revisedDataFileName for $inputFileNameComplete\n");
6590             }
6591             }
6592             #Also make a copy in directory of regularized file names, one per model.
6593            
6594             my $oldSeparator = $/;
6595             $/ = "\n";
6596             my @dataLines = ;
6597             close(DATAFILE);
6598             $/ = $oldSeparator;
6599            
6600             $dataLines[0] =~ s/^[\s]*[;\#]*[\s]*//g;
6601             my $header = $dataLines[0];
6602            
6603             my @headers = split(/\s+/,$header);
6604            
6605             my $iId = 0;
6606             my $iEvid = 0;
6607             my $iTime = 0;
6608             my $iAmt = 0;
6609             my $iDoseFieldId = 0;
6610            
6611             my $minTime = 10000;
6612            
6613             for ( my $i = 0; $i <= $#headers; $i++)
6614             {
6615             if ( $headers[$i] eq 'EVID')
6616             {
6617             $iEvid = $i;
6618             }
6619             if ( $headers[$i] eq 'ID')
6620             {
6621             $iId = $i;
6622             }
6623             if ( $headers[$i] eq 'TIME')
6624             {
6625             $iTime = $i;
6626             }
6627            
6628             if ( $headers[$i] eq 'AMT')
6629             {
6630             $iAmt = $i;
6631             }
6632             if ( $headers[$i] eq 'DOSE')
6633             {
6634             $iDoseFieldId = $i;
6635             }
6636             }
6637            
6638             for ( my $i = 1; $i <= $#dataLines; $i++)
6639             {
6640             $dataLines[$i] =~ s/^\s+//g;
6641             my @values = split(/\s+/,$dataLines[$i]);
6642             next if ($values[$iTime] eq "." );
6643            
6644             if ( $minTime > $values[$iTime] )
6645             {
6646             $minTime = $values[$iTime];
6647             }
6648             }
6649            
6650             my $dataFileWithSameBasicNameAsModel = $nameForCopyOfFile;
6651             $dataFileWithSameBasicNameAsModel =~ s/.*\///g;
6652             $dataFileWithSameBasicNameAsModel =~ s/\.CTL/\_DATA\.TXT/g;
6653            
6654             $oldSeparator = $/;
6655             $/ = "\n";
6656             open(DATACOPY,">/oss/dataRegularizedNames/$dataFileWithSameBasicNameAsModel")
6657             or die("Could not open output data file /openStatisticalServices/dataRegularizedNames/$dataFileWithSameBasicNameAsModel\n");
6658             print DATACOPY @dataLines;
6659             close(DATACOPY);
6660             $/ = $oldSeparator;
6661            
6662             open(DATAOUT,">$runsDirectory/$dataFileName.inputs")
6663             or die("Could not open output data file $runsDirectory/$dataFileName.input for $inputFileNameComplete\n");
6664             print DATAOUT "$headers[$iId],$headers[$iTime],$headers[$iAmt],$headers[$iDoseFieldId]\n";
6665             close(DATAOUT);
6666             }
6667            
6668             }
6669            
6670             open(COPYFILE,">$nameForCopyOfFile") or die("Could not open file $nameForCopyOfFile for copy\n");
6671             #print COPYFILE ";----------------------------------------------------------------------\n";
6672             print COPYFILE @copy;
6673             print COPYFILE "\n";
6674             #print COPYFILE ";----------------------------------------------------------------------\n";
6675             close(COPYFILE);
6676            
6677             open(INPUTFILE,"$inputFileNameComplete") or die("Could not open file name: $inputFileNameComplete\n");
6678             my $inputFileHandle = \*INPUTFILE;
6679             print $inputFileNameComplete,"\n";
6680            
6681             open(OUTPUTFILE,">$TLCOutputFileName") or die("Could not open output file $TLCOutputFileName\n");
6682             my $outputFileHandle = \*OUTPUTFILE;
6683            
6684             my $logFileName = $TLCOutputFileName;
6685             $logFileName =~ s/\.TLC/\.parseLog/i;
6686            
6687             open(LOGFILE,">$logFileName");
6688             my $logFileHandle = \*LOGFILE;
6689            
6690             reinitStates();
6691            
6692             if ( $useMATLAB )
6693             {
6694             &ParseMATLABMetadataAndModel($inputFileHandle,$outputFileHandle,$logFileHandle,$TLCOutputFileName,$dataFileName);
6695             }
6696             else
6697             {
6698             &ParseNONMEMFile($inputFileHandle,$outputFileHandle,$logFileHandle,$TLCOutputFileName,$dataFileName);
6699             }
6700             }
6701             }
6702             }
6703             }
6704            
6705             sub getNONMEMDataFiles
6706             {
6707             next unless /data*.txt/i;
6708            
6709             my $inputFileNameComplete = $File::Find::name;
6710            
6711             next if $inputFileNameComplete =~ /TLC|runs/i;
6712            
6713             print $inputFileNameComplete,"\n";
6714            
6715             my $inputFileName = $_;
6716            
6717             my $TLCOutputFileName = $inputFileName;
6718            
6719             my $dataFileName = "";
6720            
6721             open(INPUTFILE,$inputFileName) or die("Could not open file name -- $inputFileName\n");
6722             my @copy = ;
6723             close(INPUTFILE);
6724            
6725             open(COPYFILE,">$runsDirectory/$inputFileName") or die("Could not open file $runsDirectory/$inputFileName for copy\n");
6726             print COPYFILE @copy;
6727             close(COPYFILE);
6728            
6729             #Also make a copy of the file as a "regularized" file name
6730             my $newName = PK_regularizeFileName($inputFileName,"_data.txt");
6731            
6732             open(COPYFILE,">/openStatisticalServices/dataRegularizedNames/$newName") or die("Could not open file /oss/dataRegularizedNames/$newName for copy\n");
6733             print COPYFILE @copy;
6734             close(COPYFILE);
6735            
6736            
6737             }
6738            
6739             sub getMonolixModelFiles
6740             {
6741             next unless $_ =~ /.*\.m/i;
6742            
6743             my $inputFileNameComplete = $File::Find::name;
6744            
6745             print $inputFileNameComplete,"\n";
6746            
6747             my $inputFileName = $_;
6748            
6749             my $TLCOutputFileName = $inputFileName;
6750            
6751             my $dataFileName = "";
6752            
6753             open(INPUTFILE,$inputFileName) or die("Could not open file name -- $inputFileName\n");
6754             my @copy = ;
6755             close(INPUTFILE);
6756            
6757             open(COPYFILE,">$monolixTargetDirectory/$inputFileName") or die("Could not open file $monolixTargetDirectory/$inputFileName for copy\n");
6758             print COPYFILE @copy;
6759             close(COPYFILE);
6760            
6761             }
6762            
6763             sub parsePROBLEM
6764             {
6765             my $string = $_[0];
6766             my $state = $_[1];
6767            
6768             $string =~ s/\n//g;
6769            
6770             $state = "PROBLEM";
6771             return ( $string, $state);
6772             }
6773            
6774             sub reinitStates
6775             {
6776             %globalAST = ();
6777             $globalASTRef = \%globalAST;
6778            
6779             %derivationsForVariables = ();
6780             $derivationsForVariablesRef = \%derivationsForVariables;
6781            
6782             %reverseDerivationsForVariables = ();
6783            
6784             %IfThenExpressionsForVariables = ();
6785             $IfThenExpressionsForVariablesRef = \%IfThenExpressionsForVariables;
6786            
6787             %variablesWithNumericSuffixes = ();
6788             $variablesWithNumericSuffixesRef = \%variablesWithNumericSuffixes;
6789             %variablesWithoutNumericSuffixes = ();
6790             $variablesWithoutNumericSuffixesRef = \%variablesWithoutNumericSuffixes;
6791            
6792             %logitFunctions = ();
6793             %inverseLogitFunctions = ();
6794            
6795             $notFirstProblem = 0;
6796             }
6797            
6798             sub parseCOMMENT
6799             {
6800            
6801             my $string = $_[0];
6802             my $state = $_[1];
6803            
6804             return ( $string, $state);
6805             }
6806            
6807             sub parseDATA
6808             {
6809             my ($listRef,$state) = parseList(\$_[0],"\\s+");
6810            
6811             my $DATARef;
6812             ($DATARef,$state) = parseAttributeValuePairsInList($listRef);
6813            
6814             $state = "DATA";
6815            
6816             return ( $DATARef, $state );
6817             }
6818            
6819            
6820            
6821             sub parseETA
6822             {
6823             my ( $listRef, $state ) = parseLinesOfLists($_[0]);
6824            
6825             my $OMEGARef;
6826             ($OMEGARef,$state) = parseAttributeValuePairsInList($listRef);
6827            
6828             my @addresses = (0,"vector");
6829             my $arrayRef = getSubTree($OMEGARef,\@addresses);
6830             if ( ref($arrayRef) && $arrayRef =~ /ARRAY/)
6831             {
6832             my @array = @$arrayRef;
6833             my $one = $array[0];
6834             my $fixed = $array[1];
6835             if ( $one == 1.0 && $fixed =~ /fixed/i )
6836             {
6837             my %tree = (
6838             fixed => $array[0]
6839             );
6840             insertSubTree($globalASTRef,"FixedEta",\%tree);
6841             }
6842             }
6843            
6844             $state = "ETA";
6845             return ( $OMEGARef, $state );
6846             }
6847            
6848             sub parseMODEL
6849             {
6850             my ($treeRef,$state) = parseExpressions($_[0]);
6851             $state = "OK";
6852             return ( $treeRef, $state );
6853            
6854             }
6855            
6856             sub parsePK
6857             {
6858            
6859             my ($treeRef, $state) = parseEquations($_[0]);
6860             return ( $treeRef, $state );
6861            
6862             }
6863            
6864            
6865             sub parseWinBUGSModel
6866             {
6867            
6868             my $treeRef = $_[0];
6869             my $state = "";
6870             my $modifiedTreeRef;
6871             ($modifiedTreeRef,$state) = modifyTree($treeRef, \&checkForCharactersGiven,\&parseOneCharacterPair,"\{","\}",0,1,0);
6872             my $modifiedTree1Ref;
6873             ($modifiedTree1Ref,$state) = modifyTree($modifiedTreeRef,\&checkForCharactersGiven,\&replaceBrackets, "\[","\]",0,100,0);
6874            
6875             my %modifiedTree1 = %$modifiedTree1Ref;
6876             my $middleRef = $modifiedTree1{"middle"};
6877            
6878             my $iTotalLevels = 10;
6879             $improveThis = 1;
6880             if ( $improveThis )
6881             {
6882             $iTotalLevels = 1;
6883             }
6884            
6885             my $middle1Ref = "";
6886             ($middle1Ref,$state) = modifyTree($middleRef,\&checkForCharactersGiven,\&parseEquations,$assignmentOperator,"",0,$iTotalLevels,0);
6887            
6888             $modifiedTree1{"middle"} = $middle1Ref;
6889            
6890             $state = "WinBUGSModelStatement";
6891            
6892             return ( \%modifiedTree1, $state );
6893            
6894            
6895             }
6896            
6897             sub parseListStatement
6898             {
6899             my $treeRef = $_[0];
6900             my $state;
6901            
6902             my $tree1Ref;
6903             ($tree1Ref,$state) = modifyTree($treeRef, \&checkForCharactersGiven,\&parseOneCharacterPair,"\(","\)",0,10,0);
6904            
6905             my $tree2Ref;
6906             ($tree2Ref,$state) = modifyTree($tree1Ref,\&checkForCharactersGiven,\&parseOneSetOfCommas,",","",0,100,0);
6907            
6908             $state = "List";
6909             return ( $tree2Ref, $state );
6910            
6911             }
6912            
6913             sub checkForComma
6914             {
6915             my $string = $_[0];
6916             my $iFound = 0;
6917            
6918             if ( ! ref($string) )
6919             {
6920             if( grep(/,/,$string))
6921             {
6922             $iFound = 1;
6923             }
6924             }
6925             return($iFound);
6926             }
6927            
6928            
6929             sub replaceBrackets
6930             {
6931             my $string = $_[0];
6932             my $iFound = 0;
6933             my $state = "OK";
6934            
6935             if ( ! ref($string) )
6936             {
6937             $string =~ s/\[/\(/g;
6938             $string =~ s/\]/\)/g;
6939             }
6940             return($string,$state);
6941             }
6942            
6943            
6944             sub checkForIFStatement
6945             {
6946            
6947             my $arrayRef = $_[0];
6948             my $name = $_[1];
6949            
6950             my $iFound = 0;
6951            
6952             if ( ref($arrayRef) && $arrayRef =~ /ARRAY/ )
6953             {
6954             my @anArray = @$arrayRef;
6955             for ( my $i = $#anArray; $i >= 0; $i--)
6956             {
6957             my $hashRef = $anArray[$i];
6958             if (ref($hashRef) && $hashRef =~ /HASH/ )
6959             {
6960             my %hashTree = %$hashRef;
6961            
6962             if ( defined($hashTree{"oper"} ) && ($hashTree{"oper"} eq "=" ))
6963             {
6964             my $hashTreeRightRef = $hashTree{"right"};
6965             unless ( ref($hashTreeRightRef) && $hashTreeRightRef =~ /HASH/)
6966             {
6967             print "Possible error in checkForIfStatement\n";
6968             printTree($arrayRef,0,*STDOUT,"Check for if statement\n");
6969             }
6970             unless ( defined ( $hashTreeRightRef ) and $hashTreeRightRef =~ /HASH/)
6971             {
6972             printTree($globalASTRef,0,*STDOUT,"Here was the complete tree\n");
6973             printTree($arrayRef,0,*STDOUT,"Check for if statement\n");
6974             printTree($arrayRef,0,*STDOUT,"This was the problematic line\n");
6975             exit;
6976             }
6977             my %hashTreeRight = %$hashTreeRightRef;
6978             if ( defined($hashTreeRight{"fname"}) && $hashTreeRight{"fname"} eq "IF" )
6979             {
6980             $iFound = 1;
6981             }
6982             }
6983             }
6984             }
6985             }
6986            
6987             return ( $iFound);
6988             }
6989            
6990             sub checkForArray
6991             {
6992            
6993             my $arrayRef = $_[0];
6994             my $name = $_[1];
6995            
6996             my $iFound = 0;
6997            
6998             if ( ref($arrayRef) && $arrayRef =~ /ARRAY/ )
6999             {
7000             $iFound = 1;
7001             }
7002            
7003             return ( $iFound);
7004             }
7005            
7006            
7007             sub checkForTautology
7008             {
7009            
7010             my $arrayRef = $_[0];
7011             my $name = $_[1];
7012            
7013             my $iFound = 0;
7014            
7015             if ( ref($arrayRef) && $arrayRef =~ /ARRAY/ )
7016             {
7017             my @anArray = @$arrayRef;
7018             for ( my $i = $#anArray; $i >= 0; $i--)
7019             {
7020             my $hashRef = $anArray[$i];
7021             if (ref($hashRef) && $hashRef =~ /HASH/ )
7022             {
7023             my %hashTree = %$hashRef;
7024            
7025             if ( scalar(keys(%hashTree)) == 0 )
7026             {
7027             $iFound = 1;
7028             print "Internal error in CheckForTautology\n";
7029             exit;
7030             }
7031            
7032             if ( defined($hashTree{"oper"}) && ( $hashTree{"oper"} eq $assignmentOperator))
7033             {
7034             my $rightTreeRef = $hashTree{"right"};
7035             if ( !ref ( $rightTreeRef ) )
7036             {
7037             return 0;
7038             }
7039             my %rightTree = %$rightTreeRef;
7040            
7041             my $leftTreeRef = $hashTree{"left"};
7042             if ( !ref ( $leftTreeRef ) )
7043             {
7044             return 0;
7045             }
7046             my %leftTree = %$leftTreeRef;
7047            
7048             my $leftVariableName = $leftTree{"name"};
7049             my $rightVariableName = $rightTree{"name"};
7050            
7051            
7052             if ( defined($leftVariableName) && $leftVariableName ne "" && defined($rightVariableName) && $leftVariableName eq $rightVariableName )
7053             {
7054             $iFound = 1;
7055             }
7056            
7057             }
7058            
7059             }
7060             }
7061             }
7062            
7063             return ( $iFound);
7064             }
7065            
7066             sub checkForLHSVariable
7067             {
7068            
7069             my $arrayRef = $_[0];
7070             my $name = $_[1];
7071             my $absence = $_[2];
7072            
7073             my $iFound = 0;
7074            
7075             if ( ref($arrayRef) && $arrayRef =~ /ARRAY/ )
7076             {
7077             my @anArray = @$arrayRef;
7078             for ( my $i = $#anArray; $i >= 0; $i--)
7079             {
7080             my $hashRef = $anArray[$i];
7081             if (ref($hashRef) && $hashRef =~ /HASH/ )
7082             {
7083             my %hashTree = %$hashRef;
7084            
7085             if ( $hashTree{"oper"} eq "=" )
7086             {
7087             my $hashTreeLeftRef = $hashTree{"left"};
7088             my %hashTreeLeft = %$hashTreeLeftRef;
7089             if ( $hashTreeLeft{"name"} =~ /$name/ xor $absence )
7090             {
7091             $iFound = 1;
7092             last;
7093             }
7094             }
7095             }
7096             }
7097             }
7098            
7099             return ( $iFound);
7100             }
7101            
7102             sub checkForLHSVariablePresent
7103             {
7104            
7105             my $arrayRef = $_[0];
7106             my $name = $_[1];
7107             my $absence = 0;
7108            
7109             return ( checkForLHSVariable($arrayRef,$name,$absence));
7110             }
7111            
7112             sub checkForLHSVariableAbsent
7113             {
7114            
7115             my $arrayRef = $_[0];
7116             my $name = $_[1];
7117             my $absence = 1;
7118            
7119             return ( checkForLHSVariable($arrayRef,$name,$absence));
7120             }
7121            
7122            
7123             sub deleteIfLHSVariablePresent
7124             {
7125            
7126             my $arrayRef = $_[0];
7127             my $name = $_[1];
7128             my $absence = 0;
7129            
7130             return ( deleteIfLHSVariablePresentOrAbsent($arrayRef,$name,$absence));
7131             }
7132            
7133             sub deleteIfLHSVariableAbsent
7134             {
7135            
7136             my $arrayRef = $_[0];
7137             my $name = $_[1];
7138             my $absence = 1;
7139            
7140             return ( deleteIfLHSVariablePresentOrAbsent($arrayRef,$name,$absence));
7141             }
7142            
7143            
7144            
7145             sub deleteIfLHSVariablePresentOrAbsent
7146             {
7147            
7148             my $arrayRef = $_[0];
7149             my $name = $_[1];
7150             my $absence = $_[2];
7151            
7152             my $iFound = 0;
7153            
7154             if ( ref($arrayRef) && $arrayRef =~ /ARRAY/ )
7155             {
7156             my @anArray = @$arrayRef;
7157             for ( my $i = $#anArray; $i >= 0; $i--)
7158             {
7159             my $hashRef = $anArray[$i];
7160             if (ref($hashRef) && $hashRef =~ /HASH/ )
7161             {
7162             my %hashTree = %$hashRef;
7163            
7164             if ( $hashTree{"oper"} eq "=" )
7165             {
7166             my $hashTreeLeftRef = $hashTree{"left"};
7167             my %hashTreeLeft = %$hashTreeLeftRef;
7168             if ( $hashTreeLeft{"name"} =~ /$name/ xor $absence )
7169             {
7170             $iFound = 1;
7171             splice(@anArray,$i,1);
7172             }
7173             }
7174             }
7175             }
7176             if ( $iFound )
7177             {
7178             $arrayRef = \@anArray;
7179             }
7180             }
7181            
7182            
7183             return ( $arrayRef);
7184             }
7185            
7186            
7187             sub consolidateAsIfThenExpression
7188             {
7189            
7190             my $arrayRef = $_[0];
7191             my $name = $_[1];
7192            
7193             my $iFoundOneIfStatement = 0;
7194            
7195             if ( ref($arrayRef) && $arrayRef =~ /ARRAY/ )
7196             {
7197             my @anArray = @$arrayRef;
7198             for ( my $i = 0; $i <= $#anArray; $i++)
7199             {
7200             my $hashRef = $anArray[$i];
7201             if (ref($hashRef) && $hashRef =~ /HASH/ )
7202             {
7203             my %hashTree = %$hashRef;
7204            
7205             if ( $hashTree{"oper"} eq "=" )
7206             {
7207             my $hashTreeRightRef = $hashTree{"right"};
7208             my %hashTreeRight = %$hashTreeRightRef;
7209             my $name = "";
7210            
7211             if ( $hashTreeRight{"fname"} eq "IF" )
7212             {
7213             my $hashTreeLeftRef = $hashTree{"left"};
7214             my %hashTreeLeft = %$hashTreeLeftRef;
7215             if ( $hashTreeLeft{"oper"} eq "var" )
7216             {
7217             $name = $hashTreeLeft{"name"};
7218            
7219             my $hashTreeRightRef = $hashTree{"right"};
7220             my %hashTreeRight = %$hashTreeRightRef;
7221            
7222             my $hashTreeRight2Ref = $hashTreeRight{"right"};
7223             my %hashTreeRight2 = %$hashTreeRight2Ref;
7224            
7225             my $hashTreeRight3Ref = $hashTreeRight2{"right"};
7226            
7227             my $iFound = 0;
7228             my $j;
7229             for ( $j = $i - 1; $j >= 0; $j--)
7230             {
7231             my $hashTreeForElseRef = $anArray[$j];
7232             if (ref($hashTreeForElseRef) && $hashTreeForElseRef =~ /HASH/ )
7233             {
7234             my %hashTreeForElse = %$hashTreeForElseRef;
7235             if ( $hashTreeForElse{"oper"} eq "=" )
7236             {
7237             my $hashTreeForElseLeftRef = $hashTreeForElse{"left"};
7238             my %hashTreeForElseLeft = %$hashTreeForElseLeftRef;
7239             if ( $hashTreeForElseLeft{"oper"} eq "var" )
7240             {
7241             if ( $hashTreeForElseLeft{"name"} eq $name )
7242             {
7243             $iFound = 1;
7244            
7245             my $hashTreeForElseRightRef = $hashTreeForElse{"right"};
7246             my %hashTreeRight3 = (
7247             oper => ',',
7248             left => $hashTreeRight3Ref,
7249             right => $hashTreeForElseRightRef
7250             );
7251             $hashTreeRight2{"right"} = \%hashTreeRight3;
7252             $hashTreeRight{"right"} = \%hashTreeRight2;
7253             $hashTree{"right"} = \%hashTreeRight;
7254             $anArray[$i] = \%hashTree;
7255             last;
7256             } # end if
7257             } #end if
7258             } #end if
7259             } #end if
7260             } #end for ( my $j = $i - 1; $j >= 0; $j--)
7261            
7262             if ( $iFound )
7263             {
7264             splice(@anArray,$j,1);
7265             $iFoundOneIfStatement = 1;
7266             $i = $i - 1;
7267             }
7268             } #if ( $hashTreeRight{"fname"} eq "IF" )
7269             } # if ( $hashTree{"oper"} eq "=" )
7270             }
7271             }
7272             }
7273            
7274             if ( $iFoundOneIfStatement )
7275             {
7276             $arrayRef = \@anArray;
7277             ( $arrayRef, $name ) = obtainCategoricalVariableFromSetOfIfStatements($arrayRef,$name);
7278             }
7279             }
7280            
7281            
7282             return ( $arrayRef, "OK");
7283             }
7284            
7285            
7286             sub obtainCategoricalVariableFromSetOfIfStatements
7287             {
7288            
7289             my $arrayRef = $_[0];
7290             my $name = $_[1];
7291            
7292             my $iFoundOneIfStatement = 0;
7293            
7294             if ( ref($arrayRef) && $arrayRef =~ /ARRAY/ )
7295             {
7296             my @anArray = @$arrayRef;
7297             for ( my $i = 0; $i <= $#anArray; $i++)
7298             {
7299             my $hashRef = $anArray[$i];
7300             if (ref($hashRef) && $hashRef =~ /HASH/ )
7301             {
7302             my %hashTree = %$hashRef;
7303            
7304             if ( $hashTree{"oper"} eq "=" )
7305             {
7306             my $hashTreeRightRef = $hashTree{"right"};
7307             my %hashTreeRight = %$hashTreeRightRef;
7308             my $name = "";
7309            
7310             if ( $hashTreeRight{"fname"} eq "IF" )
7311             {
7312             my $hashTreeLeftRef = $hashTree{"left"};
7313             my %hashTreeLeft = %$hashTreeLeftRef;
7314            
7315             my $hashTreeRightRef = $hashTree{"right"};
7316            
7317             if ( $hashTreeLeft{"oper"} eq "var" )
7318             {
7319             printTree($hashTreeRightRef, 0, *STDOUT, "Right Tree to check");
7320             printTree($hashTreeLeftRef, 0, *STDOUT, "Left Tree to check");
7321            
7322             $name = getSubTree($hashTreeLeftRef,"name");
7323             my @treeLocation = ("right","left","left","name");
7324             my $varName = getSubTree($hashTreeRightRef,\@treeLocation);
7325             @treeLocation = ("right","right","left");
7326             my $valResult = getSubTree($hashTreeRightRef,\@treeLocation);
7327             @treeLocation = ("right","left","right","val");
7328             my $testVal = getSubTree($hashTreeRightRef,\@treeLocation);
7329            
7330             my %treeForThisInstance = (
7331             varName => $varName,
7332             valResult => $valResult
7333             );
7334            
7335             my %treeForVariable = ();
7336            
7337             unless ( $IfThenExpressionsForVariables{$name} )
7338             {
7339             $IfThenExpressionsForVariables{$name} = \%treeForVariable;
7340             }
7341             else
7342             {
7343             my $treeForVariableRef = $IfThenExpressionsForVariables{$name};
7344             %treeForVariable = %$treeForVariableRef;
7345             }
7346            
7347             $treeForVariable{$testVal} = \%treeForThisInstance;
7348             $IfThenExpressionsForVariables{$name} = \%treeForVariable;
7349            
7350             } #if ( $hashTreeRight{"fname"} eq "IF" )
7351             } # if ( $hashTree{"oper"} eq "=" )
7352             }
7353             }
7354             }
7355            
7356             if ( $iFoundOneIfStatement )
7357             {
7358             $arrayRef = \@anArray;
7359             }
7360             }
7361            
7362             return ( $arrayRef, "OK");
7363             }
7364            
7365            
7366             sub addNumericVariable
7367             {
7368             my ( $varNameWithoutSuffix, $iNumber, $valueToAdd ) = @_;
7369            
7370             my $treeForVariableRef = $variablesWithNumericSuffixes{$varNameWithoutSuffix};
7371            
7372             my %treeForVariable = ();
7373             unless ( $treeForVariableRef )
7374             {
7375             $treeForVariableRef = \%treeForVariable;
7376             }
7377             else
7378             {
7379             %treeForVariable = %$treeForVariableRef;
7380             }
7381            
7382             $treeForVariable{$iNumber} = $valueToAdd;
7383             $variablesWithNumericSuffixes{$varNameWithoutSuffix} = \%treeForVariable;
7384            
7385             if ( $varNameWithoutSuffix eq "ERR" )
7386             {
7387             my $completeVariableName = $varNameWithoutSuffix . $iNumber;
7388             $variablesWithNumericSuffixes{$completeVariableName}++;
7389             }
7390            
7391             }
7392            
7393            
7394             sub analyzeLHSVariables
7395             {
7396            
7397             my $arrayRef = $_[0];
7398             my $processingMethodsRef = $_[1];
7399            
7400             if ( ref($arrayRef) && $arrayRef =~ /ARRAY/ )
7401             {
7402            
7403             my @anArray = @$arrayRef;
7404             for ( my $i = 0; $i <= $#anArray; $i++)
7405             {
7406             my $hashRef = $anArray[$i];
7407             if (ref($hashRef) && $hashRef =~ /HASH/ )
7408             {
7409             my %hashTree = %$hashRef;
7410            
7411             if ( $hashTree{"oper"} eq "=" )
7412             {
7413             my $hashTreeRightRef = $hashTree{"right"};
7414             my %hashTreeRight = %$hashTreeRightRef;
7415             my $name = "";
7416            
7417             my $hashTreeLeftRef = $hashTree{"left"};
7418             my %hashTreeLeft = %$hashTreeLeftRef;
7419            
7420             if ( $hashTreeLeft{"oper"} eq "var" )
7421             {
7422             #Name of variable.
7423             my $varName = $hashTreeLeft{"name"};
7424             $varName =~ s/\(\{\}\)//g;
7425             my $varNameWithoutSuffix = substr($varName,0,length($varName)-1);
7426             my $lastCharacter = substr($varName,-1);
7427             unless ( $lastCharacter =~ /\d/ )
7428             {
7429             $variablesWithoutNumericSuffixes{$varName} = 1;
7430             next;
7431             }
7432            
7433             addNumericVariable($varNameWithoutSuffix,$lastCharacter,$hashTreeRightRef);
7434            
7435             my $expression = getExpression($hashTreeRightRef,$processingMethodsRef);
7436            
7437             #Do this in the Winbugs plane...
7438             if ( $expression =~ /1\/\(1\+\(EXP\(\-(.*)\)\)\)/ )
7439             {
7440             my $variableFound = $1;
7441             $logitFunctions{$variableFound} = $varName;
7442             $variableFound =~ s/\[iObs,|\]//g;
7443             $logitFunctions{$variableFound} = $varName;
7444             #hack on 01/20
7445             $varName = substr($varName,0,length($varName)-1);
7446             $inverseLogitFunctions{$varName} = $variableFound;
7447             }
7448            
7449             } # if ( $hashTree{"oper"} eq "=" )
7450             }
7451             }
7452             }
7453             }
7454            
7455             return ( $arrayRef, "OK");
7456             }
7457            
7458            
7459             sub checkForVariable
7460             {
7461            
7462             my $hashTreeRef = $_[0];
7463             my $iFound = 0;
7464            
7465             if ( ref($hashTreeRef) && $hashTreeRef =~ /HASH/)
7466             {
7467             my %hashTree = %$hashTreeRef;
7468             if ( $hashTree{"oper"} eq "var" )
7469             {
7470             #Name of variable.
7471             my $varName = $hashTree{"name"};
7472             $iFound = 1;
7473             }
7474             }
7475            
7476             return ( $iFound);
7477             }
7478            
7479             sub analyzeVariable
7480             {
7481             my $hashTreeRef = $_[0];
7482            
7483             if ( ref($hashTreeRef ) && $hashTreeRef =~ /HASH/)
7484             {
7485             my %hashTree = %$hashTreeRef;
7486            
7487             if ( $hashTree{"oper"} eq "var" )
7488             {
7489             my $varNameWithoutSuffix;
7490             my $lastCharacter;
7491            
7492             #Name of variable.
7493             my $varName = $hashTree{"name"};
7494             if ($varName =~ /diff\((.*)\((.*)\)/)
7495             {
7496             $varName = $1;
7497             }
7498             if ( $varName =~ /\)|\)|\[|\]/)
7499             {
7500             $varNameWithoutSuffix = $varName;
7501             $varNameWithoutSuffix =~ s/\((.*)\)//g;
7502             $lastCharacter = $1;
7503             }
7504             else
7505             {
7506             $lastCharacter = substr($varName,-1);
7507             if ( $lastCharacter =~ /\d/ )
7508             {
7509             $varNameWithoutSuffix = substr($varName,0,length($varName)-1);
7510             }
7511             }
7512            
7513             if ( $varNameWithoutSuffix )
7514             {
7515             addNumericVariable($varNameWithoutSuffix,$lastCharacter,1);
7516             }
7517             else
7518             {
7519             $variablesWithoutNumericSuffixes{$varName}++;
7520             }
7521             }
7522             }
7523            
7524             return ( $hashTreeRef, "OK");
7525             }
7526            
7527             sub checkForArrayWithOneElement
7528             {
7529             my $arrayRef = $_[0];
7530             my $name = $_[1];
7531            
7532             my $iFound = 0;
7533             if ( ref($arrayRef) )
7534             {
7535             if ( $arrayRef =~ /ARRAY/ )
7536             {
7537             my @array = @$arrayRef;
7538             if (scalar(@array) == 1 )
7539             {
7540             if ( ref($array[0]))
7541             {
7542             $iFound = 1;
7543             if ( $debug )
7544             {
7545             print "Just one array item here\n";
7546             }
7547             }
7548             }
7549             }
7550             elsif( $arrayRef =~ /HASH/ )
7551             {
7552             my %hashTable = %$arrayRef;
7553             if (scalar(keys(%hashTable)) == 1 )
7554             {
7555             if ( $hashTable{"vector"} )
7556             {
7557             $iFound = 1;
7558             if ( $debug )
7559             {
7560             print "Just one hash item here\n";
7561             }
7562            
7563             }
7564             }
7565             }
7566             }
7567             return($iFound);
7568             }
7569            
7570            
7571             sub deleteTautology
7572             {
7573             my $arrayRef = $_[0];
7574             my $name = $_[1];
7575            
7576             my $iFound = 0;
7577             if ( ref($arrayRef) && $arrayRef =~ /ARRAY/ )
7578             {
7579             my @anArray = @$arrayRef;
7580             for ( my $i = $#anArray; $i >= 0; $i--)
7581             {
7582             my $hashRef = $anArray[$i];
7583             if (ref($hashRef) && $hashRef =~ /HASH/ )
7584             {
7585            
7586             my %hashTree = %$hashRef;
7587            
7588             if ( scalar(%hashTree) == 0 )
7589             {
7590             $iFound = 1;
7591             print "Error in delete Tautology routine\n";
7592             exit;
7593             }
7594            
7595             if ( $hashTree{"oper"} eq $assignmentOperator)
7596             {
7597             my $rightTreeRef = $hashTree{"right"};
7598             if ( !ref ( $rightTreeRef ) )
7599             {
7600             return ( $arrayRef, "OK");
7601             }
7602             my %rightTree = %$rightTreeRef;
7603            
7604             my $leftTreeRef = $hashTree{"left"};
7605             if ( !ref ( $leftTreeRef ) )
7606             {
7607             return ( $arrayRef, "OK")
7608             }
7609             my %leftTree = %$leftTreeRef;
7610            
7611             my $leftVariableName = $leftTree{"name"};
7612             my $rightVariableName = $rightTree{"name"};
7613            
7614             if ( $leftVariableName ne "" && $leftVariableName eq $rightVariableName )
7615             {
7616             splice(@anArray,$i,1);
7617             $iFound = 1;
7618             }
7619             }
7620            
7621             }
7622             }
7623            
7624             if ( $iFound )
7625             {
7626             $arrayRef = \@anArray;
7627             }
7628            
7629             }
7630             return ( $arrayRef, "OK");
7631             }
7632            
7633            
7634             sub deleteUseOfArrayWithOneElement
7635             {
7636             my $arrayRef = $_[0];
7637             my $name = $_[1];
7638            
7639             if ( ref($arrayRef))
7640             {
7641             if ($arrayRef =~ /ARRAY/ )
7642             {
7643             my @anArray = @$arrayRef;
7644             my $hashRef = $anArray[0];
7645             $arrayRef = $hashRef;
7646             }
7647             elsif ($arrayRef =~ /HASH/)
7648             {
7649             my %myHash = %$arrayRef;
7650             my $tempRef = $myHash{"vector"};
7651             if ( $tempRef ne "" )
7652             {
7653             $arrayRef = $tempRef;
7654             if ( $debug )
7655             {
7656             print "did not delete 1 element array";
7657             }
7658            
7659             }
7660             }
7661             }
7662            
7663             return ( $arrayRef, "OK");
7664             }
7665            
7666            
7667             sub checkForNames
7668             {
7669             my $hashRef = $_[0];
7670             my $mapOfNames = $_[1];
7671            
7672             my $iFound = 0;
7673            
7674             if ( ref($hashRef) && $hashRef =~ /HASH/ && ref($mapOfNames) )
7675             {
7676            
7677             my %hashTree = %$hashRef;
7678             my %hashOfNames = %$mapOfNames;
7679             my $name = $hashTree{"name"};
7680            
7681             if ( defined($name) && $name ne "" )
7682             {
7683             if ( defined($hashOfNames{$name}) && $hashOfNames{$name} ne "" )
7684             {
7685             $iFound = 1;
7686             }
7687             }
7688             }
7689            
7690             return ( $iFound);
7691             }
7692            
7693             sub checkForNamesUsingOddRules
7694             {
7695             my $hashRef = $_[0];
7696             my $mapOfNames = $_[1];
7697            
7698             my $iFound = 0;
7699            
7700             if ( ref($hashRef) && $hashRef =~ /HASH/ && ref($mapOfNames) )
7701             {
7702            
7703             my %hashTree = %$hashRef;
7704             my %hashOfNames = %$mapOfNames;
7705             my $name = $hashTree{"name"};
7706            
7707             if ( defined($name) && ( $name ne "" ) )
7708             {
7709             unless ( $name =~ /^S\d/)
7710             {
7711             if ( defined( $hashOfNames{$name}) && ($hashOfNames{$name} ne "" ) )
7712             {
7713             my $variablesTreeRef = $hashOfNames{$name};
7714             my %variablesTree = %$variablesTreeRef;
7715             my $variable = $variablesTree{"variables"};
7716             unless ( $variable =~ /,/)
7717             {
7718             $iFound = 1;
7719             }
7720             }
7721             }
7722             }
7723             }
7724            
7725             return ( $iFound);
7726             }
7727            
7728            
7729             sub replaceNames
7730             {
7731             my $hashRef = $_[0];
7732             my $mapOfNames = $_[1];
7733            
7734             my %hashTree = %$hashRef;
7735             my %hashOfNames = %$mapOfNames;
7736            
7737             my $iFound = 0;
7738            
7739             my $name = $hashTree{"name"};
7740            
7741             if ( $name ne "" )
7742             {
7743             if ( $hashOfNames{$name} ne "" )
7744             {
7745             $hashTree{"name"} = $hashOfNames{$name};
7746             $iFound = 1;
7747             }
7748             }
7749            
7750             if ( $iFound )
7751             {
7752             $hashRef = \%hashTree;
7753             }
7754            
7755             return ( $hashRef, "OK" )
7756             }
7757            
7758             sub replaceNamesAndStoreThoseUsed
7759             {
7760             my $hashRef = $_[0];
7761             my $mapOfNames = $_[1];
7762            
7763             my %hashTree = %$hashRef;
7764             my %hashOfNames = %$mapOfNames;
7765            
7766             my $iFound = 0;
7767            
7768             my $name = $hashTree{"name"};
7769            
7770             if ( $name ne "" )
7771             {
7772             if ( $hashOfNames{$name} ne "" )
7773             {
7774             $hashTree{"name"} = $hashOfNames{$name};
7775             push(@arrayOfInfoAsSideEffectsYesThisIsBad,$name);
7776             $iFound = 1;
7777             }
7778             }
7779            
7780             if ( $iFound )
7781             {
7782             $hashRef = \%hashTree;
7783             }
7784            
7785             return ( $hashRef, "OK" )
7786             }
7787            
7788             sub replacePKNamesUsingOddRules
7789             {
7790             my $hashRef = $_[0];
7791             my $mapOfNames = $_[1];
7792            
7793             my %hashTree = %$hashRef;
7794             my %hashOfNames = %$mapOfNames;
7795            
7796             my $iFound = 0;
7797            
7798             my $name = $hashTree{"name"};
7799            
7800             if ( $name ne "" )
7801             {
7802             if ( $hashOfNames{$name} ne "" )
7803             {
7804             $hashTree{"name"} = $hashOfNames{$name};
7805             push(@arrayOfInfoAsSideEffectsYesThisIsBad,$name);
7806             $iFound = 1;
7807             }
7808             }
7809            
7810             if ( $iFound )
7811             {
7812             if ( $name ne "" )
7813             {
7814             unless ( $name =~ /^S\d/)
7815             {
7816             if ( $hashOfNames{$name} ne "" )
7817             {
7818             my $variablesTreeRef = $hashOfNames{$name};
7819             my %variablesTree = %$variablesTreeRef;
7820             my $variable = $variablesTree{"variables"};
7821             unless ( $variable =~ /,/)
7822             {
7823             $iFound = 1;
7824             $hashTree{"name"} = $variable;
7825             $hashRef = \%hashTree;
7826             }
7827             }
7828             }
7829             }
7830            
7831             }
7832            
7833             return ( $hashRef, "OK" )
7834             }
7835            
7836            
7837             sub replaceNamesUsingInverseMap
7838             {
7839             my $hashRef = $_[0];
7840             my $mapOfNamesRef = $_[1];
7841            
7842             my %hashTree = %$hashRef;
7843             my %mapOfNames = %$mapOfNamesRef;
7844            
7845             my $iFound = 0;
7846            
7847             my $name = $hashTree{"name"};
7848            
7849            
7850             #skip observations.
7851             unless ( $name =~ /^S.*/)
7852             {
7853            
7854             if ( $name ne "" )
7855             {
7856             if ( $mapOfNames{$name} ne "" )
7857             {
7858             $hashTree{"name"} = $mapOfNames{$name};
7859             push(@arrayOfInfoAsSideEffectsYesThisIsBad,$name);
7860             $iFound = 1;
7861             }
7862             }
7863            
7864             if ( $iFound )
7865             {
7866             $hashRef = \%hashTree;
7867             }
7868             }
7869            
7870             return ( $hashRef, "OK" )
7871             }
7872            
7873            
7874             sub replaceNameWithParseTree
7875             {
7876             my $hashRef = $_[0];
7877             my $mapOfNames = $_[1];
7878            
7879             my %hashTree = %$hashRef;
7880            
7881             if ( ref($mapOfNames) && $mapOfNames =~ /HASH/ )
7882             {
7883             my %hashOfNames = %$mapOfNames;
7884            
7885             my $name = $hashTree{"name"};
7886            
7887             if ( $name ne "" )
7888             {
7889             if ( $hashOfNames{$name} ne "" )
7890             {
7891             $hashRef = $hashOfNames{$name};
7892             }
7893             }
7894             }
7895             else
7896             {
7897             print "Problem in replace names with trees\n";
7898             print "-------------------------------------\n";
7899             }
7900             return ( $hashRef, "OK" )
7901             }
7902            
7903            
7904            
7905             sub checkForUseOfVector
7906             {
7907            
7908             if ( scalar(@_) < 2 )
7909             {
7910             print "Oops\n";
7911             exit;
7912             }
7913             my $hashTreeRef = $_[0];
7914             my $name = $_[1];
7915            
7916             my $iFound = 0;
7917             if ( ref($hashTreeRef) && $hashTreeRef =~ /HASH/ )
7918             {
7919             my %hashTree = %$hashTreeRef;
7920             if ( defined($hashTree{"fname"}) && $hashTree{"fname"} eq $name )
7921             {
7922             $iFound = 1;
7923             }
7924             else
7925             {
7926             my $nameToExamine = $hashTree{"name"};
7927             if ( defined($nameToExamine))
7928             {
7929             $nameToExamine =~ s/[\(\]\.*|[\)\]].*//g;
7930             if ( $nameToExamine eq $name )
7931             {
7932             $iFound = 1;
7933             }
7934             }
7935             }
7936             }
7937             return ( $iFound);
7938             }
7939            
7940            
7941             sub checkForUseOfFunction
7942             {
7943             my $hashTreeRef = $_[0];
7944             my $name = $_[1];
7945            
7946             my $iFound = 0;
7947             if ( ref($hashTreeRef) && $hashTreeRef =~ /HASH/ )
7948             {
7949             my %hashTree = %$hashTreeRef;
7950             if ( $hashTree{"fname"} eq $name )
7951             {
7952             $iFound = 1;
7953             }
7954             else
7955             {
7956             my $nameToExamine = $hashTree{"name"};
7957             $nameToExamine =~ s/[\(\]\.*|[\)\]].*//g;
7958             if ( $nameToExamine eq $name )
7959             {
7960             $iFound = 1;
7961             }
7962             }
7963             }
7964             return ( $iFound);
7965             }
7966            
7967             sub checkForUseOfFunctionAndVariable
7968             {
7969             my $hashTreeRef = $_[0];
7970             my $tagsRef = $_[1];
7971            
7972             my %tags = %$tagsRef;
7973            
7974             my $nameOfFunction = $tags{"nameOfFunction"};
7975             my $nameOfVariable = $tags{"nameOfVariable"};
7976             my $nameFound = "";
7977            
7978             my $iFound = 0;
7979             if ( ref($hashTreeRef) && $hashTreeRef =~ /HASH/ )
7980             {
7981             my %hashTree = %$hashTreeRef;
7982             if ( defined($hashTree{"fname"}) && ( $hashTree{"fname"} =~ /^$nameOfFunction$/i ) )
7983             {
7984             $iFound = 1;
7985             }
7986             else
7987             {
7988             my $nameToExamine = $hashTree{"name"};
7989             if ( defined($nameToExamine) )
7990             {
7991             $nameToExamine =~ s/[\(\]\.*|[\)\]].*//g;
7992             if ( ( $nameToExamine eq $nameOfFunction ) )
7993             {
7994             $iFound = 1;
7995             }
7996             }
7997             }
7998             if ( $iFound )
7999             {
8000             my $expression = getExpression($hashTreeRef,"");
8001             if ( $expression =~ /\W$nameOfVariable\W/)
8002             {
8003             $nameFound = $nameOfVariable;
8004             }
8005             }
8006             }
8007             return ( $nameFound);
8008             }
8009            
8010             sub checkForCharactersGiven
8011             {
8012             my $string = $_[0];
8013             my $char1 = $_[1];
8014             my $char2 = $_[2];
8015             my $iFound = 0;
8016            
8017             if ( ! ref($string) )
8018             {
8019             my $charWithBackslash = '\\' . $char1;
8020             if( grep(/$charWithBackslash/,$string))
8021             {
8022             $iFound = 1;
8023             }
8024             }
8025             return($iFound);
8026             }
8027            
8028            
8029             sub parsePRED
8030             {
8031            
8032             my ($treeRef, $state ) = parseEquations($_[0]);
8033            
8034             return ( $treeRef, $state );
8035            
8036             }
8037            
8038             sub parseDES
8039             {
8040            
8041             my ($ref, $state ) = parseEquations($_[0]);
8042            
8043             return ( $ref, $state );
8044            
8045             }
8046            
8047             sub parseSCAT
8048             {
8049             my $string = $_[0];
8050            
8051             my ($ref,$state) = parseListStatement(\$string);
8052             return ($ref,"SCAT");
8053            
8054            
8055             }
8056            
8057             sub parseERROR
8058             {
8059            
8060             my $errorLines = $_[0];
8061             if ( $errorLines =~ m/ONLY OBSERVATIONS/)
8062             {
8063             print "Only observations for errors\n";
8064             $errorLines =~ s/\(ONLY OBSERVATIONS\)//g;
8065             }
8066            
8067             my ($ref, $state ) = parseEquations($errorLines);
8068             $state = "ERROR";
8069            
8070             return ( $ref, $state );
8071            
8072             }
8073            
8074             sub parseTHETA
8075             {
8076             my ($treeRef, $state) = parseSetsOfParentheses($_[0]);
8077            
8078             traverseTreeParseParentheses($treeRef,"",0);
8079            
8080             return ( $treeRef,$state);
8081            
8082             }
8083            
8084             sub parseSIGMA
8085             {
8086             my ( $treeRef, $state ) = parseLinesOfLists($_[0]);
8087             return ( $treeRef, $state );
8088            
8089             }
8090            
8091             sub parseSetsOfParentheses
8092             {
8093             my $string = $_[0];
8094             my $state = $_[1];
8095            
8096             my $separator = "\n";
8097             my (@lines ) = split(/$separator/,$string);
8098             my @expressions = ();
8099            
8100             my @trees = ();
8101            
8102             my $iLine = 0;
8103            
8104             foreach my $line ( @lines)
8105             {
8106             my ( $headAndTailRef,$state) = parseHeadAndTail($line,$commentCharacter,0);
8107             my %headAndTail = %$headAndTailRef;
8108             my $expr = $headAndTail{"head"};
8109             my $comment = $headAndTail{"tail"};
8110            
8111             my %tree = ();
8112            
8113             if ( defined($expr) && $expr ne "" )
8114             {
8115             if ( $expr =~ /\(/)
8116             {
8117             (my $treeForExpressionRef, $state) = parseParentheses($expr);
8118            
8119             %tree = (
8120             "variable" => $treeForExpressionRef,
8121             "comment" => $comment
8122             );
8123             }
8124             else
8125             {
8126             my %treeForExpression =
8127             (
8128             "left" => "0",
8129             "right" => "",
8130             "middle" => $expr,
8131             "terminal" => $expr,
8132             "oper" => "PARENS"
8133             );
8134             %tree = (
8135             "variable" => \%treeForExpression,
8136             "comment" => $comment
8137             );
8138            
8139             }
8140             }
8141             else
8142             {
8143             %tree = (
8144             "comment" => $comment
8145             );
8146             }
8147            
8148             $trees[$iLine] = \%tree;
8149             $iLine++;
8150            
8151             }
8152            
8153             return ( \@trees, $state );
8154            
8155             }
8156            
8157            
8158             sub parseListOfValues
8159             {
8160             my $string = $_[0];
8161             my $state = $_[1];
8162            
8163             my $separator = "\\n";
8164             my (@lines ) = split(/$separator/,$string);
8165             my @expressions = ();
8166            
8167             my @trees = ();
8168             my $iLine = 0;
8169            
8170             foreach my $line ( @lines)
8171             {
8172             my ( $headAndTailRef,$state ) = parseHeadAndTail($line,$commentCharacter,0);
8173             my %headAndTail = %$headAndTailRef;
8174             my $expr = $headAndTail{"head"};
8175             my $comment = $headAndTail{"tail"};
8176            
8177             #Modify the NONMEM line so that it can be defined in terms of a context free grammar. Here '*' denotes monoid composition,
8178             #that is, * as concatentation of lists
8179             $expr =~ s/\)\(/\)\*\(/g;
8180            
8181             my %tree = ();
8182            
8183             if ( $expr ne "" )
8184             {
8185             my $ArithEnv = new Math::Expression;
8186             my $treeForExpression = $ArithEnv->Parse($expr);
8187             %tree = (
8188             "variable" => $treeForExpression,
8189             "comment" => $comment
8190             );
8191             } else {
8192             %tree = (
8193             "comment" => $comment
8194             );
8195             }
8196             $trees[$iLine] = \%tree;
8197             $iLine++;
8198            
8199             }
8200             return ( \@trees, $state );
8201            
8202             }
8203            
8204            
8205             sub parseLinesOfLists
8206             {
8207             my $string = $_[0];
8208             my $state = $_[1];
8209            
8210             my $separator = "\\n";
8211             my @lines = split(/$separator/,$string);
8212            
8213             my @trees = ();
8214            
8215             my $iLine = 0;
8216             foreach my $line ( @lines)
8217             {
8218             my ( $headAndTailRef,$state ) = parseHeadAndTail($line,$commentCharacter,0);
8219             my %headAndTail = %$headAndTailRef;
8220             my $expr = $headAndTail{"head"};
8221             my $comment = $headAndTail{"tail"};
8222            
8223             my $listRef;
8224             ($listRef,$state) = parseList(\$expr,"\\s+");
8225             my %tree = ();
8226            
8227             my $used = 0;
8228             if ( scalar(@$listRef) > 0 )
8229             {
8230             $tree{"vector"} = $listRef;
8231             $used++;
8232             }
8233            
8234             if ( $comment ne "" )
8235             {
8236             $tree{"comment"} = $comment;
8237             $used++;
8238             }
8239            
8240             if ( $used > 0)
8241             {
8242             $trees[$iLine] = \%tree;
8243             $iLine++;
8244             }
8245             else
8246             {
8247             ;
8248             }
8249            
8250             }
8251            
8252             return ( \@trees, $state );
8253            
8254             }
8255            
8256             sub parseSUBROUTINE
8257             {
8258             my ($listRef,$state) = parseList(\$_[0], "\\s+|,");
8259            
8260             my $ref;
8261             ($ref,$state) = parseAttributeValuePairsInList($listRef);
8262             $state = "SUBROUTINE";
8263             return ( $ref, $state );
8264            
8265             }
8266            
8267             sub parseHeadAndTail
8268             {
8269             my $string = $_[0];
8270             my $separator = $_[1];
8271             my $keepSeparator = $_[2];
8272            
8273             my $comment = "";
8274             my $head = "";
8275             my $tail = "";
8276             my $right = "";
8277            
8278             $string =~ s/^[\s+|\n]*//g;
8279             while ( substr($string,0,1) eq $commentCharacter )
8280             {
8281             my @commentLines = split(/\n/,$string, 2);
8282             $comment = $commentLines[0];
8283             if ( scalar(@commentLines) > 1 )
8284             {
8285             $string = $commentLines[1];
8286             $string =~ s/^[\s+|\n]*//g;
8287             }
8288             else
8289             {
8290             $string = "";
8291             }
8292             }
8293            
8294             my @headAndTail = split(/$separator/,$string, 2);
8295            
8296             if ( scalar(@headAndTail) >= 2 )
8297             {
8298             ( $head, $tail ) = @headAndTail;
8299             }
8300             else
8301             {
8302             $head = $headAndTail[0];
8303             }
8304            
8305             if ( $keepSeparator )
8306             {
8307             $tail = substr($string,length($head));
8308             }
8309            
8310            
8311             $tail=~ s/^[\s+|\n]*//g;
8312            
8313             my $state = "OK";
8314            
8315             my %tree =
8316             (
8317             head => $head,
8318             tail => $tail,
8319             right => $right
8320             );
8321            
8322             return (\%tree,$state);
8323             }
8324            
8325             sub parseList
8326             {
8327             my $stringRef = $_[0];
8328             my $separator = $_[1];
8329             my $state = "OK";
8330            
8331             my $string = $$stringRef;
8332            
8333             my @list = ();
8334             if ( defined($string))
8335             {
8336             $string =~ s/^\s+//g;
8337             @list = split(/$separator/,$$stringRef);
8338             }
8339             return (\@list,"OK");
8340            
8341             }
8342            
8343             sub parseAttributeValuePairsInList
8344             {
8345            
8346             my $listRef = $_[0];
8347             my %attributes = ();
8348             my $used = 0;
8349             my $iListLength = scalar(@$listRef);
8350             for ( my $iList = $iListLength-1; $iList >= 0; $iList--)
8351             {
8352             if ( @$listRef[$iList] =~ /=/ )
8353             {
8354             my ( $attribute, $value ) = split($assignmentOperator,@$listRef[$iList]);
8355             $attributes{$attribute} = $value;
8356             splice(@$listRef,$iList,1);
8357             $used++;
8358             }
8359             }
8360            
8361             if ( $used == $iListLength )
8362             {
8363             $listRef = \%attributes;
8364             }
8365             elsif ( $used > 0 )
8366             {
8367             push(@$listRef,\%attributes);
8368             }
8369            
8370             my $state = "OK";
8371             return ($listRef,$state);
8372            
8373             }
8374            
8375             sub parseFunctionCall
8376             {
8377             my $stringRef = $_[0];
8378             my $state = $_[1];
8379            
8380             my $separator = "\\(";
8381             my ($functionName, $argumentsAndParens ) = split(/$separator/,$$stringRef);
8382            
8383             $separator = "\\)";
8384             my ($arguments ) = split(/$separator/,$argumentsAndParens);
8385            
8386             $separator = ",";
8387             my @list = split(/$separator/,$arguments);
8388            
8389             my @tree = (
8390             $functionName,\@list);
8391            
8392             return (\@tree,"OK");
8393            
8394             }
8395            
8396             sub parseAttributeValuePairs
8397             {
8398             my $pairsRef = $_[0];
8399             my $attributesRef = $_[1];
8400             my %attributeValues = ();
8401            
8402             foreach my $pair (@$pairsRef)
8403             {
8404             my ( $attribute, $value ) = split(/=/,$pair);
8405             $attributeValues{$attribute} = $value;
8406             }
8407            
8408             return ( \%attributeValues,"OK");
8409             }
8410            
8411             sub parseExpressions
8412             {
8413             my $stringRef = \$_[0];
8414             my $state = $_[1];
8415            
8416             my $separator = "\\n|\\s+";
8417            
8418             my (@lines ) = split(/$separator/,$$stringRef);
8419             my @expressions = ();
8420            
8421             my $ArithEnv = new Math::Expression;
8422            
8423             foreach my $rightSide ( @lines)
8424             {
8425            
8426             $rightSide =~ s/^\s*|\s*$//g;
8427            
8428             #Remove equals signs and spaces.
8429             $rightSide =~ s/=|\s+//g;
8430             next if $rightSide eq "";
8431            
8432             my $tree2 = $ArithEnv->Parse($rightSide);
8433            
8434             if ( !ref($tree2) )
8435             {
8436             print "ERROR in right side: $rightSide\n";
8437             }
8438            
8439             push(@expressions,$tree2);
8440             }
8441             return ( \@expressions,"state");
8442            
8443             }
8444            
8445             sub isStatement
8446             {
8447             my $line = $_[0];
8448             my $isStatement = 0;
8449             if ( $line =~ m/IF[\W]|$assignmentOperator|ENDIF|ELSE|EXIT/)
8450             {
8451             $isStatement = 1;
8452             }
8453             return($isStatement);
8454            
8455             }
8456            
8457             sub parseEquations
8458             {
8459             my $stringRef = \$_[0];
8460             my $state = $_[1];
8461            
8462             print STDOUT "In parse equations ", $$stringRef, "\n";
8463            
8464             my (@lines ) = split(/$lineSeparator/,$$stringRef);
8465             my @equations = ();
8466             my $separator = $assignmentOperator;
8467            
8468             my $ArithEnv = new Math::Expression;
8469            
8470             my $conditional = "";
8471             my %forLoop = ();
8472            
8473             foreach ( my $iLine = 0; $iLine < scalar(@lines); $iLine++)
8474             {
8475             my $lineAndComment = $lines[$iLine];
8476            
8477             my ( $line, $comment ) =split($commentCharacter,$lineAndComment);
8478            
8479             next unless defined($line);
8480            
8481             if ( $line =~ /ENDIF/i)
8482             {
8483             $conditional = "";
8484             next;
8485             }
8486             elsif ($line =~ /ELSE/i)
8487             {
8488             $conditional = "NOT\(" . $ conditional . "\)";
8489             next;
8490             }
8491             elsif ($line =~ /EXIT/i)
8492             {
8493             print "Error - Exit not yet handled\n";
8494             next;
8495             }
8496            
8497             if ( $line =~ /\}/i)
8498             {
8499             %forLoop = ();
8500             next;
8501             }
8502            
8503             $line =~ s/^\s*|\s*$//g;
8504            
8505             next unless ( $line =~ /\w/);
8506            
8507             my ( $leftSide, $rightSide ) = split($assignmentOperator,$line);
8508             $line=~ m/($assignmentOperator)/;
8509             my $assignmentOperatorUsed = $1;
8510            
8511             while ( my $extraLineAndComment = $lines[$iLine+1] ) #To do: Handle additional comments.
8512             {
8513             last unless ( $extraLineAndComment =~ /[a-zA-Z]/);
8514             my ( $extraLine, $extraComment ) =split($commentCharacter,$extraLineAndComment);
8515             last if &isStatement($extraLine);
8516             $rightSide .= $extraLine;
8517             $iLine++;
8518             }
8519            
8520             if ( $leftSide eq "" or $rightSide eq "" )
8521             {
8522             if ( $leftSide =~ /.*IF\s*\((.*)\)\s*THEN/i)
8523             {
8524             $conditional = $1;
8525             }
8526             elsif ( $leftSide =~ /.*FOR\s*\((.*)\).*/i)
8527             {
8528             my $forLoopConditional = $1;
8529             $forLoop{"conditional"} = $forLoopConditional;
8530             if ( $forLoopConditional =~ /(.*)\s+in\s+(.*)/g)
8531             {
8532             $forLoop{"loopVariable"} = $1;
8533             $forLoop{"setForForLoop"} = $2;
8534             }
8535             else
8536             {
8537             print "Internal error when handling for loop\n";
8538             printTree($stringRef,0,$printHandle,"");
8539             exit;
8540             }
8541             }
8542             elsif ( $leftSide =~ /\w/)
8543             {
8544             print "Note on line: $line -- no equation given in this line, in $$stringRef\n";
8545             #printTree($stringRef,0,$printHandle,"");
8546             }
8547             next;
8548             }
8549            
8550             my $temporaryConditional = 0;
8551             if ( $leftSide =~ /.*IF\s*\((.*)\)(.*)/)
8552             {
8553             $temporaryConditional = 1;
8554             $conditional = $1;
8555             $leftSide = $2;
8556             if ( $leftSide =~ /.*THEN.*/)
8557             {
8558             print "Internal Error:\n";
8559             print $leftSide;
8560             exit;
8561             }
8562             }
8563            
8564             if ( $conditional ne "" )
8565             {
8566             $conditional =~ s/\.GT\./\>/g;
8567             $rightSide = "IF(" . $conditional . ", " . $rightSide . ")";
8568             my $rhsTreeRef = $ArithEnv->Parse($rightSide);
8569             if ( $rhsTreeRef eq "" or ! ( $rhsTreeRef =~ /HASH/))
8570             {
8571             print "Error when handling if-then conditional\n";
8572             exit;
8573             }
8574            
8575             }
8576            
8577             if ( scalar(%forLoop) != 0 )
8578             {
8579             $rightSide = "FORLOOP(" . $forLoop{"loopVariable"} . "," . $forLoop{"setForForLoop"} . "," . $rightSide . ")";
8580             }
8581             if ( $temporaryConditional > 0 )
8582             {
8583             $conditional = "";
8584             }
8585            
8586             my $tree1 = $ArithEnv->Parse($leftSide);
8587             my $tree2 = $ArithEnv->Parse($rightSide);
8588            
8589             if ( ! ref($tree1) )
8590             {
8591             print "ERROR in left side: $line\n";
8592             }
8593             elsif ( !ref($tree2) )
8594             {
8595             print "ERROR in line $line, within right side $rightSide\n";
8596             #Check for use of . without a zero or other number ahead of it.
8597             if ( $rightSide =~ /[^0-9]\./)
8598             {
8599             #rph improve this -- add check for decimal before . in the replacement.
8600            
8601             my $modifiedRightSide = $rightSide;
8602             $modifiedRightSide =~ s/\./ 0\./;
8603             $tree2 = $ArithEnv->Parse($modifiedRightSide);
8604             if ( ! ref ( $tree2 ) )
8605             {
8606             print "Was not able to fix this by prepending a 0 to a decimal point\n";
8607             print $rightSide, "\n";
8608             $tree2 = $rightSide;
8609             }
8610             else
8611             {
8612             print "Believed this was resolved by prepending a 0 to a decimal point\n";
8613             }
8614             }
8615             else
8616             {
8617             #rph improve this -- try anyway.
8618             $rightSide =~ s/\./ 0\./;
8619             $tree2 = $ArithEnv->Parse($rightSide);
8620             if ( ! ref ( $tree2 ) )
8621             {
8622            
8623             }
8624             else
8625             {
8626             print "Believed this was resolved by prepending a 0 to a decimal point\n";
8627             }
8628             }
8629             }
8630            
8631             my %equation =
8632             (
8633             'left' => $tree1,
8634             'right' => $tree2,
8635             'oper' => $assignmentOperatorUsed
8636             );
8637            
8638             push(@equations,\%equation);
8639             }
8640             return ( \@equations, $state);
8641            
8642             }
8643            
8644             sub parseOneCharacterPair
8645             {
8646             my $rightSide = $_[0];
8647             my $leftParens = $_[1];
8648             my $rightParens = $_[2];
8649            
8650             my @leftParensSet = ();
8651             my $iLeftParens = 0;
8652             my @rightParensSet = ();
8653             my $iRightParens = 0;
8654             my @parenthesesLevelLeft = ();
8655             my @parenthesesLevelRight = ();
8656            
8657             my $iLevel = 0;
8658            
8659             my @letters = split("",$rightSide);
8660            
8661             for ( my $i = 0; $i <= $#letters; $i++)
8662             {
8663             my $letter = $letters[$i];
8664             if ( $letter eq $leftParens)
8665             {
8666             $parenthesesLevelLeft[$iLeftParens] = ++$iLevel;
8667             $leftParensSet[$iLeftParens++] = $i;
8668             }
8669             if ( $letter eq $rightParens)
8670             {
8671             $parenthesesLevelRight[$iRightParens] = $iLevel--;
8672             $rightParensSet[$iRightParens++] = $i;
8673             }
8674             }
8675            
8676             my $iRightMatch;
8677             for ($iRightMatch = 0; $iRightMatch <= $#parenthesesLevelRight; $iRightMatch++)
8678             {
8679             last if ( $parenthesesLevelRight[$iRightMatch] == 1);
8680             }
8681            
8682             my $iLocationOfLeftParens = $leftParensSet[0];
8683            
8684             my $iLocationOfRightParens = $rightParensSet[$iRightMatch];
8685            
8686             my $iLength = $iLocationOfRightParens - $iLocationOfLeftParens -1;
8687            
8688             my $firstString = substr($rightSide,0,$iLocationOfLeftParens);
8689             my $middleString = substr($rightSide,$iLocationOfLeftParens+1,$iLength);
8690             my $lastString = substr($rightSide,$iLocationOfRightParens+1);
8691            
8692             my %expressionTree =
8693             (
8694             "left" => $firstString,
8695             "right" => $lastString,
8696             "middle" => $middleString,
8697             "oper" => "Bracket"
8698             );
8699            
8700             my $state = "OK";
8701             return (\%expressionTree,$state);
8702             }
8703            
8704             sub parseOneSetOfCommas
8705             {
8706             my $rightSide = $_[0];
8707            
8708             my @leftParensSet = ();
8709             my $iLeftParens = 0;
8710             my @rightParensSet = ();
8711             my $iRightParens = 0;
8712             my @parenthesesLevelLeft = ();
8713             my @parenthesesLevelRight = ();
8714            
8715             my $iLevel = 0;
8716            
8717             $rightSide =~ s/\s+|^,//g;
8718             my @parts = split(/,/,$rightSide);
8719            
8720             my ($arrayWithValuePairsRef, $state ) = parseAttributeValuePairsInList(\@parts);
8721            
8722             my %expressionTree =
8723             (
8724             "right" => $arrayWithValuePairsRef,
8725             "oper" => "COMMA"
8726             );
8727            
8728             $state = "OK";
8729            
8730             return (\%expressionTree,$state);
8731             }
8732            
8733             sub parseParentheses
8734             {
8735             my $rightSide = $_[0];
8736            
8737             my @leftParensSet = ();
8738             my $iLeftParens = 0;
8739             my @rightParensSet = ();
8740             my $iRightParens = 0;
8741             my @parenthesesLevelLeft = ();
8742             my @parenthesesLevelRight = ();
8743             my @rightParensForLeft = ();
8744             my @firstChildForParens = ();
8745            
8746             my $iLevel = 0;
8747            
8748             my @letters = split("",$rightSide);
8749            
8750             my @lastParensAtThisLevel = ();
8751             my @parentParens = ();
8752             my @nextParensAtThisLevel = ();
8753            
8754             for ( my $i = 0; $i <= $#letters; $i++)
8755             {
8756             my $letter = $letters[$i];
8757             if ( $letter eq $leftParens)
8758             {
8759             $parenthesesLevelLeft[$iLeftParens] = ++$iLevel;
8760             $firstChildForParens[$iLeftParens] = -1;
8761             $lastParensAtThisLevel[$iLeftParens] = -1;
8762             $parentParens[$iLeftParens] = -1;
8763             $nextParensAtThisLevel[$iLeftParens] = -1;
8764             $rightParensForLeft[$iLeftParens] = -1;
8765             $leftParensSet[$iLeftParens++] = $i;
8766            
8767             }
8768             if ( $letter eq $rightParens)
8769             {
8770             $parenthesesLevelRight[$iRightParens] = $iLevel--;
8771             $rightParensSet[$iRightParens++] = $i;
8772             }
8773             }
8774            
8775             for ( my $iParens = 1; $iParens < $iLeftParens; $iParens++)
8776             {
8777             my $iParensLevel1 = $parenthesesLevelLeft[$iParens];
8778             for ( my $iParens2 = $iParens - 1; $iParens2 >= 0; $iParens2--)
8779             {
8780             if ( $parenthesesLevelLeft[$iParens2] == $iParensLevel1 )
8781             {
8782             if ( $nextParensAtThisLevel[$iParens] == -1 )
8783             {
8784             $nextParensAtThisLevel[$iParens2] = $iParens;
8785             if ( $lastParensAtThisLevel[$iParens] == -1)
8786             {
8787             $lastParensAtThisLevel[$iParens] = $iParens2;
8788             #print "stuff: $iParensLevel1, $iParens, $iParens2\n";
8789             last;
8790             }
8791             }
8792             }
8793             elsif ( $parenthesesLevelLeft[$iParens2] < $iParensLevel1 )
8794             {
8795             if ( $parentParens[$iParens] == -1 )
8796             {
8797             $parentParens[$iParens] = $iParens2;
8798             }
8799             if ( $firstChildForParens[$iParens] == -1 )
8800             {
8801             $firstChildForParens[$iParens2] = $iParens;
8802             #$lastParensAtThisLevel[$iParens2] = -1;
8803             }
8804             last;
8805             }
8806             }
8807             }
8808            
8809             for ( my $iParens = 0; $iParens < $iLeftParens; $iParens++ )
8810             {
8811             $iLevel = $parenthesesLevelLeft[$iParens];
8812             my $iLocationForLeft = $leftParensSet[$iParens];
8813             for ( my $iParens2 = 0; $iParens2 < $iRightParens; $iParens2++)
8814             {
8815             my $iRightLocation = $rightParensSet[$iParens2];
8816             if ( $iLevel == $parenthesesLevelRight[$iParens2]
8817             && $rightParensForLeft[$iParens] == -1
8818             && $iRightLocation > $iLocationForLeft )
8819             {
8820             $rightParensForLeft[$iParens] = $iParens2;
8821             }
8822             }
8823             }
8824            
8825             my @trees = ();
8826             my $iTree = 0;
8827             for ( my $iCurrentLevel = 1; $iCurrentLevel <= 1; $iCurrentLevel++ )
8828             {
8829             my @tree = ();
8830            
8831             for ( my $iParens = 0; $iParens <= $#parenthesesLevelLeft; $iParens++ )
8832             {
8833             if ( $iCurrentLevel == $parenthesesLevelLeft[$iParens])
8834             {
8835             my $iLocationRightParens = $rightParensSet[$rightParensForLeft[$iParens]];
8836             #print "$iParens,$rightParensForLeft[$iParens],$rightParensSet[0]\n";
8837             my $iLength = $iLocationRightParens - $leftParensSet[$iParens] - 1;
8838            
8839             my $iParent = $parentParens[$iParens];
8840            
8841             my $iStartForParent = 0;
8842             my $iEndForParent = length($rightSide);
8843            
8844             if ( $iParent > -1 )
8845             {
8846             $iStartForParent = $leftParensSet[$iParent]+1;
8847             $iEndForParent = $rightParensSet[$rightParensForLeft[$iParent]]-1;
8848            
8849             }
8850             if ( $lastParensAtThisLevel[$iParens] > -1 )
8851             {
8852             $iStartForParent = $rightParensSet[$rightParensForLeft[$lastParensAtThisLevel[$iParens]]]+1;
8853             #print "$iCurrentLevel, $iParens, $lastParensAtThisLevel[$iParens], $iStartForParent\n";
8854             }
8855             if ( $nextParensAtThisLevel[$iParens] > -1 )
8856             {
8857             $iEndForParent = $leftParensSet[$nextParensAtThisLevel[$iParens]]-1;
8858             }
8859             my $iStartOfWhatFollows = $iLocationRightParens + 1;
8860            
8861             my $firstString = substr($rightSide,$iStartForParent,$leftParensSet[$iParens]-$iStartForParent);
8862             my $middleString = substr($rightSide,$leftParensSet[$iParens]+1,$iLength);
8863             my $lastString = substr($rightSide,$iStartOfWhatFollows,$iEndForParent-$iStartOfWhatFollows+1);
8864            
8865             my %expressionTree =
8866             (
8867             "left" => $firstString,
8868             "right" => $lastString,
8869             "middle" => $middleString,
8870             "terminal" => $middleString,
8871             "oper" => "PARENS"
8872             );
8873            
8874             push(@tree,\%expressionTree);
8875            
8876             }
8877            
8878             }
8879             $trees[$iTree++] = \@tree;
8880            
8881             }
8882            
8883             my $state = "OK";
8884             return (\@trees,$state);
8885             }
8886            
8887            
8888             sub printTree
8889             {
8890             my $treeRef = $_[0];
8891             my $iTreeLevel = $_[1];
8892             my $temporaryFileHandle = $_[2];
8893             my $title = $_[3];
8894            
8895             if ( $iTreeLevel == 0 )
8896             {
8897             if ( $temporaryFileHandle eq "" )
8898             {
8899             print "Possible error -- no file handle given in printTree\n";
8900             $temporaryFileHandle = *STDOUT;
8901             }
8902             print $temporaryFileHandle "\nStart of tree-------------------------\n";
8903            
8904             if ( defined($title))
8905             {
8906             print $title;
8907             }
8908             }
8909            
8910             if (!ref($treeRef ) )
8911             {
8912             if ( defined($treeRef) )
8913             {
8914             chomp $treeRef;
8915             print $temporaryFileHandle "\n", " " x (4*$iTreeLevel);
8916             print $temporaryFileHandle q('), $treeRef, q(');
8917             }
8918             }
8919             else
8920             {
8921             if ( $treeRef =~ /.*ARRAY.*/)
8922             {
8923             print $temporaryFileHandle "\n", " " x (4*$iTreeLevel);
8924             print $temporaryFileHandle "ARRAY = [";
8925             my $iElement = 0;
8926             foreach my $subTreeRef ( @$treeRef )
8927             {
8928             &printTree($subTreeRef,$iTreeLevel+1,$temporaryFileHandle,"");
8929             print $temporaryFileHandle ",", unless ++$iElement == scalar(@$treeRef);
8930            
8931             }
8932             print $temporaryFileHandle "\n", " " x (4*$iTreeLevel);
8933             print $temporaryFileHandle "]";
8934             }
8935             elsif ( $treeRef =~ /.*CODE.*/)
8936             {
8937             print $temporaryFileHandle &$treeRef;
8938             }
8939             elsif ( $treeRef =~ /.*HASH.*/)
8940             {
8941             my %hashTree = %$treeRef;
8942             print $temporaryFileHandle "\n", " " x (4*($iTreeLevel)), "HASH = (";
8943             foreach my $key ( keys(%hashTree))
8944             {
8945             print $temporaryFileHandle "\n", " " x (4*($iTreeLevel+1));
8946             print $temporaryFileHandle "$key => ";
8947             if (!ref($hashTree{$key} ))
8948             {
8949             if ( defined($hashTree{$key}))
8950             {
8951             print $temporaryFileHandle q('),$hashTree{$key},q(');
8952             }
8953             }
8954             else
8955             {
8956             &printTree($hashTree{$key},$iTreeLevel+1,$temporaryFileHandle,"");
8957             }
8958             }
8959             print $temporaryFileHandle "\n", " " x (4*$iTreeLevel),")";
8960            
8961             }
8962             elsif ($treeRef =~ /.*SCALAR.*/)
8963             {
8964             print $temporaryFileHandle "\n", " " x (4*($iTreeLevel));
8965             if ( defined($$treeRef))
8966             {
8967             print $temporaryFileHandle "$$treeRef";
8968             }
8969             }
8970             else
8971             {
8972             print $temporaryFileHandle "\nError: $treeRef\n";
8973             print STDOUT "\nError: $treeRef\n";
8974             exit;
8975            
8976             }
8977            
8978             }
8979            
8980             if ( $iTreeLevel == 0 )
8981             {
8982             if (defined($title ))
8983             {
8984             print $title;
8985             }
8986             print $temporaryFileHandle "\nEnd of tree-------------------------\n";
8987             }
8988             }
8989            
8990             sub traverseTreeForVectorItemDependencies
8991             {
8992             my $treeRef = $_[0];
8993             my $name = $_[1];
8994             my $iTreeLevel = $_[2];
8995            
8996             if (!ref($treeRef ))
8997             {
8998             ;
8999             }
9000             else
9001             {
9002             if ( $treeRef =~ /.*ARRAY.*/)
9003             {
9004             foreach my $subTreeRef ( @$treeRef )
9005             {
9006             &traverseTreeForVectorItemDependencies($subTreeRef,$name, $iTreeLevel+1);
9007             }
9008             }
9009             elsif ( $treeRef =~ /.*CODE.*/)
9010             {
9011             }
9012             elsif ( $treeRef =~ /.*HASH.*/)
9013             {
9014             my %hashTree = %$treeRef;
9015             foreach my $key ( keys(%hashTree))
9016             {
9017             if (!ref($hashTree{$key} ))
9018             {
9019             my $iScalar = 0;
9020             if ($key eq "oper" && $hashTree{$key} =~ /$assignmentOperator/)
9021             {
9022             my $rightTreeRef = $hashTree{"right"};
9023            
9024            
9025             if ( !ref ($rightTreeRef) )
9026             {
9027             return;
9028             }
9029             my %rightTree = %$rightTreeRef;
9030            
9031             my $leftTreeRef = $hashTree{"left"};
9032             if ( ! ref($leftTreeRef) )
9033             {
9034             return;
9035             }
9036             my %leftTree = %$leftTreeRef;
9037            
9038             print "----------About to call subtree dependencies\n";
9039             my $leftVariableName = $leftTree{"name"};
9040             print $leftVariableName,"\n";
9041             printTree(\%rightTree,0,*STDOUT,"");
9042             print "----------have called subtree dependencies\n";
9043            
9044             checkSubTreeForDependencies(\%rightTree,$name,$leftVariableName);
9045             }
9046            
9047             }
9048             else {
9049             &traverseTreeForVectorItemDependencies($hashTree{$key},$name, $iTreeLevel+1);
9050             }
9051             }
9052             }
9053             elsif ($treeRef =~ /.*SCALAR.*/)
9054             {
9055             ;
9056             }
9057             else
9058             {
9059             print $printHandle "Error: \n";
9060             print $printHandle $treeRef;
9061             exit;
9062             }
9063             }
9064             }
9065            
9066            
9067            
9068             sub traverseTreeParseParentheses
9069             {
9070             my $treeRef = $_[0];
9071             my $name = $_[1];
9072             my $iTreeLevel = $_[2];
9073            
9074             my %hashTreeCopy = ();
9075            
9076             if (!ref($treeRef ))
9077             {
9078             ;
9079             }
9080             else
9081             {
9082             if ( $treeRef =~ /.*ARRAY.*/)
9083             {
9084             foreach my $subTreeRef ( @$treeRef )
9085             {
9086             &traverseTreeParseParentheses($subTreeRef,$name, $iTreeLevel+1);
9087             }
9088             }
9089             elsif ( $treeRef =~ /.*CODE.*/)
9090             {
9091             }
9092             elsif ( $treeRef =~ /.*HASH.*/)
9093             {
9094             %hashTreeCopy = %$treeRef;
9095             foreach my $key ( keys(%hashTreeCopy))
9096             {
9097             if (!ref($hashTreeCopy{$key} ))
9098             {
9099             my $iScalar = 0;
9100             if ($key eq "oper" && $hashTreeCopy{$key} eq "PARENS")
9101             {
9102             my $terminalExpression = $hashTreeCopy{"terminal"};
9103             $hashTreeCopy{"terminal"} = "";
9104             my $separator = ",";
9105             ($hashTreeCopy{"middle"},$state) = parseList(\$terminalExpression,$separator);
9106             %$treeRef = %hashTreeCopy;
9107             }
9108             }
9109             else
9110             {
9111             &traverseTreeParseParentheses($hashTreeCopy{$key},$name, $iTreeLevel+1);
9112             }
9113             }
9114             } else {
9115             print $printHandle "Error: \n";
9116             print $printHandle $treeRef;
9117             exit;
9118             }
9119             }
9120            
9121             }
9122            
9123             sub storeLHSVariableDerivation
9124             {
9125             my $name = $_[0];
9126             my $iScalar = $_[1];
9127             my $leftVariableName = $_[2];
9128            
9129             #Reverse table is here:
9130             my $reverseDerivationsForThisVariableRef = $reverseDerivationsForVariables{$leftVariableName};
9131             my %reverseDerivationsForThisVariable = ();
9132             if ( ! ref ( $reverseDerivationsForThisVariableRef ) )
9133             {
9134             $reverseDerivationsForVariables{$leftVariableName} = \%reverseDerivationsForThisVariable;
9135             }
9136             else
9137             {
9138             %reverseDerivationsForThisVariable = %$reverseDerivationsForThisVariableRef;
9139             }
9140            
9141             $reverseDerivationsForThisVariable{$name . $iScalar} = $reverseDerivationsForThisVariable{$name . $iScalar} + 1;
9142            
9143             $reverseDerivationsForVariables{$leftVariableName} = \%reverseDerivationsForThisVariable;
9144            
9145             print "=------------------------------------\n";
9146             print $leftVariableName, "\n";
9147             printTree(\%reverseDerivationsForVariables,0,*STDOUT,"");
9148             print "=------------------------------------\n";
9149            
9150             }
9151            
9152             sub storeVariableDerivation
9153             {
9154             my $name = $_[0];
9155             my $iScalar = $_[1];
9156             my $leftVariableName = $_[2];
9157            
9158             print "=------------------------------------\n";
9159             print $leftVariableName, $name, $iScalar, "\n";
9160             printTree(\%reverseDerivationsForVariables,0,*STDOUT,"");
9161             print "=------------------------------------\n";
9162            
9163             my $derivationsForThisVariableRef = $derivationsForVariables{$name};
9164             my %derivationsForThisVariable;
9165             if ( ! ref ( $derivationsForThisVariableRef ) )
9166             {
9167             %derivationsForThisVariable = ();
9168             $derivationsForVariables{$name} = \%derivationsForThisVariable;
9169             }
9170             else
9171             {
9172             %derivationsForThisVariable = %$derivationsForThisVariableRef;
9173             }
9174            
9175             $derivationsForThisVariable{$iScalar} = $leftVariableName;
9176             $derivationsForVariables{$name} = \%derivationsForThisVariable;
9177            
9178             }
9179            
9180             sub checkSubTreeForDependencies
9181             {
9182             my %hashTree = %{$_[0]};
9183             my $name = $_[1];
9184             my $leftVariableName = $_[2];
9185            
9186             my $iScalar = 0;
9187            
9188             if ( defined($hashTree{"fname"}) && ( $hashTree{"fname"} eq $name ) )
9189             {
9190            
9191             my %rightRightTree = %{$hashTree{"right"}};
9192             if ( $rightRightTree{"oper"} eq "const" )
9193             {
9194             my $iScalar = $rightRightTree{"val"};
9195             storeVariableDerivation($name,$iScalar,$leftVariableName);
9196             }
9197             elsif ( $rightRightTree{"oper"} eq "var" )
9198             {
9199             my $iScalar = $rightRightTree{"val"};
9200             if ( $iScalar =~ /^\d$/)
9201             {
9202             storeVariableDerivation($name,$iScalar,$leftVariableName);
9203             }
9204             }
9205            
9206             }
9207            
9208             my $nameVariable = $hashTree{"name"};
9209             if ( $hashTree{"oper"} eq "var" && $nameVariable =~ /$name\d+/ )
9210             {
9211            
9212             my $iScalar = substr($nameVariable,-1); #hack -- only 1-9 supported.
9213             if ( $iScalar =~ /^\d$/)
9214             {
9215             storeVariableDerivation($name,$iScalar,$leftVariableName);
9216             }
9217            
9218             }
9219            
9220             my $goMoreThanOneLevelDeep = 1;
9221            
9222             if ( $goMoreThanOneLevelDeep )
9223             {
9224             #-------------------------------Handle subtrees----------------------
9225             if ( ref( $hashTree{"left"} ))
9226             {
9227             $iScalar = checkSubTreeForDependencies($hashTree{"left"},$name,$leftVariableName);
9228             }
9229             if ( ref( $hashTree{"right"}))
9230             {
9231             $iScalar = checkSubTreeForDependencies($hashTree{"right"},$name,$leftVariableName);
9232             }
9233             #-------------------------------andle subtrees------------------------
9234            
9235             }
9236            
9237             return $iScalar;
9238            
9239            
9240             }
9241            
9242             sub replaceUseOfVectorWithScalar
9243             {
9244             my %hashTree = %{$_[0]};
9245             my $name = $_[1];
9246            
9247             my $iScalar = 0;
9248             my %tree = %hashTree;
9249            
9250             if ( ref($hashTree{"right"} ) )
9251             {
9252             my %rightRightTree = %{$hashTree{"right"}};
9253             if ( $rightRightTree{"oper"} eq "const" )
9254             {
9255             $iScalar = $rightRightTree{"val"};
9256             %tree = (
9257             'oper' => 'var',
9258             'name' => $name . $iScalar
9259             );
9260             }
9261             }
9262             else
9263             {
9264             my $nameToExamine = $hashTree{"name"};
9265             $nameToExamine =~ s/\(|\)|\[|\]//g;
9266             %tree = (
9267             'oper' => 'var',
9268             'name' => $nameToExamine
9269             );
9270            
9271             }
9272            
9273            
9274             return (\%tree,"OK");
9275            
9276             }
9277            
9278             sub replaceUseOfFunctionWithScalar
9279             {
9280             my %hashTree = %{$_[0]};
9281             my $name = $_[1];
9282            
9283             my $iScalar = 0;
9284             my %tree = %hashTree;
9285            
9286             if ( ref($hashTree{"right"} ) )
9287             {
9288             my %rightRightTree = %{$hashTree{"right"}};
9289             if ( $rightRightTree{"oper"} eq "var" )
9290             {
9291             $iScalar = $rightRightTree{"name"};
9292             %tree = (
9293             'oper' => 'var',
9294             'name' => $name . $iScalar
9295             );
9296             }
9297            
9298             }
9299             else
9300             {
9301             my $nameToExamine = $hashTree{"name"};
9302             $nameToExamine =~ s/\(|\)|\[|\]//g;
9303             %tree = (
9304             'oper' => 'var',
9305             'name' => $nameToExamine
9306             );
9307            
9308             }
9309            
9310            
9311             return (\%tree,"OK");
9312            
9313             }
9314            
9315             sub renameFunction
9316             {
9317             my %hashTree = %{$_[0]};
9318             my $name = $_[1];
9319            
9320             my $iScalar = 0;
9321            
9322             $improveThis = 1; #a is hardwired.
9323             if ( $hashTree{"fname"} eq $name )
9324             {
9325             $hashTree{"fname"} = "A";
9326             }
9327            
9328             return (\%hashTree,"OK");
9329            
9330             }
9331            
9332            
9333             sub parseINPUT
9334             {
9335             my $string = $_[0];
9336            
9337             my $separator = "\\s+|\\n";
9338             my ($ref,$state) = parseList(\$string,$separator);
9339             return ($ref,"INPUT");
9340            
9341             }
9342            
9343             sub parseEST
9344             {
9345             my $string = $_[0];
9346            
9347             my $separator = ",|\\n";
9348             my ($ref,$state) = parseList(\$string,$separator);
9349            
9350            
9351             return ($ref,"EST");
9352            
9353             }
9354            
9355             sub parseCOVA
9356             {
9357             my $string = $_[0];
9358            
9359             my $separator = ",";
9360             my ($ref,$state) = parseList(\$string,$separator);
9361             return ($ref,"INPUT");
9362            
9363             }
9364            
9365            
9366             sub parseTAB
9367             {
9368             my $string = $_[0];
9369            
9370             my ($ref, $state) = parseLinesOfLists($string);
9371            
9372             return ($ref,"TAB");
9373            
9374             }
9375            
9376            
9377             sub modifyTree
9378             {
9379             my $treeRef = $_[0];
9380             my $filterFunctionRef = $_[1];
9381             my $functionRef = $_[2];
9382             my $char1 = $_[3];
9383             my $char2 = $_[4];
9384             my $iTreeLevel = $_[5];
9385             my $iTotalLevels = $_[6];
9386             my $justModifyRightSide = $_[7];
9387            
9388             my @results = ();
9389            
9390             $iTreeLevel++;
9391            
9392             if ( $iTreeLevel > $iTotalLevels )
9393             {
9394             return ($treeRef,"complete");
9395             }
9396            
9397             if ( 0 )
9398             {
9399             open(DOG,">>dog.txt" );
9400             print DOG "-------------TO START---------------------\n";
9401             printTree($treeRef,0,*DOG,"");
9402             print DOG "-------------END START---------------------\n";
9403            
9404             close(DOG);
9405             }
9406            
9407             my @treeArray;
9408             my %tree;
9409            
9410             my $valuesRef = "";
9411            
9412             if ( !ref($treeRef) )
9413             {
9414             if ( &$filterFunctionRef($treeRef,$char1,$char2))
9415             {
9416             ($treeRef,$state) = &$functionRef($treeRef,$char1,$char2);
9417             ($treeRef,$state) = modifyTree($treeRef,$filterFunctionRef, $functionRef,$char1,$char2,$iTreeLevel,$iTotalLevels,$justModifyRightSide);
9418             }
9419             }
9420             else
9421             {
9422             if ( $treeRef =~ /.*ARRAY.*/)
9423             {
9424             if ( &$filterFunctionRef($treeRef,$char1,$char2))
9425             {
9426             ($treeRef,$state) = &$functionRef($treeRef,$char1,$char2);
9427             }
9428             my $iElement = 0;
9429             if ( ref($treeRef) && $treeRef =~ /ARRAY/)
9430             {
9431             @treeArray = @$treeRef;
9432             foreach my $subTreeRef ( @treeArray )
9433             {
9434             if ( &$filterFunctionRef($subTreeRef,$char1,$char2))
9435             {
9436             ($subTreeRef,$state) = &$functionRef($subTreeRef,$char1,$char2);
9437             }
9438             elsif ( ref($subTreeRef ))
9439             {
9440             ($subTreeRef,$state) = &modifyTree($subTreeRef,$filterFunctionRef, $functionRef,$char1,$char2,$iTreeLevel,$iTotalLevels,$justModifyRightSide);
9441             }
9442             $treeArray[$iElement++] = $subTreeRef;
9443             }
9444             $treeRef = \@treeArray;
9445             }
9446             }
9447             elsif ( $treeRef =~ /.*CODE.*/)
9448             {
9449            
9450             }
9451             elsif ( $treeRef =~ /.*HASH.*/)
9452             {
9453             my $iElement = 0;
9454             %tree = %$treeRef;
9455             foreach my $key ( keys(%tree) )
9456             {
9457             my $subTreeRef = $tree{$key};
9458            
9459             if ( $justModifyRightSide )
9460             {
9461             if ( $tree{"oper"} eq "=" && $key eq "left" )
9462             {
9463             next;
9464             }
9465             }
9466            
9467             if ( &$filterFunctionRef($subTreeRef,$char1,$char2))
9468             {
9469             ($subTreeRef,$state) = &$functionRef($subTreeRef,$char1, $char2);
9470             ($subTreeRef,$state) = modifyTree($subTreeRef,$filterFunctionRef, $functionRef,$char1, $char2,$iTreeLevel,$iTotalLevels,$justModifyRightSide);
9471             }
9472             elsif ( ref($subTreeRef))
9473             {
9474             ($subTreeRef, $state ) = &modifyTree($subTreeRef,$filterFunctionRef, $functionRef,$char1, $char2,$iTreeLevel,$iTotalLevels,$justModifyRightSide);
9475             }
9476             $tree{$key} = $subTreeRef;
9477             }
9478             $treeRef = \%tree;
9479             }
9480             elsif ($treeRef =~ /.*SCALAR.*/)
9481             {
9482             if ( &$filterFunctionRef($treeRef,$char1,$char2))
9483             {
9484             ($treeRef,$state) = &$functionRef($treeRef,$char1, $char2);
9485             ($treeRef,$state) = modifyTree($treeRef,$filterFunctionRef, $functionRef, $char1, $char2,$iTreeLevel,$iTotalLevels,$justModifyRightSide);
9486             }
9487             }
9488             else
9489             {
9490             print $printHandle "Error: \n";
9491             print $printHandle $treeRef;
9492             printTree($treeRef,0,$printHandle,"");
9493             exit;
9494             }
9495             }
9496            
9497             $iTreeLevel--;
9498            
9499             if ( 0 )
9500             {
9501             open(DOG,">>dog.txt" );
9502             print DOG "-------------NOW DONE---------------------\n";
9503             printTree($treeRef,0,*DOG,"");
9504             print DOG "-------------END DONE---------------------\n";
9505            
9506             close(DOG);
9507             }
9508            
9509             return ($treeRef,"OK");
9510             }
9511            
9512             sub getInfoFromTree
9513             {
9514             my $treeRef = $_[0];
9515             my $tagsRef = $_[1];
9516             if ( ! ref ( $tagsRef ) || (! ( $tagsRef =~ /HASH/)) )
9517             {
9518             print "Error in getInfoFromTree\n";
9519             printTree($globalASTRef,0,*STDOUT,"\nGlobal Tree\n");
9520             printTree($treeRef,0,*STDOUT,"\nLocal Tree\n");
9521             print $tagsRef, "\n";
9522             exit;
9523             }
9524             my %tags = %{$_[1]};
9525             my $iTreeLevel = $_[2];
9526            
9527             my $label = $tags{"label"};
9528             my $functionRef = $tags{"routine"};
9529            
9530             my $valuesString;
9531            
9532             if (!ref($treeRef ))
9533             {
9534             }
9535             else
9536             {
9537             if ( $treeRef =~ /.*ARRAY.*/)
9538             {
9539             my $iElement = 0;
9540             foreach my $subTreeRef ( @$treeRef )
9541             {
9542             my ($valuesStringTemp, $state) = getInfoFromTree($subTreeRef,\%tags, $iTreeLevel+1);
9543             if ( defined($valuesStringTemp))
9544             {
9545             if ( ref($valuesStringTemp) && $valuesStringTemp =~ /HASH/)
9546             {
9547             $valuesString = $valuesStringTemp;
9548             }
9549             else
9550             {
9551             $valuesString .= $valuesStringTemp;
9552             }
9553             }
9554             }
9555             }
9556             elsif ( $treeRef =~ /.*CODE.*/)
9557             {
9558             }
9559             elsif ( $treeRef =~ /.*HASH.*/)
9560             {
9561             my %hashTree = %$treeRef;
9562             foreach my $key ( keys(%hashTree))
9563             {
9564             if ( $key eq $label )
9565             {
9566             my ($valuesStringTemp,$state) = &$functionRef($hashTree{$key},\%tags,$iTreeLevel+1);
9567             if ( defined($valuesStringTemp ) )
9568             {
9569             if ( ref($valuesStringTemp) && $valuesStringTemp =~ /HASH/)
9570             {
9571             $valuesString = $valuesStringTemp;
9572             }
9573             else
9574             {
9575             $valuesString .= $valuesStringTemp;
9576             }
9577             }
9578             }
9579             if (!ref($hashTree{$key} ))
9580             {
9581             }
9582             else
9583             {
9584             my ($valuesStringTemp, $state) = getInfoFromTree($hashTree{$key},\%tags,$iTreeLevel+1);
9585             if ( defined($valuesStringTemp))
9586             {
9587             if ( ref($valuesStringTemp) && $valuesStringTemp =~ /HASH/)
9588             {
9589             $valuesString = $valuesStringTemp;
9590             }
9591             else
9592             {
9593             $valuesString .= $valuesStringTemp;
9594             }
9595             }
9596             }
9597             }
9598             }
9599             elsif ( $treeRef =~ /.*SCALAR.*/)
9600             {
9601             ;
9602             }
9603             else
9604             {
9605             print $printHandle "Error: \n";
9606             print $printHandle $treeRef;
9607             printTree($treeRef,0,$printHandle,"");
9608             exit;
9609             }
9610             }
9611            
9612             return ($valuesString,"OK");
9613             }
9614            
9615             sub getArrayOfInfoFromTree
9616             {
9617             my $treeRef = $_[0];
9618             my %tags = %{$_[1]};
9619             my $iTreeLevel = $_[2];
9620            
9621             my $label = $tags{"label"};
9622             my $functionRef = $tags{"routine"};
9623            
9624             my @arrayOfInfo = ();
9625            
9626             if (!ref($treeRef ))
9627             {
9628             }
9629             else
9630             {
9631             if ( $treeRef =~ /.*ARRAY.*/)
9632             {
9633             my $iElement = 0;
9634             foreach my $subTreeRef ( @$treeRef )
9635             {
9636             my ($arrayOfInfoRefTemp,$state) = &$functionRef($subTreeRef,\%tags,$iTreeLevel+1);
9637             if ( $arrayOfInfoRefTemp =~ /ARRAY/)
9638             {
9639             push(@arrayOfInfo, @$arrayOfInfoRefTemp);
9640             }
9641             elsif ( $arrayOfInfoRefTemp =~ /\w/ )
9642             {
9643             push(@arrayOfInfo, $arrayOfInfoRefTemp);
9644             }
9645            
9646             ($arrayOfInfoRefTemp, $state) = getArrayOfInfoFromTree($subTreeRef,\%tags, $iTreeLevel+1);
9647             if ( $arrayOfInfoRefTemp =~ /ARRAY/)
9648             {
9649             push(@arrayOfInfo, @$arrayOfInfoRefTemp);
9650             }
9651             elsif ( $arrayOfInfoRefTemp =~ /\w/ )
9652             {
9653             push(@arrayOfInfo, $arrayOfInfoRefTemp);
9654             }
9655            
9656             }
9657             }
9658             elsif ( $treeRef =~ /.*CODE.*/)
9659             {
9660             }
9661             elsif ( $treeRef =~ /.*HASH.*/)
9662             {
9663             my %hashTree = %$treeRef;
9664             foreach my $key ( keys(%hashTree))
9665             {
9666             my ($arrayOfInfoRefTemp,$state) = &$functionRef($hashTree{$key},\%tags,$iTreeLevel+1);
9667             if ( $arrayOfInfoRefTemp =~ /ARRAY/)
9668             {
9669             push(@arrayOfInfo, @$arrayOfInfoRefTemp);
9670             }
9671             elsif ( $arrayOfInfoRefTemp =~ /\w/ )
9672             {
9673             push(@arrayOfInfo, $arrayOfInfoRefTemp);
9674             }
9675            
9676             if (!ref($hashTree{$key} ))
9677             {
9678             }
9679             else
9680             {
9681             my ($arrayOfInfoRefTemp, $state) = getArrayOfInfoFromTree($hashTree{$key},\%tags,$iTreeLevel+1);
9682             if ( $arrayOfInfoRefTemp =~ /ARRAY/)
9683             {
9684             push(@arrayOfInfo, @$arrayOfInfoRefTemp);
9685             }
9686             elsif ( $arrayOfInfoRefTemp =~ /\w/ )
9687             {
9688             push(@arrayOfInfo, $arrayOfInfoRefTemp);
9689             }
9690             }
9691             }
9692             }
9693             elsif ( $treeRef =~ /.*SCALAR.*/)
9694             {
9695             ;
9696             }
9697             else
9698             {
9699             print $printHandle "Error: \n";
9700             print $printHandle $treeRef;
9701             printTree($treeRef,0,$printHandle,"");
9702             exit;
9703             }
9704             }
9705            
9706             if ( 0 && scalar(@arrayOfInfo) )
9707             {
9708             printTree(\@arrayOfInfo,0,*STDOUT,"");
9709             }
9710            
9711             return (\@arrayOfInfo,"OK");
9712             }
9713            
9714             sub getHashOfInfoFromTree
9715             {
9716             my $treeRef = $_[0];
9717             my %tags = %{$_[1]};
9718             my $iTreeLevel = $_[2];
9719             my $hashRef = $_[3];
9720            
9721             my $label = $tags{"label"};
9722             my $functionRef = $tags{"routine"};
9723            
9724             my @arrayOfInfo = ();
9725            
9726             if (ref($treeRef ))
9727             {
9728             if ( $treeRef =~ /.*ARRAY.*/)
9729             {
9730             my $iElement = 0;
9731             foreach my $subTreeRef ( @$treeRef )
9732             {
9733             my $state = "";
9734             ($hashRef,$state) = &$functionRef($subTreeRef,\%tags,$iTreeLevel+1,$hashRef);
9735             ($hashRef, $state) = getHashOfInfoFromTree($subTreeRef,\%tags, $iTreeLevel+1,$hashRef);
9736            
9737             }
9738             }
9739             elsif ( $treeRef =~ /.*HASH.*/)
9740             {
9741             my %hashTree = %$treeRef;
9742             foreach my $key ( keys(%hashTree))
9743             {
9744             my $state = "";
9745             ($hashRef,$state) = &$functionRef($hashTree{$key},\%tags,$iTreeLevel+1,$hashRef);
9746            
9747             if (ref($hashTree{$key} ))
9748             {
9749             ($hashRef, $state) = getHashOfInfoFromTree($hashTree{$key},\%tags,$iTreeLevel+1,$hashRef);
9750             }
9751             }
9752             }
9753             }
9754             return ($hashRef,"OK");
9755             }
9756            
9757             sub fillInArrayOfInfoFromTree
9758             {
9759             my $treeRef = $_[0];
9760             my %tags = %{$_[1]};
9761             my $arrayOfInfoRef = $_[2];
9762             my $iTreeLevel = $_[3];
9763            
9764             my $label = $tags{"label"};
9765             my $functionRef = $tags{"routine"};
9766             my $state = "OK";
9767            
9768             if (!ref($treeRef ))
9769             {
9770             }
9771             else
9772             {
9773             if ( $treeRef =~ /.*ARRAY.*/)
9774             {
9775             my $iElement = 0;
9776             foreach my $subTreeRef ( @$treeRef )
9777             {
9778             ($arrayOfInfoRef, $state) = &$functionRef($subTreeRef,\%tags,$arrayOfInfoRef,$iTreeLevel+1);
9779             ($arrayOfInfoRef, $state) = fillInArrayOfInfoFromTree($subTreeRef,\%tags,$arrayOfInfoRef, $iTreeLevel+1);
9780             }
9781             }
9782             elsif ( $treeRef =~ /.*CODE.*/)
9783             {
9784             }
9785             elsif ( $treeRef =~ /.*HASH.*/)
9786             {
9787             my %hashTree = %$treeRef;
9788             foreach my $key ( keys(%hashTree))
9789             {
9790             ($arrayOfInfoRef,$state) = &$functionRef($hashTree{$key},\%tags,$arrayOfInfoRef,$iTreeLevel+1);
9791             if (!ref($hashTree{$key} ))
9792             {
9793             }
9794             else
9795             {
9796             ($arrayOfInfoRef, $state) = fillInArrayOfInfoFromTree($hashTree{$key},\%tags,$arrayOfInfoRef,$iTreeLevel+1);
9797             }
9798             }
9799             }
9800             elsif ( $treeRef =~ /.*SCALAR.*/)
9801             {
9802             ;
9803             }
9804             else
9805             {
9806             print $printHandle "Error: \n";
9807             print $printHandle $treeRef;
9808             printTree($treeRef,0,$printHandle,"");
9809             exit;
9810             }
9811             }
9812            
9813             return ($arrayOfInfoRef,"OK");
9814             }
9815            
9816             sub constructObservationFunctions
9817             {
9818             my ( $stateVariablesRef, $pkScaleFactors ) = @_;
9819            
9820             my %observationFunctions = ();
9821            
9822             my $stateVariables = "";
9823             if ( ref($stateVariablesRef ))
9824             {
9825             $stateVariables = $$stateVariablesRef;
9826             }
9827             else
9828             {
9829             $stateVariables = $stateVariablesRef; #$improveThis =1; #should pass in always as ref.
9830             }
9831            
9832             my @states = split(/,/,$stateVariables);
9833             my @pkScaleFactors = split(/,/,$pkScaleFactors);
9834            
9835             my $iStateNumber = 1;
9836             my $iDefaultObservation = 1; #hack rph **************************************** 2008/01/22
9837            
9838             $pkScaleFactors =~ s/S/V/g;
9839             for ( my $i = 1; $i <= scalar(@states); $i++ )
9840             {
9841             my $stateVariable = "F" . $iStateNumber;
9842             $observationFunctions{$stateVariable} = "$states[$i-1]\/V$i";
9843             if ( $iStateNumber == $iDefaultObservation )
9844             {
9845             $observationFunctions{"F"} = "$states[$i-1]\/V ;\#Default Observation(should duplicate another)";
9846             }
9847             $iStateNumber++;
9848             }
9849            
9850             return ( \%observationFunctions);
9851            
9852             }
9853            
9854             sub constructPriorsForThetas
9855             {
9856             my ($arraysOfBoundsRef, $exponentialDependenciesRef ) = @_;
9857            
9858             my %arraysOfBounds = %$arraysOfBoundsRef;
9859             my %exponentialDependencies = %$exponentialDependenciesRef;
9860            
9861             my $priorsString = "";
9862            
9863             my $defaultMean = "0.0";
9864             my $defaultPrecision = "0.0001";
9865             my $defaultRange = "100";
9866             my $defaultPositivityConstraint = "";
9867            
9868             my $arrayOfBoundsForThisParameterRef = $arraysOfBounds{"THETA"};
9869            
9870             if ( ref( $arrayOfBoundsForThisParameterRef ) && $arrayOfBoundsForThisParameterRef =~ /ARRAY/)
9871             {
9872             my @derivationsForThetas = @$arrayOfBoundsForThisParameterRef;
9873            
9874             my @expVars;
9875            
9876             for ( my $i = 1; $i <= scalar(@derivationsForThetas); $i++ )
9877             {
9878             my $mean = $defaultMean;
9879             my $precision = $defaultPrecision;
9880             my $range = $defaultRange;
9881             my $pairOfBoundsRef = $derivationsForThetas[$i-1];
9882             if ( ref($pairOfBoundsRef) && $pairOfBoundsRef =~ /ARRAY/)
9883             {
9884             my ($lowValue,$highValue) = @$pairOfBoundsRef;
9885             $range = $highValue - $lowValue;
9886            
9887             if ($range > 0 )
9888             {
9889             $precision = 1/$range;
9890             }
9891             }
9892            
9893             my $positivityConstraint = $defaultPositivityConstraint;
9894            
9895             my $setOfDependenciesRef = $exponentialDependencies{"THETA" . $i};
9896             my @setOfDependencies = @$setOfDependenciesRef;
9897            
9898             $improveThis = 1; #Need to simplify this...
9899             if ( scalar(@setOfDependencies))
9900             {
9901             $mean = "-1.0";
9902             $positivityConstraint = "I(,0)";
9903             }
9904            
9905             $priorsString .= "\ theta[$i] ~ dnorm($mean,$range)$positivityConstraint\n";
9906            
9907             }
9908             }
9909            
9910             return ( $priorsString);
9911            
9912             }
9913            
9914             sub constructPriorsForEtas
9915             {
9916             my ($arraysOfBoundsRef, $exponentialDependenciesRef ) = @_;
9917            
9918             my %arraysOfBounds = %$arraysOfBoundsRef;
9919             my %exponentialDependencies = %$exponentialDependenciesRef;
9920            
9921             my @allPriorsStrings = ();
9922             my $priorsString = "";
9923            
9924             my $defaultMean = "0.0";
9925             my $defaultPrecision = "0.0001";
9926             my $defaultRange = 100;
9927             my $defaultPositivityConstraint = "";
9928            
9929             my $arrayOfBoundsForThisParameterRef = $arraysOfBounds{"ETA"};
9930            
9931             if ( ref( $arrayOfBoundsForThisParameterRef ) && $arrayOfBoundsForThisParameterRef =~ /ARRAY/)
9932             {
9933             my @derivationsForEtas = @$arrayOfBoundsForThisParameterRef;
9934            
9935             my @expVars;
9936            
9937             my $possiblyFixed = $derivationsForEtas[1];
9938             my $isFixed = 0;
9939             if ( $possiblyFixed =~ /FIXED/i)
9940             {
9941             $isFixed = 1;
9942             }
9943            
9944             if ( $isFixed )
9945             {
9946             my $mean = $derivationsForEtas[0];
9947             $priorsString = "Dirac($mean)";
9948             $allPriorsStrings[0] = $priorsString;
9949             }
9950             else
9951             {
9952             for ( my $i = 1; $i <= scalar(@derivationsForEtas); $i++ )
9953             {
9954             my $mean = $defaultMean;
9955             my $precision = $defaultPrecision;
9956             my $range = $defaultRange;
9957             my $positivityConstraint = $defaultPositivityConstraint;
9958            
9959             my $setOfDependenciesRef = $exponentialDependencies{"ETA" . $i};
9960             my @setOfDependencies = @$setOfDependenciesRef;
9961            
9962             $improveThis = 1; #Need to simplify this...
9963             if ( scalar(@setOfDependencies))
9964             {
9965             $mean = "-1.0";
9966             $positivityConstraint = "I(,0)";
9967             }
9968            
9969             $priorsString = "dunif(0,$range)";
9970             $allPriorsStrings[$i - 1 ] = $priorsString;
9971             }
9972             }
9973             }
9974            
9975             return ( \@allPriorsStrings );
9976            
9977             }
9978            
9979             sub removeAnyFunctionDependencies
9980             {
9981             my ( $expressionsList, $variable) = @_;
9982             my @expressions = split(",", $expressionsList);
9983             for ( my $i = 0; $i <= $#expressions; $i++ )
9984             {
9985             $expressions[$i] =~ s/\($variable\)//g;
9986             }
9987             #my @expressionsFinal = map(s/\($variable\)//g,@expressions);
9988             my $expressionsListFinal = join(",",@expressions);
9989             return ( $expressionsListFinal);
9990            
9991             }
9992            
9993             sub writeNonmemFile
9994             {
9995             my $globalASTRef = $_[0];
9996             my $TLCOutputFileName = $_[1];
9997             my $dataFileName = $_[2];
9998            
9999             my $infoString = "";
10000             my $state = "";
10001            
10002             my %processingMethods = (
10003             getLanguageSpecificVersionOfVariable => \&getNonmemVersionOfVariable,
10004             getIfThenExpression => \&getNonmemIfThenExpression,
10005             modifyDifferentialExpression => \&useNonmemDifferentialExpression,
10006             getForLoopExpression => \&getNonmemForLoopExpression,
10007             assignmentOperator => " = "
10008             );
10009            
10010             my $NonmemFileName = $TLCOutputFileName;
10011             $NonmemFileName =~ s/\.TLC/\.NONMEM/ig;
10012            
10013             open(NonmemFILEParseTree,">>$NonmemFileName.parseTree" ) or die("Could not open Nonmem file $NonmemFileName\n");
10014             printTree($globalASTRef,0,*NonmemFILEParseTree,"");
10015             close(NonmemFILEParseTree);
10016            
10017             open(NonmemFILE,">>$NonmemFileName" ) or die("Could not open Nonmem file $NonmemFileName\n");
10018             my $NONMEMFileHandle = *NonmemFILE;
10019             $printHandle = $NONMEMFileHandle;
10020            
10021             my %tags = ( label => "PROBLEM", startTag => "\$PROBLEM ", endTag => "\n", separator => " ", routine => \&getSingleString, subRoutine => \&getMainTagAndValue);
10022             ( $infoString, $state ) = getInfoFromSubTree($globalASTRef,"PROBLEM",\%tags,0);
10023             print $NONMEMFileHandle $infoString;
10024            
10025             %tags = ( label => "INPUT", startTag => "\$INPUT ", endTag => "\n",internalStartTag => "", internalEndTag => "",routine => \&getArrayOfValues, separator => " ",subRoutine => \&getTagAndValueOrHashGeneral);
10026             ( $infoString, $state ) = getInfoFromSubTree($globalASTRef,"INPUT",\%tags, 0);
10027             print $NONMEMFileHandle $infoString;
10028            
10029             %tags = ( label => "DATA", startTag => "\$DATA ", endTag => "\n", routine => \&getArrayOfValues, separator => " ",subRoutine => \&getTagAndValueOrHashGeneral, printHandle => $NONMEMFileHandle );
10030             ( $infoString, $state ) = getInfoFromSubTree($globalASTRef,"DATA",\%tags,0);
10031             print $NONMEMFileHandle $infoString;
10032            
10033             %tags = ( label => "SUBROUTINE", startTag => "\$SUBROUTINE ", endTag => "\n", separator => " ", routine => \&getArrayOfValues,subRoutine => \&getTagAndValueOrHashGeneral, printHandle => $NONMEMFileHandle );
10034             ( $infoString, $state ) = getInfoFromSubTree($globalASTRef,"SUBROUTINE",\%tags,0);
10035             my $subroutineIsDefined = ( $infoString =~ /SUBROUTINE\s+/);
10036            
10037             $improveThis = 1; #make showing model contingent on subroutines.
10038             #%tags = ( label => "MODEL", startTag => "\$MODEL ", endTag => "\n",separator => " ",routine => \&getArrayOfValues, subRoutine => \&getTagAndValueOrExpressionGeneral);
10039             #( $infoString, $state ) = getInfoFromSubTree($globalASTRef,"MODEL",\%tags,0);
10040            
10041             if ( $subroutineIsDefined )
10042             {
10043             #Use ADVAN6 instead, for the time being.
10044             my $replaceSubroutineWithADVAN6 = 1;
10045             if ( $replaceSubroutineWithADVAN6)
10046             {
10047             $infoString = "\$SUBROUTINE ADVAN6 TOL=5\n";
10048             }
10049             print $NONMEMFileHandle $infoString;
10050             }
10051             my $arrayOfModelTreesRef = getSubTree($globalASTRef,"MODEL");
10052            
10053             if ( $arrayOfModelTreesRef ne "" )
10054             {
10055             print $NONMEMFileHandle "\$MODEL\n";
10056             unless ( $arrayOfModelTreesRef =~ /ARRAY/)
10057             {
10058             my $modelString = getExpression($arrayOfModelTreesRef);
10059             print $NONMEMFileHandle "\t$modelString\n";
10060             }
10061             else
10062             {
10063             my @arrayOfModelTrees = @$arrayOfModelTreesRef;
10064             if ( scalar(@arrayOfModelTrees ) > 0 )
10065             {
10066             foreach my $treeRef ( @arrayOfModelTrees )
10067             {
10068             my $modelString = getExpression($treeRef);
10069             print $NONMEMFileHandle "\t$modelString\n";
10070             }
10071             }
10072             }
10073             }
10074            
10075             my %processingMethodsForStateVariables = (
10076             getLanguageSpecificVersionOfVariable => \&getNonmemVersionOfVariable,
10077             getIfThenExpression => \&getNonmemIfThenExpression,
10078             modifyDifferentialExpression => \&useNonmemDifferentialExpression,
10079             assignmentOperator => " = "
10080             );
10081            
10082             my $showComments = 0;
10083            
10084             %tags = ( label => "CATEGORICAL_VARIABLES", startTag => "\;#CATEGORICAL_VARIABLES\n;# ", endTag => "\n", separator => " ", routine => \&getSingleString, subRoutine => \&getMainTagAndValue);
10085             ( $infoString, $state ) = getInfoFromSubTree($globalASTRef,"CATEGORICAL_VARIABLES",\%tags,0);
10086             print $NONMEMFileHandle $infoString if $showComments;
10087            
10088             %tags = ( label => "PK_STATE_VARIABLES", startTag => ";\#PK_STATE_VARIABLES\n;# ", endTag => "\n", separator => " ", routine => \&getSingleString, subRoutine => \&getMainTagAndValue);
10089             ( $infoString, $state ) = getInfoFromSubTree($globalASTRef,"PK_STATE_VARIABLES",\%tags,0);
10090             print $NONMEMFileHandle $infoString if $showComments;
10091            
10092             my $stateVariablesRef = getSubTree($globalASTRef,"PK_STATE_VARIABLES");
10093             my $stateVariables;
10094             if ( ref($stateVariablesRef))
10095             {
10096             $stateVariables = $$stateVariablesRef;
10097             }
10098             else
10099             {
10100             $stateVariables = $stateVariablesRef;
10101             }
10102            
10103             my $parameters = join(",", keys(%variablesWithoutNumericSuffixes));
10104            
10105             $improveThis = 1;
10106             if ( $improveThis )
10107             {
10108             $parameters .= ",ERR1";
10109             }
10110            
10111             my $PKNodeName = "PK";
10112             if ( ! $subroutineIsDefined )
10113             {
10114             $PKNodeName = "PRED";
10115             }
10116             %tags = ( label => "PK", startTag => "\$$PKNodeName\n ", separator => "\n ", endTag => "\n", routine => \&getDifferentialEquations, processingMethods => \%processingMethodsForStateVariables, getLeftRightOrBothSides => 'Both', subRoutine => "" );
10117             my $PKEquations;
10118             ( $PKEquations, $state ) = getInfoFromSubTree($globalASTRef,"PK",\%tags,0);
10119             print $NONMEMFileHandle $PKEquations;
10120            
10121             my $useMaster = 1;
10122             %tags = ( label => "DESMASTER", startTag => "\$DES\n ", separator => "\n ", endTag => "\n", routine => \&getDifferentialEquations, processingMethods => \%processingMethods, getLeftRightOrBothSides => 'Both', subRoutine => "" );
10123             my $DESEquations;
10124             ( $DESEquations, $state ) = getInfoFromSubTree($globalASTRef,"DESMASTER",\%tags,0);
10125            
10126             if ( $subroutineIsDefined )
10127             {
10128             print $NONMEMFileHandle $DESEquations;
10129             }
10130            
10131             my $priorsStringRef = getSubTree($globalASTRef,"PRIORS");
10132             my $priorsString = "";
10133             $improveThis = 1; #check for type here.
10134             if ( ref ($priorsStringRef ) && $priorsStringRef =~ /SCALAR/ )
10135             {
10136             $priorsString = $$priorsStringRef;
10137             my @allPriors = split(/\n/,$priorsString);
10138             my $iTheta = 1;
10139             for ( my $iPrior = 0; $iPrior < scalar(@allPriors); $iPrior++ )
10140             {
10141             my $dist1 = $allPriors[$iPrior];
10142             $dist1 =~ s/dnorm.*//g;
10143             my $limits1 = $allPriors[$iPrior];
10144             $limits1 =~ s/.*\(|\).*//g;
10145             my ( $low, $high ) = split(/,/,$limits1);
10146             $allPriors[$iPrior] = "\; $allPriors[$iPrior] . $dist1 . Dirac(Td$iTheta) $low < Td$iTheta < $high )";
10147             $iTheta++;
10148             }
10149             $priorsString = ";\#PRIORSForBUGS\n" . $priorsString;
10150            
10151             }
10152             $priorsString =~ s/\n^$/\n;\#/g;
10153             print $NONMEMFileHandle $priorsString if $showComments;
10154             print $NONMEMFileHandle ";\#PRIORSForNONMEM THETA[i] ~ Dirac(dx); Use all aspects of data ( ignore no aspects of data )\n" if ( $showComments);
10155             my @priorsStringsForEtas = ();
10156             my $priorsForEtasRef = getSubTree($globalASTRef,"PRIORSForEtas");
10157             if ( ref($priorsForEtasRef) )
10158             {
10159             @priorsStringsForEtas = @$priorsForEtasRef;
10160             }
10161            
10162             my $priorsStringForEtas = "";
10163             for ( my $iLine = 1; $iLine <= scalar(@priorsStringsForEtas); $iLine++)
10164             {
10165             my @distributionForEta = $priorsStringsForEtas[$iLine-1];
10166             $priorsStringForEtas .= "\teta[$iLine] ~ $distributionForEta[0]\n";
10167             }
10168             print $NONMEMFileHandle $priorsStringForEtas if $showComments;
10169            
10170             %processingMethodsForStateVariables = (
10171             getLanguageSpecificVersionOfVariable => \&getNonmemVersionOfVariable,
10172             getIfThenExpression => \&getNonmemIfThenExpression,
10173             modifyDifferentialExpression => \&adaptDifferentialExpressionForStateVariable,
10174             assignmentOperator => " = "
10175             );
10176            
10177             %tags = ( label => "DES", startTag => ";\#VECTOR_FIELD\n;# ", separator => "\n;\# ", endTag => "\n", routine => \&getDifferentialEquations, processingMethods => \%processingMethodsForStateVariables, getLeftRightOrBothSides => 'Right', subRoutine => "" );
10178             my $vectorFieldExpressions;
10179             ( $vectorFieldExpressions, $state ) = getInfoFromSubTree($globalASTRef,"DES",\%tags,0);
10180             print $NONMEMFileHandle $vectorFieldExpressions if $showComments;
10181            
10182             %tags = ( label => "PKScaleFactors", startTag => ";\#SCALE_FACTORS\n;# ", separator => "\n;\# ", endTag => "\n", routine => \&getDifferentialEquations, processingMethods => \%processingMethodsForStateVariables, getLeftRightOrBothSides => 'Left', subRoutine => "" );
10183             my $PKScaleFactors;
10184             ( $PKScaleFactors, $state ) = getInfoFromSubTree($globalASTRef,"PKScaleFactors",\%tags,0);
10185             $PKScaleFactors =~ s/\n\s*\n/\n/g;
10186             print $NONMEMFileHandle $PKScaleFactors if $showComments;
10187            
10188             %tags = ( label => "OBSERVATION_FUNCTIONS", startTag => ";\#OBSERVATION_FUNCTIONS\n;# ", endTag => "\n", separator => "\n;# ", routine => \&getHashOfFunctions, subRoutine => \&getMainTagAndValue);
10189             ( $infoString, $state ) = getInfoFromSubTree($globalASTRef,"OBSERVATION_FUNCTIONS",\%tags,0);
10190             print $NONMEMFileHandle $infoString if $showComments;
10191            
10192             $improveThis = 1;
10193             if ( $improveThis == 1 )
10194             {
10195             #my $outputExpressions =~ s/EXP\(ERR1\)/ERR1/g;
10196             }
10197             %tags = ( label => "ERROR", startTag => ";\#OBSERVATION_VARIABLES\n;# ", separator =>", ", endTag => "\n", routine => \&getDifferentialEquations, processingMethods => \%processingMethods, getLeftRightOrBothSides => 'Left', subRoutine => "" );
10198             my $coStateVariables = "";
10199             ( $coStateVariables, $state ) = getInfoFromSubTree($globalASTRef,"ERROR",\%tags,0);
10200             print $NONMEMFileHandle $coStateVariables if $showComments;
10201            
10202             my $inputVariables = "";
10203            
10204             print $NONMEMFileHandle <
10205             NonmemPart1
10206            
10207             %processingMethods = (
10208             getLanguageSpecificVersionOfVariable => \&getNonmemVersionOfVariable,
10209             getIfThenExpression => \&getNonmemIfThenExpression
10210             );
10211            
10212             #%tags = ( label => "DES", startTag => "DES", separator =>", ", endTag => "", routine => \&getDifferentialEquations, processingMethods => \%processingMethodsForStateVariables, getLeftRightOrBothSides => 'Both', subRoutine => "" );
10213             #my ( $differentialEquations, $state ) = getInfoFromSubTree($globalASTRef,"DES",\%tags,0);
10214             #print $NONMEMFileHandle $differentialEquations, "\n";
10215            
10216             my $allVariables = $stateVariables . ",extra," . $parameters;
10217            
10218             %tags = ( label => "ERROR", startTag => "\$ERROR\n ", separator =>"\n ", endTag => "\n",routine => \&getDifferentialEquations, processingMethods => \%processingMethods, subRoutine => \&dummy );
10219             ( $infoString, $state ) = getInfoFromSubTree($globalASTRef,"ERROR",\%tags,0);
10220             my $hasErrorString = $infoString =~ /ERROR\s+\w/;
10221             if ( $hasErrorString)
10222             {
10223             print $printHandle $infoString;
10224             }
10225            
10226             %tags = ( label => "THETA", startTag => "\$THETA\n ", separator =>"\n ", endTag => "\n", routine => \&getHashOfArrayOfValuesInParentheses, subRoutine => \&getThetaGeneral );
10227             ( $infoString, $state ) = getInfoFromSubTree($globalASTRef,"THETA",\%tags,0);
10228             print $printHandle $infoString;
10229            
10230             %tags = ( label => "ETA", startTag => "\$OMEGA ", separator =>" ", endTag => "\n", routine => \&getHashOfArrayOfValues, subRoutine => \&getOmegaInitialValuesGeneral );
10231             ( $infoString, $state ) = getInfoFromSubTree($globalASTRef,"ETA",\%tags,0);
10232             print $printHandle $infoString;
10233            
10234             %tags = ( label => "SIGMA", startTag => "\$SIGMA ", separator =>" ", endTag => "\n",routine => \&getHashOfArrayOfValues, subRoutine => \&getOmegaInitialValuesGeneral );
10235             ( $infoString, $state ) = getInfoFromSubTree($globalASTRef,"SIGMA",\%tags,0);
10236             my $hasSigmaString = $infoString =~ /SIGMA\s+\w/;
10237             if ( $hasSigmaString )
10238             {
10239             print $printHandle $infoString;
10240             }
10241            
10242             %tags = ( label => "TABLE", startTag => "\$TABLE ", endTag => "\n", separator => ' ', routine => \&getHashOfArrayOfValues, subRoutine => \&getTagAndValueOrHashGeneral );
10243             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
10244             print $printHandle $infoString;
10245            
10246             %tags = ( label => "COVA", startTag => "\$COVA ", endTag => "\n", routine => \&getArrayOfValues, subRoutine => \&getTagAndValueOrHashGeneral );
10247             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
10248             print $printHandle $infoString;
10249            
10250             %tags = ( label => "ESTIMATION", startTag => "\$EST ", endTag => "\n", separator => ' ', routine => \&getArrayOfValues, subRoutine => \&getTagAndValueOrHashGeneral );
10251             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
10252             print $printHandle $infoString;
10253            
10254             %tags = ( label => "SCAT", startTag => "\$SCAT ", endTag => "\n", routine => \&getArrayOfValues, subRoutine => \&getTagAndValueOrHashGeneral );
10255             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
10256             print $printHandle $infoString;
10257            
10258             close($NONMEMFileHandle);
10259            
10260             }
10261            
10262            
10263             sub writeAsAlgebraicTheory
10264             {
10265             my $globalASTRef = $_[0];
10266             my $TLCOutputFileName = $_[1];
10267             my $dataFileName = $_[2];
10268            
10269             my %processingMethods = (
10270             getLanguageSpecificVersionOfVariable => \&getNonmemVersionOfVariable,
10271             getIfThenExpression => \&getMapleIfThenExpression,
10272             modifyDifferentialExpression => \&useNonmemDifferentialExpression,
10273             getForLoopExpression => \&getNonmemForLoopExpression,
10274             assignmentOperator => " = "
10275             );
10276            
10277             my $AlgebraicTheoryName = $TLCOutputFileName;
10278             #$AlgebraicTheoryName =~ s/\.TLC/\.AlgebraicTheory/ig;
10279            
10280             open(AlgebraicTheory,">$AlgebraicTheoryName" ) or die("Could not open AlgebraicTheory file $AlgebraicTheoryName\n");
10281             my $AlgebraicTheoryHandle = *AlgebraicTheory;
10282             $printHandle = *$AlgebraicTheoryHandle;
10283            
10284             my $modelNameFromFileRef = getSubTree($globalASTRef,"MODEL_NAME_FROM_FILE");
10285             my $modelNameFromFile = $$modelNameFromFileRef;
10286             my $infoStringForModelNameFromFile = "ModelName:ModelNames=$modelNameFromFile";
10287             print $AlgebraicTheoryHandle $infoStringForModelNameFromFile,"\n";
10288            
10289             my $regularizedModelNameRef = getSubTree($globalASTRef,"REGULARIZED_MODEL_NAME");
10290             my $regularizedModelName = $$regularizedModelNameRef;
10291             my $infoStringForModelName = "ModelName:ModelNames=$regularizedModelName";
10292             print $AlgebraicTheoryHandle $infoStringForModelName,"\n";
10293            
10294             my $routingRef = getSubTree($globalASTRef,"ROUTING");
10295             my $routing = $$routingRef;
10296             my $infoStringForRouting = "Routing:RoutingTypes=$routing";
10297             print $AlgebraicTheoryHandle $infoStringForRouting,"\n";
10298            
10299             my $dosingRef = getSubTree($globalASTRef,"DOSING");
10300             my $dosing = $$dosingRef;
10301             my $infoStringForDosing = "Dosing:DosingTypes=$dosing";
10302             print $AlgebraicTheoryHandle $infoStringForDosing,"\n";
10303            
10304             my $arrayOfPKNamesRef = getSubTree($globalASTRef,"PK_VARIABLE_NAMES_ORIGINAL");
10305             my $infoStringForPKNames = getPKVariableNames($arrayOfPKNamesRef);
10306             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($infoStringForPKNames);
10307            
10308             my $arrayOfPKNamesOriginalRef = getSubTree($globalASTRef,"PK_VARIABLE_NAMES");
10309            
10310             my $infoString;
10311             $infoString = getPKVariableNamesOriginal($arrayOfPKNamesOriginalRef);
10312             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($infoString);
10313            
10314             my $dependenciesOnVectorsRef = getSubTree($globalASTRef,"VECTOR_VARIABLE_DEPENDENCIES");
10315            
10316             #improve this -- use data already in the global syntax tree.
10317             my $defaultPrefix = 'tv';
10318             $infoString = getPKVariableNamesAsNTuple($dependenciesOnVectorsRef, "THETA", $arrayOfPKNamesRef, $defaultPrefix );
10319             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($infoString);
10320            
10321             #improve this -- may not work on complex problems.
10322             $defaultPrefix = 'n';
10323             $infoString = getPKVariableNamesAsNTuple($dependenciesOnVectorsRef, "ETA", $arrayOfPKNamesRef, $defaultPrefix );
10324             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($infoString);
10325            
10326             $defaultPrefix = 'tv';
10327             $infoString = getPKVariableDependencies($dependenciesOnVectorsRef, "THETA", $arrayOfPKNamesRef, $defaultPrefix );
10328             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($infoString);
10329            
10330             $defaultPrefix = 'n';
10331             $infoString = getPKVariableDependencies($dependenciesOnVectorsRef, "ETA", $arrayOfPKNamesRef, $defaultPrefix ) ;
10332             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($infoString);
10333            
10334             my %tags = ( label => "PROBLEM", startTag => "PROBLEM, ModelName, =, \"", endTag => "\"\n", separator => " ", routine => \&getSingleString, subRoutine => \&getMainTagAndValue);
10335             ( $infoString, $state ) = getInfoFromSubTree($globalASTRef,"PROBLEM",\%tags,0);
10336             my $lambdaExpression = Util_convertToLambdaExpression($infoString);
10337             print $AlgebraicTheoryHandle $lambdaExpression;
10338            
10339             %tags = ( label => "INPUT", startTag => "INPUT, colNames, =, \" [ ", endTag => "\]\"\n",internalStartTag => "", internalEndTag => "",routine => \&getArrayOfValues, separator => ", ", subRoutine => \&getTagAndValueOrHashGeneral);
10340             ( $infoString, $state ) = getInfoFromSubTree($globalASTRef,"INPUT",\%tags, 0);
10341             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($infoString);
10342            
10343             %tags = ( label => "DATA", startTag => "DATA,", endTag => "", routine => \&getArrayOfValues, separator => ", ",subRoutine => \&getTagAndValueOrHashGeneral, printHandle => $AlgebraicTheoryHandle );
10344             ( $infoString, $state ) = getInfoFromSubTree($globalASTRef,"DATA",\%tags,0);
10345            
10346             my $infoStringForAlgebraicTheory;
10347             $infoStringForAlgebraicTheory = splitOutSingleStringAndAttributes("DATA", "DATA", $infoString, "\=");
10348             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($infoStringForAlgebraicTheory);
10349            
10350             %tags = ( label => "SUBROUTINE", startTag => "SUBROUTINE, ", endTag => "\n", separator => ", ", routine => \&getArrayOfValues,subRoutine => \&getTagAndValueOrHashGeneral, printHandle => $AlgebraicTheoryHandle );
10351             ( $infoString, $state ) = getInfoFromSubTree($globalASTRef,"SUBROUTINE",\%tags,0);
10352             $infoStringForAlgebraicTheory = splitOutSingleStringAndAttributes("SUBROUTINE", "SUBROUTINE", $infoString, "\=");
10353             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($infoStringForAlgebraicTheory);
10354            
10355             %tags = ( label => "MODEL", startTag => "", endTag => "\"\n",separator => ",",routine => \&getArrayOfValues, subRoutine => \&getTagAndValueOrExpressionGeneral);
10356             ( $infoString, $state ) = getInfoFromSubTree($globalASTRef,"MODEL",\%tags,0);
10357             $infoStringForAlgebraicTheory = splitOutFunctionAndFunctionValues("MODEL", $infoString, "\=");
10358             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($infoStringForAlgebraicTheory);
10359            
10360             my %processingMethodsForStateVariables = (
10361             getLanguageSpecificVersionOfVariable => \&getNonmemVersionOfVariable,
10362             getIfThenExpression => \&getMapleIfThenExpression,
10363             modifyDifferentialExpression => \&useNonmemDifferentialExpression,
10364             assignmentOperator => " = "
10365             );
10366            
10367             %tags = ( label => "CATEGORICAL_VARIABLES", startTag => "CATEGORICAL_VARIABLES, CATEGORICAL_VARIABLES, =, [", endTag => " \]\n", separator => " ", routine => \&getSingleString, subRoutine => \&getMainTagAndValue);
10368             ( $infoString, $state ) = getInfoFromSubTree($globalASTRef,"CATEGORICAL_VARIABLES",\%tags,0);
10369             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($infoString);
10370            
10371             %tags = ( label => "PK_STATE_VARIABLES", startTag => "PK_STATE_VARIABLES, PK_STATE_VARIABLES =, \[ ", endTag => " ]\n", separator => ", ", routine => \&getSingleString, subRoutine => \&getMainTagAndValue);
10372             ( $infoString, $state ) = getInfoFromSubTree($globalASTRef,"PK_STATE_VARIABLES",\%tags,0);
10373             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($infoString);
10374            
10375             my $stateVariablesRef = getSubTree($globalASTRef,"PK_STATE_VARIABLES");
10376             my $stateVariables;
10377             if ( ref($stateVariablesRef))
10378             {
10379             $stateVariables = $$stateVariablesRef;
10380             }
10381             else
10382             {
10383             $stateVariables = $stateVariablesRef;
10384             }
10385            
10386             my $parameters = join(",", keys(%variablesWithoutNumericSuffixes));
10387            
10388             $improveThis = 1;
10389             if ( $improveThis )
10390             {
10391             $parameters .= ",ERR1";
10392             }
10393            
10394             %tags = ( label => "PK", startTag => "PK, ", separator => "\nPK, ", endTag => "\n", routine => \&getDifferentialEquations, processingMethods => \%processingMethodsForStateVariables, getLeftRightOrBothSides => 'Both', subRoutine => "" );
10395             my $PKEquations;
10396             ( $PKEquations, $state ) = getInfoFromSubTree($globalASTRef,"PK",\%tags,0);
10397             my $PKEquationsAsAlgebraicTheory = splitLabelAndEquations("PK", $PKEquations,"\=");
10398             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($PKEquationsAsAlgebraicTheory);
10399            
10400             %tags = ( label => "DES", startTag => "DES, ", separator => "\nDES, ", endTag => "\n", routine => \&getDifferentialEquations, processingMethods => \%processingMethodsForStateVariables, getLeftRightOrBothSides => 'Both', subRoutine => "" );
10401             my $DESEquations;
10402             ( $DESEquations, $state ) = getInfoFromSubTree($globalASTRef,"DES",\%tags,0);
10403             my $DESEquationsAsAlgebraicTheory = splitLabelAndEquations("DES", $DESEquations,"\=");
10404             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($DESEquationsAsAlgebraicTheory);
10405            
10406             #Improve this -- make use of DESMASTER already in the AST
10407             my $DESFileNameRef = getSubTree($globalASTRef,"REGULARIZED_MODEL_NAME");
10408             my $DESFileName = $$DESFileNameRef;
10409            
10410             my $fileRoot = "\\oss\\models\\DifferentialEquations\\";
10411             my $fileFound = 1;
10412            
10413             my $linesFound = copyFileToAlgebraicTheoryLines("$fileRoot$DESFileName.DES",$AlgebraicTheoryHandle,"DESMASTER");
10414             if ( $linesFound == 0 )
10415             {
10416             my $modelNameFromFileRef = getSubTree($globalASTRef,"MODEL_NAME_FROM_FILE");
10417             my $modelNamefromFile = $$modelNameFromFileRef;
10418             $linesFound = copyFileToAlgebraicTheoryLines("$fileRoot$modelNamefromFile.DES",$AlgebraicTheoryHandle,"DESMASTER");
10419             }
10420            
10421             copyFileToAlgebraicTheoryLines("$fileRoot$DESFileName.PK",$AlgebraicTheoryHandle,"PKMASTER");
10422            
10423             my $priorsStringRef = getSubTree($globalASTRef,"PRIORS");
10424             my $priorsString = $$priorsStringRef;
10425             my $priorsAsAlgebraicTheory = splitEquations("PRIORS", $priorsString,"\~");
10426             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($priorsAsAlgebraicTheory);
10427            
10428             my @priorsStringsForEtas = ();
10429             my $priorsForEtasRef = getSubTree($globalASTRef,"PRIORSForEtas");
10430             if ( ref($priorsForEtasRef) )
10431             {
10432             @priorsStringsForEtas = @$priorsForEtasRef;
10433             }
10434            
10435             my $firstLine = 1;
10436             my $priorsStringForEtas = "";
10437             for ( my $iLine = 1; $iLine <= scalar(@priorsStringsForEtas); $iLine++)
10438             {
10439             my @distributionForEta = $priorsStringsForEtas[$iLine-1];
10440             $priorsStringForEtas .= "PRIORSForEta, ";
10441             $priorsStringForEtas .= "eta[$iLine], ~, \"$distributionForEta[0]\"\n";
10442             }
10443             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($priorsStringForEtas);
10444            
10445             %processingMethodsForStateVariables = (
10446             getLanguageSpecificVersionOfVariable => \&getNonmemVersionOfVariable,
10447             getIfThenExpression => \&getNonmemIfThenExpression,
10448             modifyDifferentialExpression => \&adaptDifferentialExpressionForStateVariable,
10449             assignmentOperator => " = "
10450             );
10451            
10452             %tags = ( label => "DES", startTag => "VECTOR_FIELD, VECTOR_FIELD, = , \[", separator => ",", endTag => " \]\n", routine => \&getDifferentialEquations, processingMethods => \%processingMethodsForStateVariables, getLeftRightOrBothSides => 'Right', subRoutine => "" );
10453            
10454             my $vectorFieldExpressions = "";
10455             ( $vectorFieldExpressions, $state ) = getInfoFromSubTree($globalASTRef,"DES",\%tags,0);
10456             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($vectorFieldExpressions);
10457            
10458             %tags = ( label => "PKScaleFactors", startTag => "SCALE_FACTORS, SCALE_FACTORS, =, \[", separator => " ", endTag => " ]\n", routine => \&getDifferentialEquations, processingMethods => \%processingMethodsForStateVariables, getLeftRightOrBothSides => 'Left', subRoutine => "" );
10459             my $PKScaleFactors;
10460             ( $PKScaleFactors, $state ) = getInfoFromSubTree($globalASTRef,"PKScaleFactors",\%tags,0);
10461             $PKScaleFactors =~ s/\n\s*\n/\n/g;
10462             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($PKScaleFactors);
10463            
10464             %tags = ( label => "OBSERVATION_FUNCTIONS", startTag => "", endTag => "\n", separator => "\n", routine => \&getHashOfFunctions, subRoutine => \&getMainTagAndValue);
10465             ( $infoString, $state ) = getInfoFromSubTree($globalASTRef,"OBSERVATION_FUNCTIONS",\%tags,0);
10466             $infoStringForAlgebraicTheory = splitEquations("OBSERVATION_FUNCTIONS",$infoString,"=");
10467             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($infoStringForAlgebraicTheory);
10468            
10469             $improveThis = 1;
10470             if ( $improveThis == 1 )
10471             {
10472             my $outputExpressions =~ s/EXP\(ERR1\)/ERR1/g;
10473             }
10474             %tags = ( label => "ERROR", startTag => "OBSERVATION_VARIABLES, OBSERVATION_VARIABLES, =, \"\[ ", separator =>", ", endTag => "\]\"\n", routine => \&getDifferentialEquations, processingMethods => \%processingMethodsForStateVariables, getLeftRightOrBothSides => 'Left', subRoutine => "" );
10475             my ( $coStateVariables, $state ) = getInfoFromSubTree($globalASTRef,"ERROR",\%tags,0);
10476             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($coStateVariables);
10477            
10478             my $inputVariables = "";
10479            
10480             print $AlgebraicTheoryHandle <
10481             AlgebraicTheoryPart1
10482            
10483             %processingMethods = (
10484             getLanguageSpecificVersionOfVariable => \&getNonmemVersionOfVariable,
10485             getIfThenExpression => \&getWinbugsIfThenExpression
10486             );
10487            
10488             #%tags = ( label => "DES", startTag => "DES, ", separator =>"\nDES, ", endTag => "", routine => \&getDifferentialEquations, processingMethods => \%processingMethodsForStateVariables, getLeftRightOrBothSides => 'Both', subRoutine => "" );
10489             #my ( $differentialEquations, $state ) = getInfoFromSubTree($globalASTRef,"DES",\%tags,0);
10490             #print $AlgebraicTheoryHandle $differentialEquations, "\n";
10491            
10492             my $allVariables = $stateVariables . ",extra," . $parameters;
10493            
10494             %tags = ( label => "ERROR", startTag => "ERROR, ", separator =>"\nERROR, ", endTag => "\n",routine => \&getDifferentialEquations, processingMethods => \%processingMethods, subRoutine => \&dummy );
10495             ( $infoString, $state ) = getInfoFromSubTree($globalASTRef,"ERROR",\%tags,0);
10496             $infoStringForAlgebraicTheory = splitLabelAndEquations("ERROR",$infoString,"\=");
10497             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($infoStringForAlgebraicTheory);
10498            
10499             %tags = ( label => "THETA", startTag => "", separator =>"\n", endTag => "", routine => \&getHashOfArrayOfValuesInParentheses, subRoutine => \&getThetaBoundsForAlgebraicTheories );
10500             ( $infoString, $state ) = getInfoFromSubTree($globalASTRef,"THETA",\%tags,0);
10501             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($infoString);
10502            
10503             %tags = ( label => "THETA", startTag => "", separator =>"", endTag => "", routine => \&getHashOfArrayOfValuesInParentheses, subRoutine => \&getThetaInitialValuesForAlgebraicTheories );
10504             ( $infoString, $state ) = getInfoFromSubTree($globalASTRef,"THETA",\%tags,0);
10505             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($infoString);
10506            
10507             %tags = ( label => "THETA", startTag => "", separator =>"", endTag => "", routine => \&getHashOfArrayOfValuesInParentheses, subRoutine => \&getThetaBoundsAndInitialValuesForAlgebraicTheories );
10508             ( $infoString, $state ) = getInfoFromSubTree($globalASTRef,"THETA",\%tags,0);
10509             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($infoString);
10510            
10511             %tags = ( label => "ETA", startTag => "", separator =>"\n", endTag => "\n", routine => \&getHashOfArrayOfValues, subRoutine => \&getOmegaInitialValuesForAlgebraicTheories );
10512             ( $infoString, $state ) = getInfoFromSubTree($globalASTRef,"ETA",\%tags,0);
10513             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($infoString);
10514            
10515             %tags = ( label => "ETA", startTag => "ETAInitial,EtaInitial, =, \[ ", separator =>", ", endTag => "]\"\n", routine => \&getHashOfArrayOfValues, subRoutine => \&getOmegaInitialValuesAsListForAlgebraicTheories );
10516             ( $infoString, $state ) = getInfoFromSubTree($globalASTRef,"ETA",\%tags,0);
10517             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($infoString);
10518            
10519             %tags = ( label => "SIGMA", startTag => "SIGMAInitial, ", separator =>", ", endTag => "\n", routine => \&getHashOfArrayOfValues, subRoutine => \&getOmegaInitialValuesForAlgebraicTheories );
10520             ( $infoString, $state ) = getInfoFromSubTree($globalASTRef,"SIGMA",\%tags,0);
10521             $improveThis = 1;
10522             $infoString =~ s/,sigma//;
10523             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($infoString);
10524            
10525             %tags = ( label => "TABLE", startTag => "TABLE, ", endTag => "\n", separator => ' ', routine => \&getHashOfArrayOfValues, subRoutine => \&getTagAndValueOrHashGeneral );
10526             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
10527             $infoStringForAlgebraicTheory = splitOutVectorAndAttributePairs("TABLE", "colNames", $infoString,"\=");
10528             print $AlgebraicTheoryHandle Util_convertToLambdaExpression($infoStringForAlgebraicTheory);
10529            
10530             %tags = ( label => "COVA", startTag => "COVA, ", endTag => "\n", routine => \&getArrayOfValues, subRoutine => \&getTagAndValueOrHashGeneral );
10531             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
10532             print $printHandle Util_convertToLambdaExpression($infoString);
10533            
10534             %tags = ( label => "ESTIMATION", startTag => "ESTIMATION, ", endTag => "\n", separator => ' ', routine => \&getArrayOfValues, subRoutine => \&getTagAndValueOrHashGeneral );
10535             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
10536             $infoStringForAlgebraicTheory = splitOutVectorAndAttributePairs("ESTIMATION","ESTIMATION", $infoString,"\=");
10537             print $printHandle Util_convertToLambdaExpression($infoStringForAlgebraicTheory);
10538            
10539             %tags = ( label => "SCAT", startTag => "SCAT, ", endTag => "\]\n", routine => \&getArrayOfValues, subRoutine => \&getTagAndValueOrHashGeneral );
10540             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
10541             $infoStringForAlgebraicTheory = splitOutVectorAndAttributePairs("SCAT","SCAT", $infoString,"\=");
10542             print $printHandle Util_convertToLambdaExpression($infoStringForAlgebraicTheory);
10543            
10544             close($AlgebraicTheoryHandle);
10545            
10546             }
10547            
10548             $improveThis = 1; #should not need this routine.
10549             sub splitLabelAndEquations
10550             {
10551             my ($label, $equationString, $separator) = @_;
10552             my $finalString = "";
10553            
10554             my @labelsAndEquations = split(/\n/,$equationString);
10555            
10556             foreach my $labelAndEquation ( @labelsAndEquations)
10557             {
10558             my ( $label, $equation ) = split(", ", $labelAndEquation);
10559             my ( $lhs, $rhs) = split(/=|\~/,$equation);
10560             $finalString .= $label . ", " . $lhs . ", " . $separator . ", " . "\"" . $rhs . "\"" . "\n";
10561             }
10562             return ( $finalString);
10563            
10564             }
10565            
10566             $improveThis = 1; #should not need this routine.
10567             sub splitEquations
10568             {
10569             my ($label, $equationString, $separator) = @_;
10570             my $finalString = "";
10571            
10572             my @labelsAndEquations = split(/\n/,$equationString);
10573            
10574             foreach my $equation ( @labelsAndEquations)
10575             {
10576             my ( $lhs, $rhs) = split(/=|\~/,$equation);
10577             $finalString .= $label . ", " . $lhs . ", " . $separator . ", " . "\"" . $rhs . "\"" . "\n";
10578             }
10579             return ( $finalString);
10580            
10581             }
10582            
10583            
10584             sub splitOutFunctionAndFunctionValues
10585             {
10586             my ($label, $equationString, $separator) = @_;
10587             my $finalString = "";
10588            
10589             my @labelsAndEquations = split(/\n/,$equationString);
10590            
10591             foreach my $equation ( @labelsAndEquations)
10592             {
10593             $equation =~ s/\s+//g;
10594             my ( $lhs, $center, $blank) = split(/\(|\)/,$equation);
10595             if ( defined($center))
10596             {
10597             my @params = split(/,/,$center);
10598             $params[1] =~ s/DEF//g;
10599             $finalString .= $label . ", " . $params[1] . "(" . $params[0] . ")" . ", " . "=" . ", " . "TRUE";
10600             $finalString .= "\n";
10601             }
10602             }
10603             return ( $finalString);
10604            
10605             }
10606            
10607             sub splitOutSingleStringAndAttributes
10608             {
10609             my ($label, $label1, $equationString, $separator) = @_;
10610             my $finalString = "";
10611            
10612             my ($lhs, $rhs, @equations ) = split(/,/,$equationString);
10613            
10614             $finalString .= $lhs . ", " . $label1 . ", " . "\=" . ", " . $rhs . "\n";
10615            
10616             foreach my $equation ( @equations)
10617             {
10618             my ( $lhs, $rhs) = split(/=/,$equation);
10619             if ( ! defined($lhs))
10620             {
10621             $lhs = "";
10622             }
10623             if ( ! defined($rhs))
10624             {
10625             $rhs = "";
10626             }
10627            
10628             $finalString .= $label . ", " . $lhs . ", " . "\"" . q(=) . "\"" . ", " . $rhs . "\n";
10629             }
10630             return ( $finalString);
10631            
10632             }
10633            
10634             sub splitOutVectorAndAttributePairs
10635             {
10636             my ($label, $label1, $equationString, $separator) = @_;
10637             my $finalString = "";
10638            
10639             my ($lhs, @equations ) = split(/,|\s+/,$equationString);
10640            
10641             $finalString .= $lhs . ", " . $label1 . ", " . "\=" . " , " . " [ ";
10642             my $optionsBegun = 0;
10643             foreach my $equation ( @equations)
10644             {
10645             if ( $equation =~ /ONEHEADER/)
10646             {
10647             $optionsBegun = 1;
10648             $finalString .= " ]\n";
10649             $finalString .= $lhs . ", " . "options" . ", " . "\=" . " , " . " [ ";
10650             }
10651            
10652             unless ( $equation =~ /=/)
10653             {
10654             $finalString .= " " . $equation;
10655             }
10656             else
10657             {
10658             my ( $lhs, $rhs) = split(/=/,$equation);
10659             $finalString .= " ]\n";
10660             $finalString .= $label . ", " . $lhs . ", " . "\"" . q(=) . "\"" . ", " . $rhs . "\n";
10661             }
10662             }
10663             return ( $finalString);
10664            
10665             }
10666            
10667            
10668             sub writeMapleFile
10669             {
10670             my $globalASTRef = $_[0];
10671             my $TLCOutputFileName = $_[1];
10672             my $dataFileName = $_[2];
10673            
10674             my %processingMethods = (
10675             getLanguageSpecificVersionOfVariable => \&getMapleVersionOfVariable,
10676             getIfThenExpression => \&getMapleIfThenExpression
10677             );
10678            
10679             my $mapleFileName = $TLCOutputFileName;
10680             $mapleFileName =~ s/\.TLC/\.mpl/ig;
10681             #$mapleFileName =~ s/\.TLC/\.ctl/ig;
10682            
10683             open(MAPLEFILE,">$mapleFileName" ) or die("Could not open Maple file $mapleFileName\n");
10684             $mapleFileHandle = *MAPLEFILE;
10685             #$mapleFileHandle = *STDOUT;
10686            
10687             print $mapleFileHandle "#---------------------------------------------------------------------\n";
10688            
10689             $printHandle = $mapleFileHandle;
10690            
10691             my %tags = ( label => "PROBLEM ", startTag => ";\#PROBLEM", endTag => "\n", separator => " ", printHandle => $mapleFileHandle, routine => \&getSingleString, subRoutine => \&reportMainTagAndValue);
10692            
10693             my $infoString;
10694            
10695             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
10696            
10697             %tags = ( label => "INPUT ", startTag => "\#INPUT", endTag => "\n",internalStartTag => "", internalEndTag => "",routine => \&reportArrayOfValues, separator => " ",subRoutine => \&reportTagAndValueOrHashGeneral, printHandle => $mapleFileHandle);
10698             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags, 0);
10699            
10700             %tags = ( label => "DATA ", startTag => "\#DATA", endTag => "\n", routine => \&reportArrayOfValues, separator => " ",subRoutine => \&reportTagAndValueOrHashGeneral, printHandle => $mapleFileHandle );
10701             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
10702            
10703             %tags = ( label => "SUBROUTINE ", startTag => "\#SUBROUTINE", endTag => "\n", separator => " ", routine => \&reportArrayOfValues,subRoutine => \&reportTagAndValueOrHashGeneral, printHandle => $mapleFileHandle );
10704             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
10705            
10706             %tags = ( label => "MODEL ", startTag => "\#MODEL", endTag => "\n", printHandle => $mapleFileHandle, separator => " ",routine => \&reportArrayOfValues, subRoutine => \&reportTagAndValueOrExpressionGeneral);
10707             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
10708            
10709             my %processingMethodsForStateVariables = (
10710             getLanguageSpecificVersionOfVariable => \&getJetVersionOfVariable,
10711             getIfThenExpression => \&getMapleIfThenExpression,
10712             modifyDifferentialExpression => \&modifyDifferentialExpression,
10713             assignmentOperator => " = "
10714            
10715             );
10716            
10717             %tags = ( label => "PK", startTag => "\n ", separator => "\n ,", endTag => "", routine => \&getDifferentialEquations, getLeftRightOrBothSides => 'Both', processingMethods => \%processingMethodsForStateVariables, subRoutine => "" );
10718             my ( $PKEquations, $state ) = getInfoFromSubTree($globalASTRef,"PK",\%tags,0);
10719            
10720             %tags = ( label => "DES", startTag => "", separator => "\n ,", endTag => "\n", printHandle => $mapleFileHandle, routine => \&getDifferentialEquations, processingMethods => \%processingMethodsForStateVariables, getLeftRightOrBothSides => 'Right', subRoutine => "" );
10721             my $vectorFieldExpressions;
10722             ( $vectorFieldExpressions, $state ) = getInfoFromSubTree($globalASTRef,"DES",\%tags,0);
10723            
10724             %tags = ( label => "DES", startTag => "\nS:=[\n ", separator => "\n ", endTag => "\n];\n", routine => \&getDifferentialEquations, getLeftRightOrBothSides => 'Both', processingMethods => \%processingMethods, subRoutine => "" );
10725             $vectorFieldExpressions = removeAnyFunctionDependencies( $vectorFieldExpressions,"t");
10726             my $parameters = join(",", keys(%variablesWithoutNumericSuffixes));
10727            
10728             $improveThis = 0; #rph not sure, 02/08
10729             if ( $improveThis )
10730             {
10731             $parameters .= ",ERR1";
10732             }
10733            
10734             # my $observationFunctionsRef = getSubTree($globalASTRef,"OBSERVATION_FUNCTIONS");
10735             # ($globalASTRef,$state) = modifySubTree($globalASTRef,"ERROR",\&checkForNames,\&replaceNames,$observationFunctionsRef,"",0,100,0);
10736            
10737             my %processingMethodsForJetVariables = (
10738             getLanguageSpecificVersionOfVariable => \&getJetVersionOfVariable,
10739             getIfThenExpression => \&getMapleIfThenExpression,
10740             modifyDifferentialExpression => \&modifyDifferentialExpression,
10741             assignmentOperator => " = "
10742            
10743             );
10744            
10745             %processingMethods = (
10746             getLanguageSpecificVersionOfVariable => \&getMapleVersionOfVariable,
10747             getIfThenExpression => \&getWinbugsIfThenExpression
10748             );
10749            
10750             my $useMine = 0; #improve this -- temporarily, just use masters.
10751            
10752             my @mapleDifferentialEquations = ();
10753             if ( $useMine )
10754             {
10755             %tags = ( label => "DES", startTag => "\nS:=[\n ", separator => ",\n ", endTag => "\n];\n",
10756             printHandle => $mapleFileHandle, routine => \&getDifferentialEquations,
10757             getLeftRightOrBothSides => 'Both', processingMethods => \%processingMethods, subRoutine => "" );
10758             my $differentialEquations;
10759             ( $differentialEquations, $state ) = getInfoFromSubTree($globalASTRef,"DES",\%tags,0);
10760             print $mapleFileHandle $differentialEquations, "\n";
10761            
10762             }
10763            
10764             my $useMaster = 1; #improve this
10765             if ( $useMaster )
10766             {
10767             %tags = ( label => "DESMASTER", startTag => "\nS:=[\n ", separator => ",\n ", endTag => "\n];\n",
10768             printHandle => $mapleFileHandle, routine => \&getDifferentialEquations,
10769             getLeftRightOrBothSides => 'Both', processingMethods => \%processingMethods, subRoutine => "" );
10770             my $differentialEquationsMaster;
10771             ( $differentialEquationsMaster, $state ) = getInfoFromSubTree($globalASTRef,"DESMASTER",\%tags,0);
10772             @mapleDifferentialEquations = split(/\n/,$differentialEquationsMaster);
10773            
10774             my $dosingRef = getSubTree($globalASTRef,"DOSING");
10775             my $dosing = $$dosingRef;
10776            
10777             my $routingRef = getSubTree($globalASTRef,"ROUTING");
10778             my $routing = $$routingRef;
10779            
10780             my $dosingExpression = "";
10781             if ( $routing eq "INFUSION" )
10782             {
10783             $dosingExpression = "AMT*(Heaviside(t) - Heaviside(t-1))";
10784             }
10785             elsif ( $dosing eq "MD" )
10786             {
10787             $dosingExpression = "sum(AMT*Dirac(24*day-t), day = 3 .. 9)";
10788             }
10789             elsif ( $dosing eq "SS" )
10790             {
10791             $dosingExpression = "";
10792             }
10793            
10794             if ( $dosingExpression ne "" )
10795             {
10796             for ( my $i = 0; $i < scalar(@mapleDifferentialEquations); $i++ )
10797             {
10798             if ( $mapleDifferentialEquations[$i] =~ /diff/)
10799             {
10800             chomp $mapleDifferentialEquations[$i];
10801             my $addComma = 0;
10802             if ( $mapleDifferentialEquations[$i] =~ /,\s*$/)
10803             {
10804             $mapleDifferentialEquations[$i] =~ s/,\s*$//g;
10805             $addComma = 1;
10806             }
10807             $mapleDifferentialEquations[$i] .= ' ' . '+ ' . $dosingExpression;
10808             if ( $addComma )
10809             {
10810             $mapleDifferentialEquations[$i] .= ", ";
10811             }
10812             $differentialEquationsMaster = join("\n",@mapleDifferentialEquations);
10813             last;
10814             }
10815             }
10816             }
10817             print $mapleFileHandle $differentialEquationsMaster, "\n";
10818            
10819             }
10820            
10821             %tags = ( label => "ERROR", startTag => "", separator => "\n ,", endTag => "\n", printHandle => $mapleFileHandle, routine => \&getDifferentialEquations, processingMethods => \%processingMethodsForJetVariables, getLeftRightOrBothSides => 'Right', subRoutine => "" );
10822             my $outputExpressions;
10823             ( $outputExpressions, $state ) = getInfoFromSubTree($globalASTRef,"ERROR",\%tags,0);
10824            
10825             $improveThis = 1;
10826             if ( $improveThis )
10827             {
10828             $outputExpressions =~ s/EXP\(ERR1\)/ERR1/g;
10829             }
10830             %tags = ( label => "ERROR", startTag => "", separator => ",", endTag => "", printHandle => $mapleFileHandle, routine => \&getDifferentialEquations, processingMethods => \%processingMethodsForJetVariables, getLeftRightOrBothSides => 'Left', subRoutine => "" );
10831             my $coStateVariables;
10832             ( $coStateVariables, $state ) = getInfoFromSubTree($globalASTRef,"ERROR",\%tags,0);
10833            
10834             my $inputVariables = "";
10835            
10836             my $stateVariablesRef = getSubTree($globalASTRef,"PK_STATE_VARIABLES");
10837             my $stateVariables;
10838             if ( ref($stateVariablesRef))
10839             {
10840             $stateVariables = $$stateVariablesRef;
10841             }
10842             else
10843             {
10844             $stateVariables = $stateVariablesRef;
10845             }
10846            
10847             my @allStateVariables = split(/\[s,]+/,$stateVariables);
10848            
10849             my $stateDependencies = "";
10850            
10851             foreach my $stateVariable ( @allStateVariables )
10852             {
10853             $stateDependencies .= "$stateVariable(t)";
10854             }
10855             $stateDependencies .= ", extra(t), myDenom(t)";
10856            
10857             print $mapleFileHandle <
10858            
10859             \#Define dependencies
10860             #declare($stateDependencies):
10861            
10862             \#Define Assumptions
10863             maplePart1
10864            
10865             if ( 0 )
10866             {
10867             %tags = ( label => "THETA", startTag => "assume(", endTag => "\n):\n", separator => ", ", routine => \&getHashOfArrayOfValuesInParentheses, subRoutine => \&getThetaBounds, indentLevel => 1 );
10868             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
10869             print $mapleFileHandle $infoString;
10870            
10871             %tags = ( label => "OMEGA", startTag => "assume(", endTag => "\):\n", separator => ", ", routine => \&getHashOfArrayOfValuesInParentheses, subRoutine => \&getThetaBounds, indentLevel => 1 );
10872             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
10873             print $mapleFileHandle $infoString;
10874             }
10875            
10876             my $first = 1;
10877             my %variablesWithoutSuffixes = %$variablesWithoutNumericSuffixesRef;
10878            
10879             my $dependenciesOnVectorsRef = getSubTree($globalASTRef,"VECTOR_VARIABLE_DEPENDENCIES");
10880             #improve this -- use data already in the global syntax tree.
10881             my $defaultPrefix = 'tv';
10882             my $arrayOfPKNamesRef = getSubTree($globalASTRef,"PK_VARIABLE_NAMES_ORIGINAL");
10883             $infoString = getPKVariableNamesAsNTuple($dependenciesOnVectorsRef, "THETA", $arrayOfPKNamesRef, $defaultPrefix );
10884             my @variables = Util_convertNTupleAsStringToVector($infoString);
10885             my @variablesWithoutNumericSuffixes = keys ( %variablesWithoutSuffixes );
10886             my @allAssumptions = sort (@variables, @variablesWithoutNumericSuffixes);
10887            
10888             my $lastVar = "";
10889             foreach my $key ( @allAssumptions )
10890             {
10891             next if $lastVar eq $key;
10892            
10893             if ( $first )
10894             {
10895             print $mapleFileHandle "assume(\n\t 0 < $key";
10896             $first = 0;
10897             }
10898             else
10899             {
10900             print $mapleFileHandle "\n ,0 < $key";
10901             }
10902             $lastVar = $key;
10903            
10904             }
10905            
10906             #rph Improve this 05/21/08 -- determine the maximum dose time here and use instead of 288.
10907             print $mapleFileHandle "\n\t,0<= t\n ,t < 288\n\t,0<= AMT\n\t,0 <= myDenom(t)\n):";
10908            
10909             #hack 05/30/08 -- need to define dosing compartment.
10910             my $iDosingCompartment = 1;
10911             my $routingRef = getSubTree($globalASTRef,"ROUTING");
10912             my $routing = $$routingRef;
10913             my $dosingRef = getSubTree($globalASTRef,"DOSING");
10914             my $dosing = $$dosingRef;
10915            
10916             my $initialConditionsString = MAPLE_getInitialConditionsString(\@mapleDifferentialEquations,$iDosingCompartment,$dosing,$routing);
10917             print $mapleFileHandle <
10918            
10919             \#Define initial conditions
10920             $initialConditionsString
10921            
10922             \#Define the basic differential equations
10923             maplePart1b
10924            
10925             my $allVariables = $stateVariables . ",extra," . $parameters;
10926            
10927             my $iFirst = 1;
10928             my $appendOrNot = "";
10929            
10930             my $mapleFileNameForLatex = "$mapleFileName.tex";
10931             $mapleFileNameForLatex =~ s/\//\\\\/g;
10932             foreach my $DEQ ( @mapleDifferentialEquations)
10933             {
10934             print $mapleFileHandle <
10935            
10936             \#Save Latex versions of differential equations
10937             latex(S, "$mapleFileNameForLatex"$appendOrNot);
10938            
10939             maplePart1c
10940            
10941             $appendOrNot = ",append";
10942             }
10943            
10944             my $fileNameForDEQs = "$mapleFileName.DEQS";
10945             $fileNameForDEQs =~ s/\//\\\\/g;
10946            
10947             my $fileNameForExplicitSolution = "$mapleFileName.integrated";
10948             $fileNameForExplicitSolution =~ s/\//\\\\/g;
10949            
10950             print $mapleFileHandle <
10951            
10952             \#Consolidate the basic equations and the initial conditions.
10953             SandICS := [op(S), op(ics)]:
10954            
10955             \#Solve the basic system
10956             mySol := simplify(dsolve(SandICS));
10957            
10958             maplePart1c
10959            
10960             if ( $dosing eq "SS" )
10961             {
10962             print $mapleFileHandle <
10963            
10964             \#Use one particular approach for obtaining steady state results...
10965             myLhs := lhs(mySol);
10966             myRhs := rhs(mySol);
10967             myRhs := simplify(sum(myRhs, t = 0 .. infinity ));
10968             mySol := myLhs = myRhs;
10969            
10970             maplePart1d
10971            
10972             }
10973            
10974             print $mapleFileHandle <
10975            
10976             stringForSolution := simplify(convert(mySol,string)):
10977            
10978             S := simplify(S);
10979             results := dpolyform(S);
10980            
10981             save mySol, S, results, "$fileNameForDEQs";
10982             save stringForSolution, "$fileNameForExplicitSolution";
10983            
10984             latex(mySol, "$mapleFileNameForLatex", 'append');
10985            
10986             \#--------------------------------------------------------------------------------
10987             \#Convert to polynomial form, and remove the denominators
10988             \#Step 1: remove the denominators.
10989             myRhs := 1:
10990             for i to nops(S) do
10991             x := op(i, S):
10992             for j to nops(x) do
10993             y1 := op(j, x); y := simplify(y1):
10994             if denom(y) <> 1 then
10995             myDenom := denom(y):
10996             k1 := algsubs(denom(y) = 1, y):
10997             myRhs := subsop(j = numer(y)*extra(t), x):
10998             iSave1 := i; iSave2 := j:
10999             S[iSave1] := myRhs :
11000             end if;
11001             end do;
11002             end do;
11003            
11004             \#Step 2: The next step is to add in an additional variable
11005             eqExtra := 'diff(extra(t), t)' = 'extra(t)^2'*(diff(myDenom, t)):
11006             for k to nops(S) do
11007             eqExtra := algsubs(lhs(S[k]) = rhs(S[k]), eqExtra)
11008             end do:
11009             S := [op(S), eqExtra]:
11010            
11011             \#Step 3: add in an additional initial condition for the additional variable.
11012             extraCondition := extra(0) = 1/myDenom;
11013             extraCondition := algsubs(t = 0, extraCondition);
11014             for k to nops(ics) do
11015             extraCondition := algsubs(lhs(ics[k]) = 0, extraCondition)
11016             end do;
11017             ics := [ics, extraCondition];
11018             \#--------------------------------------------------------------------------------
11019            
11020             \#Construct the differential ring needed to find the characteristic set.
11021             SAsDifferentialRing := S;
11022             for k to nops(S) do
11023             SAsDifferentialRing[k] := lhs(S[k])-rhs(S[k])
11024             end do;
11025             R := differential_ring(ranking = [$allVariables], derivations = [t], notation = 'diff');
11026            
11027             \#Finally, compute the characteristic set ( does not work yet )
11028             Results := Rosenfeld_Groebner(SAsDifferentialRing, R);
11029             \#--------------------------------------------------------------------------------
11030            
11031             \#Construct the differential ring needed to find the characteristic set.
11032             SAsDifferentialRing := S:
11033             for k to nops(S) do
11034             SAsDifferentialRing[k] := lhs(S[k])-rhs(S[k])
11035             end do:
11036            
11037             \#Finally, compute the characteristic sets
11038             Results := Rosenfeld_Groebner(SAsDifferentialRing, R);
11039            
11040             maplePart2
11041            
11042             %tags = ( label => "ERROR", startTag => "\#ERROR ", separator =>"; ", endTag => "\n", routine => \&getDifferentialEquations, processingMethods => \%processingMethods, subRoutine => \&dummy );
11043             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
11044             print $mapleFileHandle $infoString;
11045            
11046             %tags = ( label => "THETA", startTag => "\#THETA ", separator =>" ", endTag => "\n", routine => \&getHashOfArrayOfValuesInParentheses, subRoutine => \&getThetaGeneral );
11047             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
11048             print $mapleFileHandle $infoString;
11049            
11050             %tags = ( label => "ETA", startTag => "\#OMEGA ", separator =>" ", endTag => "\n", routine => \&getHashOfArrayOfValues, subRoutine => \&getOmegaInitialValuesGeneral );
11051             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
11052             print $mapleFileHandle $infoString;
11053            
11054             %tags = ( label => "SIGMA", startTag => "\#SIGMA ", separator =>" ", endTag => "\n", printHandle => $mapleFileHandle, routine => \&getHashOfArrayOfValues, subRoutine => \&getOmegaInitialValuesGeneral );
11055             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
11056             print $mapleFileHandle $infoString;
11057            
11058             %tags = ( label => "TAB", startTag => "\#TAB ", endTag => "\n", separator => ' ', printHandle => $mapleFileHandle, routine => \&getHashOfArrayOfValues, subRoutine => \&getTagAndValueOrHashGeneral );
11059             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
11060             if ( defined($infoString))
11061             {
11062             print $mapleFileHandle $infoString;
11063             }
11064             %tags = ( label => "COVA", startTag => "\#COVA ", endTag => "\n", printHandle => $mapleFileHandle, routine => \&getArrayOfValues, subRoutine => \&getTagAndValueOrHashGeneral );
11065             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
11066             print $mapleFileHandle $infoString;
11067            
11068             %tags = ( label => "EST", startTag => "\#EST ", endTag => "\n", separator => ' ', printHandle => $mapleFileHandle, routine => \&getArrayOfValues, subRoutine => \&getTagAndValueOrHashGeneral );
11069             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
11070             if ( defined($infoString))
11071             {
11072             print $mapleFileHandle $infoString;
11073             }
11074            
11075             %tags = ( label => "SCAT", startTag => "\#SCAT ", endTag => "\n", printHandle => $mapleFileHandle, routine => \&getArrayOfValues, subRoutine => \&getTagAndValueOrHashGeneral );
11076             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
11077             print $mapleFileHandle $infoString;
11078            
11079             $stateVariablesRef = getSubTree($globalASTRef,"PK_STATE_VARIABLES");
11080            
11081             if ( ref($stateVariablesRef) )
11082             {
11083             $stateVariables = $$stateVariablesRef;
11084             }
11085             else
11086             {
11087             $stateVariables = $stateVariablesRef;
11088             }
11089            
11090             print $printHandle <
11091            
11092             ##-----------------------------------------------------------------------------#
11093             \## System
11094             # Description :
11095             \# Result :
11096             \#
11097             \#-----------------------------------------------------------------------------#
11098             infolevel[observabilityTest] := 1 :
11099             infolevel[observabilitySymmetries] := 1 :
11100             t := 't':
11101             \#-----------------------------------------------------------------------------#
11102             \# Bibliography : see Monolix standard
11103             \#-----------------------------------------------------------------------------#
11104             \# We assume that diff(Variables[i],t) = VectorsField[i]
11105             VectorField:= [
11106             $vectorFieldExpressions
11107             ]:
11108            
11109             \# We assume that OutputsVariables[i] = OutputSystem[i].
11110             OutputSystem := [
11111             $outputExpressions
11112             ] :
11113            
11114             \#-----------------------------------------------------------------------------#
11115             OutputsVariables:= [$coStateVariables] :
11116             Inputs := [$inputVariables] :
11117             Parameters := [$parameters] :
11118             \# The variables have to be ordered as the vectors field.
11119             Variables := [$stateVariables] :
11120             \#-----------------------------------------------------------------------------#
11121             NonObservable := observabilityTest( VectorField ,
11122             Variables ,
11123             OutputSystem ,
11124             Parameters ,
11125             Inputs ) :
11126             print(%) :
11127             GroupInfGen := observabilitySymmetries( VectorField ,
11128             Variables ,
11129             OutputSystem ,
11130             Parameters ,
11131             Inputs ,
11132             NonObservable ) :
11133             print(%) :
11134             \#-----------------------------------------------------------------------------#
11135            
11136             Sedaglovic
11137            
11138             close($mapleFileHandle);
11139            
11140             }
11141            
11142             sub getLanguageIndependentVersionOfBaseVariable
11143             {
11144             my $name = $_[0];
11145             my $outName = $name;
11146            
11147             if ( $name eq "I" || $name eq "DV" )
11148             {
11149             $outName = "IVar";
11150             }
11151             return ( $outName);
11152             }
11153            
11154             sub getMapleVersionOfBaseVariable
11155             {
11156             my $name = $_[0];
11157             my $outName = $name;
11158            
11159             if ( $name eq "I" || $name eq "DV" )
11160             {
11161             $outName = "IVar";
11162             }
11163             return ( $outName);
11164             }
11165            
11166             sub getNonmemVersionOfBaseVariable
11167             {
11168             my $name = $_[0];
11169             my $outName = $name;
11170            
11171             if ( $name eq "I" || $name eq "DV" )
11172             {
11173             $outName = "IVar";
11174             }
11175             $outName =~ s/\./\_/g;
11176             return ( $outName);
11177             }
11178            
11179             sub getWinbugsVersionOfBaseVariable
11180             {
11181             my $name = $_[0];
11182             my $outName = $name;
11183            
11184             if ( $name eq "I" || $name eq "DV" )
11185             {
11186             $outName = "IVar";
11187             }
11188             return ( $outName);
11189             }
11190            
11191             sub modifyDifferentialExpression
11192             {
11193             my $name = $_[0];
11194             my $outName = $name;
11195            
11196             if ($name =~ /diff\((.*)\((.*)/)
11197             {
11198             $outName = $1;
11199             }
11200             return ( $outName);
11201             }
11202            
11203             sub adaptDifferentialExpressionForStateVariable
11204             {
11205             my $name = $_[0];
11206             my $outName = $name;
11207            
11208             if ($name =~ /diff\((.*)\((.*)/)
11209             {
11210             $outName = $1;
11211             }
11212            
11213             if ($name =~ /diff\((.*)\)/)
11214             {
11215             $outName = $1;
11216             $outName =~ s/,t//g;
11217             }
11218            
11219             if ($name =~ /DADT(\d+)/)
11220             {
11221             $outName = "A$1";
11222             }
11223            
11224             if ($name =~ /D\((.*)\)/)
11225             {
11226             $outName = $1;
11227             $outName =~ s/,t//g;
11228             }
11229            
11230             if ( $name eq "DADT")
11231             {
11232             $outName = "A1";
11233             }
11234            
11235             return ( $outName);
11236             }
11237            
11238             sub useNonmemDifferentialExpression
11239             {
11240             my $name = $_[0];
11241             my $outName = $name;
11242            
11243             if ($name =~ /D\(A(\d).*/)
11244             {
11245             $outName = "DADT($1)";
11246             }
11247            
11248             if ($name =~ /diff\(A(\d).*/i)
11249             {
11250             $outName = "DADT($1)";
11251             }
11252            
11253             return ( $outName);
11254             }
11255            
11256             sub getWinbugsVersionOfVariable
11257             {
11258             my $name = $_[0];
11259             my $outName = $name;
11260            
11261             my $baseVariable = substr($outName,0,length($outName)-1);
11262             my $suffix = substr($outName,-1);
11263            
11264             my $treeForThisVariableRef = $variablesWithNumericSuffixes{$baseVariable};
11265            
11266             if ( $treeForThisVariableRef )
11267             {
11268             my $iOffsetForUseOf0 = getOffsetForPossibleUseOfZero($treeForThisVariableRef );
11269             $suffix += $iOffsetForUseOf0;
11270             $baseVariable = getWinbugsVersionOfBaseVariable($baseVariable);
11271             if ( $outName =~ /^eta/i)
11272             {
11273             $outName = "$baseVariable\[iSubject,$suffix\]";
11274             }
11275             else
11276             {
11277             $outName = "$baseVariable\[iObs,$suffix\]";
11278             }
11279             if ( $logitFunctions{$name} )
11280             {
11281             my $winbugsName = getWinbugsVersionOfVariable($logitFunctions{$name});
11282             $outName = "logit\($winbugsName\)";
11283             }
11284             }
11285             elsif ( $outName =~ /\(/)
11286             {
11287             $outName =~ s/\((.*)\)/\[$1\]/g;
11288            
11289             if ( $outName =~ /^eta/i )
11290             {
11291             $outName =~ s/ETA\[(.*)\]/ETA\[Subject\[iObs\],$1\]/ig;
11292             }
11293             }
11294             elsif ( $outName =~ /TIME|DOSE/)
11295             {
11296             $outName = "$outName\[iObs\]";
11297             }
11298             return ( $outName);
11299             }
11300            
11301             sub getNonmemVersionOfVariable
11302             {
11303             my $name = $_[0];
11304            
11305             my $outName = $name;
11306            
11307             if ( defined($outName) )
11308             {
11309            
11310             my $baseVariable = substr($outName,0,length($outName)-1);
11311             my $suffix = substr($outName,-1);
11312            
11313             my $treeForThisVariableRef = $variablesWithNumericSuffixes{$baseVariable};
11314            
11315             if ( $treeForThisVariableRef )
11316             {
11317             my $iOffsetForUseOf0 = getOffsetForPossibleUseOfZero($treeForThisVariableRef );
11318             $suffix += $iOffsetForUseOf0;
11319             $outName = getNonmemVersionOfBaseVariable($baseVariable);
11320             $outName = $outName . $suffix;
11321            
11322             }
11323             elsif ( $outName =~ /\[|\(/)
11324             {
11325             $outName =~ s/\[(.*)\]/\($1\)/g;
11326             $outName =~ s/\(t\)//g;
11327             $outName =~ s/\,t//g;
11328            
11329             }
11330             elsif ( $outName =~ /TIME|DOSE/)
11331             {
11332             }
11333            
11334             $outName =~ s/\./\_/g;
11335             }
11336            
11337             return ( $outName);
11338             }
11339            
11340             sub getLanguageIndependentVersionOfVariable
11341             {
11342             my $name = $_[0];
11343             my $outName = $name;
11344            
11345             $outName =~ s/\(|\)|\]\)//g;
11346            
11347             my $baseVariable = substr($outName,0,length($outName)-1);
11348             my $suffix = substr($outName,-1);
11349            
11350             my $treeForThisVariableRef = "";
11351            
11352             if ( $suffix =~ /\d+/ )
11353             {
11354             $treeForThisVariableRef = $variablesWithNumericSuffixes{$baseVariable};
11355            
11356             if ( $treeForThisVariableRef )
11357             {
11358             my $iOffsetForUseOf0 = getOffsetForPossibleUseOfZero($treeForThisVariableRef );
11359             $suffix += $iOffsetForUseOf0;
11360             $outName = getLanguageIndependentVersionOfBaseVariable($baseVariable);
11361             }
11362             }
11363             elsif ( $outName =~ /\[/)
11364             {
11365             $outName =~ s/\[(.*)\]/\($1\)/g;
11366             }
11367             elsif ( $outName =~ /TIME|DOSE/)
11368             {
11369             }
11370             return ( $outName);
11371             }
11372            
11373             sub getMapleVersionOfVariable
11374             {
11375             my $name = $_[0];
11376             my $outName = $name;
11377            
11378             #Improve this;
11379             unless ( $name =~ /^K\d+/)
11380             {
11381             my $baseVariable = substr($outName,0,length($outName)-1);
11382             my $suffix = substr($outName,-1);
11383            
11384             my $treeForThisVariableRef = $variablesWithNumericSuffixes{$baseVariable};
11385            
11386             if ( $treeForThisVariableRef )
11387             {
11388             my $iOffsetForUseOf0 = getOffsetForPossibleUseOfZero($treeForThisVariableRef );
11389             $suffix += $iOffsetForUseOf0;
11390             $outName = getMapleVersionOfBaseVariable($baseVariable);
11391            
11392             }
11393             elsif ( $outName =~ /\[/)
11394             {
11395             $outName =~ s/\[(.*)\]/\($1\)/g;
11396             }
11397             elsif ( $outName =~ /TIME|DOSE/)
11398             {
11399             }
11400             }
11401             return ( $outName);
11402             }
11403            
11404            
11405             sub getJetVersionOfVariable
11406             {
11407             my $name = $_[0];
11408             my $outName = modifyDifferentialExpression($name);
11409             #$outName =~ s/\((t)\)//g;
11410             $outName =~ s/\((\d)\)/$1/g;
11411             return ( $outName);
11412             }
11413            
11414             sub getOffsetForPossibleUseOfZero
11415             {
11416             my $treeForUseOfThisVariableRef = $_[0];
11417             my $iOffset = 0;
11418            
11419             if ( ref($treeForUseOfThisVariableRef) && $treeForUseOfThisVariableRef =~ /HASH/)
11420             {
11421             my %treeForUseOfThisVariable = %$treeForUseOfThisVariableRef;
11422             my @keys = sort(keys(%treeForUseOfThisVariable));
11423            
11424             if ( $keys[0] == 0 )
11425             {
11426             $iOffset = 1;
11427             }
11428             }
11429            
11430             return ( $iOffset);
11431             }
11432            
11433            
11434             sub determineCATEGORICAL_VARIABLES
11435             {
11436            
11437             my $globalASTRef = $_[0];
11438            
11439             my %processingMethods = (
11440             getLanguageSpecificVersionOfVariable => \&getWinbugsVersionOfVariable,
11441             getIfThenExpression => \&getWinbugsIfThenExpression
11442             );
11443            
11444             my $processingMethodsRef = \%processingMethods;
11445            
11446             my $predTreeRef = getSubTree($globalASTRef,"PRED");
11447             unless ( ref($predTreeRef) && ( $predTreeRef =~ /HASH/ or $predTreeRef =~ /ARRAY/ ))
11448             {
11449             print "Possible ERROR since no PRED provided\n";
11450             return;
11451             }
11452            
11453             my @predEquations = @$predTreeRef;
11454            
11455             my %baseVariablesUsed = ();
11456             my $additionalString = "";
11457            
11458             for ( my $iEquation = $#predEquations; $iEquation >= 0; $iEquation-- )
11459             {
11460             my $equationTreeRef = $predEquations[$iEquation];
11461            
11462             my %equation = %$equationTreeRef;
11463             my $leftSideRef = $equation{"left"};
11464             my %leftSide = %$leftSideRef;
11465             my $outName = $leftSide{"name"};
11466            
11467             if ( $outName eq "Y" )
11468             {
11469             my $varName = "DV";
11470             my $dataForDVRef = $IfThenExpressionsForVariables{$varName};
11471             my %dataForDV = %$dataForDVRef;
11472             my $nKeys = scalar(keys(%dataForDV));
11473             $varName = getWinbugsVersionOfBaseVariable($varName);
11474             $baseVariablesUsed{$varName} = 1;
11475             $additionalString .= "$outName\[iObs\] ~ dcat\($varName\[iObs,1:$nKeys\]\)";
11476             next;
11477             }
11478            
11479             my $baseVariable = substr($outName,0,length($outName)-1);
11480             my $suffix = substr($outName,-1);
11481             my $treeForThisVariableRef = $variablesWithNumericSuffixes{$baseVariable};
11482             if ( $suffix =~ /\d/ && $treeForThisVariableRef )
11483             {
11484             $baseVariable = getWinbugsVersionOfBaseVariable($baseVariable);
11485            
11486             next if ( $baseVariablesUsed{$baseVariable} );
11487             next if ( $inverseLogitFunctions{$baseVariable} );
11488            
11489             $baseVariablesUsed{$baseVariable} = 1;
11490             my %treeForThisVariable = %$treeForThisVariableRef;
11491            
11492             my $iKeyOffsetForUseOf0 = getOffsetForPossibleUseOfZero(\%treeForThisVariable);
11493             foreach my $key ( sort(keys(%treeForThisVariable )))
11494             {
11495             my $rightTreeRef = $treeForThisVariable{$key};
11496             my $rightHandExpression = getExpression($rightTreeRef,$processingMethodsRef);
11497             my $variable = $baseVariable . $key;
11498             my $winBugsVariable = getWinbugsVersionOfVariable($variable);
11499             #$additionalString .= " $winBugsVariable <- $rightHandExpression\n";
11500             }
11501             #$additionalString .= "\n";
11502             }
11503             else
11504             {
11505             my %equationTree = %$equationTreeRef;
11506             my $leftSide = getExpression($equationTree{"left"},$processingMethodsRef);
11507             my $oper = getExpression($equationTree{"oper"},$processingMethodsRef);
11508             $oper = "\<\-";
11509             my $rightSide = getExpression($equationTree{"right"},$processingMethodsRef);
11510             #$additionalString .= " $leftSide $oper $rightSide\n";
11511            
11512             }
11513             }
11514            
11515             #$additionalString .= <
11516             #}
11517             #WinBugsEnd
11518            
11519             return ( $additionalString);
11520            
11521             }
11522            
11523             sub getPriorsForThetasAsString
11524             {
11525             my $globalASTRef = $_[0];
11526            
11527             my $additionalString = "";
11528            
11529             my $priorsStringRef = getSubTree($globalASTRef,"PRIORS");
11530             $improveThis = 1; #should not need to do this next step.
11531             my $localPriorString = $$priorsStringRef;
11532             $localPriorString =~ s/;\#//g;
11533             $additionalString .= $localPriorString;
11534            
11535             return ( $additionalString);
11536            
11537             }
11538            
11539             sub writeWinbugsOut
11540             {
11541            
11542             $globalASTRef = $_[0];
11543             my $TLCOutputFileName = $_[1];
11544            
11545             my %processingMethods = (
11546             getLanguageSpecificVersionOfVariable => \&getWinbugsVersionOfVariable,
11547             getIfThenExpression => \&getWinbugsIfThenExpression
11548             );
11549            
11550             my $processingMethodsRef = \%processingMethods;
11551            
11552             my $predTreeRef = getSubTree($globalASTRef,"PRED");
11553             unless ( ref($predTreeRef) && ( $predTreeRef =~ /HASH/ or $predTreeRef =~ /ARRAY/ ))
11554             {
11555             print "Possible ERROR since no PRED provided\n";
11556             $globalASTRef = copySubTree($globalASTRef,"PK","PRED");
11557             $improveThis =1; #do for DES as well (?)
11558             $predTreeRef = getSubTree($globalASTRef,"PRED");
11559             }
11560            
11561             my $WinbugsFileName = $TLCOutputFileName;
11562             $WinbugsFileName =~ s/\.TLC/\.bugs/ig;
11563            
11564             open(WinbugsFILE,">$WinbugsFileName" ) or die("Could not open Winbugs file $WinbugsFileName\n");
11565             print WinbugsFILE "---------------------------------------------------------------------\n";
11566             my $winbugsFileHandle = *WinbugsFILE;
11567            
11568             $printHandle = $winbugsFileHandle;
11569            
11570             my @priorsStringsForEtas = ();
11571             my $priorsStringsForEtasRef = getSubTree($globalASTRef,"PRIORSForEtas");
11572             if ( ref($priorsStringsForEtasRef) )
11573             {
11574             @priorsStringsForEtas = @$priorsStringsForEtasRef;
11575             }
11576            
11577             print $printHandle <
11578            
11579             model {
11580            
11581             for (iSubject in 1:nSubjects)
11582             {
11583             WinBugs1
11584            
11585             for (my $i = 1; $i <= scalar(@priorsStringsForEtas);$i++)
11586             {
11587             my $LHSString = "ETA[iSubject,$i] ~ ";
11588             print $printHandle <
11589             $LHSString $priorsStringsForEtas[$i-1]
11590             WinBugs1a
11591             }
11592            
11593             print $printHandle <
11594             }
11595            
11596             for (iObs in 1:nObs)
11597             {
11598             WinBugs1b
11599            
11600             my @predEquations = @$predTreeRef;
11601            
11602             my %baseVariablesUsed = ();
11603            
11604             for ( my $iEquation = $#predEquations; $iEquation >= 0; $iEquation-- )
11605             {
11606             my $equationTreeRef = $predEquations[$iEquation];
11607            
11608             my %equation = %$equationTreeRef;
11609            
11610             my $leftSideRef = $equation{"left"};
11611             my %leftSide = %$leftSideRef;
11612             my $outName = $leftSide{"name"};
11613             if ( $outName eq "Y" )
11614             {
11615             my $varName = "DV";
11616             my $dataForDVRef = $IfThenExpressionsForVariables{$varName};
11617             my %dataForDV = %$dataForDVRef;
11618             my $nKeys = scalar(keys(%dataForDV));
11619             $varName = getWinbugsVersionOfBaseVariable($varName);
11620             $baseVariablesUsed{$varName} = 1;
11621             print $printHandle <
11622             $outName\[iObs\] ~ dcat\($varName\[iObs,1:$nKeys\]\)
11623            
11624             IfThenExpressionsAsDCAT
11625            
11626             next;
11627             }
11628            
11629             my $baseVariable = substr($outName,0,length($outName)-1);
11630             my $suffix = substr($outName,-1);
11631             my $treeForThisVariableRef = $variablesWithNumericSuffixes{$baseVariable};
11632             if ( $suffix =~ /\d/ && $treeForThisVariableRef )
11633             {
11634             $baseVariable = getWinbugsVersionOfBaseVariable($baseVariable);
11635            
11636             next if ( $baseVariablesUsed{$baseVariable} );
11637             next if ( $inverseLogitFunctions{$baseVariable} );
11638            
11639             $baseVariablesUsed{$baseVariable} = 1;
11640             my %treeForThisVariable = %$treeForThisVariableRef;
11641            
11642             my $iKeyOffsetForUseOf0 = getOffsetForPossibleUseOfZero(\%treeForThisVariable);
11643             foreach my $key ( sort(keys(%treeForThisVariable )))
11644             {
11645             my $rightTreeRef = $treeForThisVariable{$key};
11646             my $rightHandExpression = getExpression($rightTreeRef,$processingMethodsRef);
11647             my $variable = $baseVariable . $key;
11648             my $winBugsVariable = getWinbugsVersionOfVariable($variable);
11649             print $printHandle " $winBugsVariable <- $rightHandExpression\n";
11650             }
11651             print $printHandle "\n";
11652             }
11653             else
11654             {
11655             my %equationTree = %$equationTreeRef;
11656             my $leftSide = getExpression($equationTree{"left"},$processingMethodsRef);
11657             my $oper = getExpression($equationTree{"oper"},$processingMethodsRef);
11658             $oper = "\<\-";
11659             my $rightSide = getExpression($equationTree{"right"},$processingMethodsRef);
11660             print $printHandle " $leftSide $oper $rightSide\n";
11661            
11662             }
11663             }
11664            
11665             print $printHandle <
11666             }
11667             WinBugsEnd
11668            
11669             my $priorsStringRef = getSubTree($globalASTRef,"PRIORS");
11670             $improveThis = 1; #should not need to do this next step.
11671             my $localPriorString = $$priorsStringRef;
11672             $localPriorString =~ s/;\#//g;
11673             print $printHandle $localPriorString;
11674            
11675             print $printHandle <
11676             }
11677             WinBugsEnd
11678             return;
11679            
11680             }
11681            
11682             sub writeWinbugsOutMethod2
11683             {
11684            
11685             $globalASTRef = $_[0];
11686             my $TLCOutputFileName = $_[1];
11687            
11688             my %processingMethods = (
11689             getLanguageSpecificVersionOfVariable => \&getWinbugsVersionOfVariable,
11690             getIfThenExpression => \&getWinbugsIfThenExpression
11691             );
11692            
11693             my $processingMethodsRef = \%processingMethods;
11694            
11695             my $predTreeRef = getSubTree($globalASTRef,"PRED");
11696             unless ( ref($predTreeRef) && ( $predTreeRef =~ /HASH/ or $predTreeRef =~ /ARRAY/ ))
11697             {
11698             print "Possible ERROR since no PRED provided\n";
11699             $globalASTRef = copySubTree($globalASTRef,"PK","PRED");
11700             $improveThis =1; #do for DES as well (?)
11701             $predTreeRef = getSubTree($globalASTRef,"PRED");
11702             }
11703            
11704             my $WinbugsFileName = $TLCOutputFileName;
11705             $WinbugsFileName =~ s/\.TLC/\.bugs/ig;
11706            
11707             open(WinbugsFILE,">$WinbugsFileName" ) or die("Could not open Winbugs file $WinbugsFileName\n");
11708             print WinbugsFILE "---------------------------------------------------------------------\n";
11709             my $winbugsFileHandle = *WinbugsFILE;
11710            
11711             $printHandle = $winbugsFileHandle;
11712            
11713             my @priorsStringsForEtas = ();
11714             my $priorsStringsForEtasRef = getSubTree($globalASTRef,"PRIORSForEtas");
11715             if ( ref($priorsStringsForEtasRef) )
11716             {
11717             @priorsStringsForEtas = @$priorsStringsForEtasRef;
11718             }
11719            
11720             print $printHandle <
11721            
11722             model {
11723            
11724             for (iSubject in 1:nSubjects)
11725             {
11726             WinBugs1
11727            
11728            
11729             for (my $i = 1; $i <= scalar(@priorsStringsForEtas);$i++)
11730             {
11731             my $LHSString = "ETA[iSubject,$i] ~ ";
11732             print $printHandle <
11733             $LHSString $priorsStringsForEtas[$i-1]
11734             WinBugs1a
11735             }
11736            
11737             print $printHandle <
11738             }
11739            
11740             for (iObs in 1:nObs)
11741             {
11742             WinBugs1b
11743            
11744             my @predEquations = @$predTreeRef;
11745            
11746             my %baseVariablesUsed = ();
11747            
11748             for ( my $iEquation = $#predEquations; $iEquation >= 0; $iEquation-- )
11749             {
11750             my $equationTreeRef = $predEquations[$iEquation];
11751            
11752             my %equation = %$equationTreeRef;
11753            
11754             my $leftSideRef = $equation{"left"};
11755             my %leftSide = %$leftSideRef;
11756             my $outName = $leftSide{"name"};
11757             if ( $outName eq "Y" )
11758             {
11759             my $varName = "DV";
11760             my $dataForDVRef = $IfThenExpressionsForVariables{$varName};
11761             my %dataForDV = %$dataForDVRef;
11762             my $nKeys = scalar(keys(%dataForDV));
11763             $varName = getWinbugsVersionOfBaseVariable($varName);
11764             $baseVariablesUsed{$varName} = 1;
11765             print $printHandle <
11766             $outName\[iObs\] ~ dcat\($varName\[iObs,1:$nKeys\]\)
11767            
11768             IfThenExpressionsAsDCAT
11769            
11770             next;
11771             }
11772            
11773             my $baseVariable = substr($outName,0,length($outName)-1);
11774             my $suffix = substr($outName,-1);
11775             my $treeForThisVariableRef = $variablesWithNumericSuffixes{$baseVariable};
11776             if ( $suffix =~ /\d/ && $treeForThisVariableRef )
11777             {
11778             $baseVariable = getWinbugsVersionOfBaseVariable($baseVariable);
11779            
11780             next if ( $baseVariablesUsed{$baseVariable} );
11781             next if ( $inverseLogitFunctions{$baseVariable} );
11782            
11783             $baseVariablesUsed{$baseVariable} = 1;
11784             my %treeForThisVariable = %$treeForThisVariableRef;
11785            
11786             my $iKeyOffsetForUseOf0 = getOffsetForPossibleUseOfZero(\%treeForThisVariable);
11787             foreach my $key ( sort(keys(%treeForThisVariable )))
11788             {
11789             my $rightTreeRef = $treeForThisVariable{$key};
11790             my $rightHandExpression = getExpression($rightTreeRef,$processingMethodsRef);
11791             my $variable = $baseVariable . $key;
11792             my $winBugsVariable = getWinbugsVersionOfVariable($variable);
11793             print $printHandle " $winBugsVariable <- $rightHandExpression\n";
11794             }
11795             print $printHandle "\n";
11796             }
11797             else
11798             {
11799             my %equationTree = %$equationTreeRef;
11800             my $leftSide = getExpression($equationTree{"left"},$processingMethodsRef);
11801             my $oper = getExpression($equationTree{"oper"},$processingMethodsRef);
11802             $oper = "\<\-";
11803             my $rightSide = getExpression($equationTree{"right"},$processingMethodsRef);
11804             print $printHandle " $leftSide $oper $rightSide\n";
11805            
11806             }
11807             }
11808            
11809             print $printHandle <
11810             }
11811             WinBugsEnd
11812            
11813             my $priorsStringRef = getSubTree($globalASTRef,"PRIORS");
11814             $improveThis = 1; #should not need to do this next step.
11815             my $localPriorString = $$priorsStringRef;
11816             $localPriorString =~ s/;\#//g;
11817             print $printHandle $localPriorString;
11818            
11819             print $printHandle <
11820             }
11821             WinBugsEnd
11822             return;
11823            
11824             my $infoString = "";
11825            
11826             my %tags = ( label => "PROBLEM", startTag => "\$PROBLEM ", endTag => "\n", separator => " ", printHandle => $winbugsFileHandle, routine => \&getProblemGeneral, subRoutine => \&getMainTagAndValue);
11827             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
11828            
11829             %tags = ( label => "INPUT", startTag => "\$INPUT ", endTag => "\n",internalStartTag => "", internalEndTag => "",routine => \&getArrayOfValues, separator => " ",subRoutine => \&getTagAndValueOrHashGeneral, printHandle => $winbugsFileHandle);
11830             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags, 0);
11831            
11832             %tags = ( label => "DATA", startTag => "\$DATA ", endTag => "\n", routine => \&getArrayOfValues, separator => " ",subRoutine => \&getTagAndValueOrHashGeneral, printHandle => $winbugsFileHandle );
11833             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
11834            
11835             %tags = ( label => "SUBROUTINE", startTag => "\$SUBROUTINE ", endTag => "\n", separator => " ", routine => \&getArrayOfValues,subRoutine => \&getTagAndValueOrHashGeneral, printHandle => $winbugsFileHandle );
11836             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
11837            
11838             %tags = ( label => "MODEL", startTag => "\$MODEL ", endTag => "\n",printHandle => $winbugsFileHandle, separator => " ",routine => \&getArrayOfValues, subRoutine => \&getTagAndValueOrExpressionGeneral);
11839             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
11840            
11841             %tags = ( label => "PK", startTag => "\$PK ", endTag => "\n", separator => "\n", printHandle => $winbugsFileHandle, routine => \&getDifferentialEquations, subRoutine => \&dummy );
11842             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
11843            
11844             %tags = ( label => "PRED", startTag => "\$PRED\n", endTag => "\n", separator => "\n", printHandle => $winbugsFileHandle, routine => \&getDifferentialEquations, subRoutine => \&dummy );
11845             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
11846            
11847             %tags = ( label => "DES", startTag => "\$DES ", endTag => "\n", printHandle => $winbugsFileHandle, routine => \&getDifferentialEquations, subRoutine => \&dummy );
11848             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
11849            
11850             %tags = ( label => "ERROR", startTag => "\$ERROR\n", separator =>"\n", endTag => "\n", printHandle => $winbugsFileHandle, routine => \&getDifferentialEquations, subRoutine => \&dummy );
11851             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
11852            
11853             %tags = ( label => "THETA", startTag => "\$THETA\n", separator =>" ", endTag => "\n", printHandle => $winbugsFileHandle, routine => \&getHashOfArrayOfValuesInParentheses, subRoutine => \&getThetaGeneral );
11854             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
11855            
11856             %tags = ( label => "ETA", startTag => "\$OMEGA ", separator =>" ", endTag => "\n", printHandle => $winbugsFileHandle, routine => \&getHashOfArrayOfValues, subRoutine => \&getOmegaInitialValuesGeneral );
11857             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
11858            
11859             %tags = ( label => "SIGMA", startTag => "\$SIGMA ", separator =>" ", endTag => "\n", printHandle => $winbugsFileHandle, routine => \&getHashOfArrayOfValues, subRoutine => \&getOmegaInitialValuesGeneral );
11860             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
11861            
11862             %tags = ( label => "TAB", startTag => "\$TAB ", endTag => "\n", separator => ' ', printHandle => $winbugsFileHandle, routine => \&getHashOfArrayOfValues, subRoutine => \&getTagAndValueOrHashGeneral );
11863             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
11864            
11865             %tags = ( label => "COVA", startTag => "\$COVA ", endTag => "\n", printHandle => $winbugsFileHandle, routine => \&getArrayOfValues, subRoutine => \&getTagAndValueOrHashGeneral );
11866             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
11867            
11868             %tags = ( label => "EST", startTag => "\$EST ", endTag => "\n", separator => ' ', printHandle => $winbugsFileHandle, routine => \&getArrayOfValues, subRoutine => \&getTagAndValueOrHashGeneral );
11869             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
11870            
11871             %tags = ( label => "SCAT", startTag => "\$SCAT ", endTag => "\n", printHandle => $winbugsFileHandle, routine => \&getArrayOfValues, subRoutine => \&getTagAndValueOrHashGeneral );
11872             ( $infoString, $state ) = getInfoFromTree($globalASTRef,\%tags,0);
11873            
11874             }
11875            
11876             #---------------------------------------------------------------------------------------------------------
11877            
11878             #package TLC
11879            
11880             sub Util_convertDirectoryOfTypedLambdaCalculusFilesToCSVForm
11881             {
11882             if ( scalar(@_) < 3 )
11883             {
11884             return "Sorry, not enough arguments\n";
11885             }
11886             my ( $inputsDirectory, $extension, $outputsDirectory ) = @_;
11887            
11888             my $oldSeparator = $/;
11889            
11890             $/ = "\n";
11891            
11892             opendir(RUNDIR,$inputsDirectory) or die("Could not open run directory $inputsDirectory\n");
11893             my @files = grep ( /\.$extension/i, readdir(RUNDIR));
11894             close(READDIR);
11895            
11896             foreach my $fileIn ( @files )
11897             {
11898             print $fileIn,"\n";
11899             my $fileOut = $fileIn;
11900             $fileOut =~ s/\.$extension/\.CSV/ig;
11901             Util_convertStatMLAlgebraicTheoryFileToCSVForm("$inputsDirectory/$fileIn","$outputsDirectory/$fileOut");
11902             }
11903            
11904             $/ = $oldSeparator;
11905            
11906             }
11907            
11908             sub Util_convertStatMLAlgebraicTheoryFileToCSVForm
11909             {
11910             my ( $fileIn, $fileOut ) = @_;
11911            
11912             my $oldSeparator = $/;
11913             $/ = "\n";
11914            
11915             open (INPUTFILE,"$fileIn") or die ("Could not open input file $fileIn\n");
11916            
11917             my @data = ;
11918             chomp @data;
11919             close(INPUTFILE);
11920            
11921             my @newData = ();
11922             foreach my $datum ( @data )
11923             {
11924             my $CSVExpression = Util_convertLambdaExpressionToCSVForm($datum);
11925             push(@newData,$CSVExpression);
11926             }
11927            
11928             open (OUTPUTFILE,">$fileOut") or die ("Could not open input file $fileOut\n");
11929             print OUTPUTFILE join("\n",@newData);
11930             close(OUTPUTFILE);
11931            
11932             $/ = $oldSeparator;
11933            
11934             }
11935            
11936             sub TLC_OptimizeTLCFile
11937             {
11938             my ( $fileIn, $fileOut ) = @_;
11939            
11940             my $oldFileInputSeparator = $/;
11941             $/ = "\n";
11942            
11943             open (INPUTFILE,"$fileIn") or die ("Could not open input file $fileIn\n");
11944            
11945             my @data = ;
11946             chomp @data;
11947             close(INPUTFILE);
11948            
11949             #First get all of the types in use.
11950             my @typesInUse = ();
11951             foreach my $lambdaExpression ( @data )
11952             {
11953            
11954             my $relationalOperator = "\=";
11955             if ( $lambdaExpression =~ /\~/)
11956             {
11957             $relationalOperator = "\~";
11958             }
11959             my @parts = split(/$relationalOperator/,$lambdaExpression,2);
11960             if ( ! defined($parts[1]))
11961             {
11962             $parts[1] = "";
11963             }
11964            
11965             my ($name,$type);
11966             if ( defined($parts[0]))
11967             {
11968             ($name,$type) = split(/:/,$parts[0]);
11969             }
11970             if ( Util_isInList($type,@typesInUse ) < 0 )
11971             {
11972             push(@typesInUse,$type);
11973             }
11974            
11975             }
11976            
11977             my @lambdaExpressions = ();
11978             foreach my $typeToCheck ( @typesInUse )
11979             {
11980             my @dataForThisType = ();
11981             my $allRHSAreScalars = 1;
11982             my @pastLambdaExpressionsForThisType = ();
11983            
11984             foreach my $lambdaExpression ( @data )
11985             {
11986            
11987             my $relationalOperator = "\=";
11988             if ( $lambdaExpression =~ /\~/)
11989             {
11990             $relationalOperator = "\~";
11991             }
11992             my @parts = split(/$relationalOperator/,$lambdaExpression,2);
11993             if ( ! defined($parts[1]))
11994             {
11995             $parts[1] = "";
11996             }
11997            
11998             my ($name,$type);
11999             if ( defined($parts[0]))
12000             {
12001             ($name,$type) = split(/:/,$parts[0]);
12002             }
12003            
12004             if ( ! defined($type) or $type eq "" )
12005             {
12006             next;
12007             }
12008             if ( $type ne $typeToCheck )
12009             {
12010             next;
12011             }
12012             my $vector = $parts[1];
12013             $vector =~ s/\"|\[|\]//g;
12014             $vector =~ s/^\s+|\s+$//g;
12015             my @data = split(/,|\s+/,$vector);
12016             if ( scalar(@data) == 1 && $data[0] =~ /^[\d\.]*$/ && $allRHSAreScalars )
12017             {
12018             push(@dataForThisType,$data[0]);
12019             push(@pastLambdaExpressionsForThisType,$lambdaExpression);
12020             }
12021             else
12022             {
12023             if ( $allRHSAreScalars == 1 && scalar(@pastLambdaExpressionsForThisType ) > 0 )
12024             {
12025             push(@lambdaExpressions,@pastLambdaExpressionsForThisType);
12026             @pastLambdaExpressionsForThisType = ();
12027             }
12028             $allRHSAreScalars = 0;
12029             push(@lambdaExpressions,$lambdaExpression);
12030             }
12031             }
12032            
12033             if ( $allRHSAreScalars )
12034             {
12035             my $dataForThisTypeString = join(",", @dataForThisType);
12036             my $totalLambdaExpression = $typeToCheck . ":" . $typeToCheck . "=" . "[ " . $dataForThisTypeString . " ] ";
12037             push(@lambdaExpressions,$totalLambdaExpression);
12038             }
12039             }
12040            
12041             open (OUTPUTFILE,">$fileOut") or die ("Could not open input file $fileOut\n");
12042             print OUTPUTFILE join("\n",@lambdaExpressions);
12043             close(OUTPUTFILE);
12044            
12045             $/ = $oldFileInputSeparator;
12046            
12047             }
12048            
12049            
12050            
12051             sub Util_convertDirectoryOfStatMLDataFilesToTypedLambdaCalculus
12052             {
12053             if ( scalar(@_) < 4 )
12054             {
12055             return "Sorry, not enough arguments\n";
12056             }
12057             my ( $inputsDirectory, $extension, $outputsDirectory, $outputExtension, $criterion ) = @_;
12058            
12059             my $oldFileInputSeparator = $/;
12060            
12061             $/ = "\n";
12062            
12063             opendir(RUNDIR,$inputsDirectory) or die("Could not open run directory $inputsDirectory\n");
12064             my @files = grep ( /\.$extension/i, readdir(RUNDIR));
12065             close(READDIR);
12066            
12067             foreach my $fileIn ( @files )
12068             {
12069             print $fileIn,"\n";
12070             my $fileOut = $fileIn;
12071             $fileOut =~ s/\.$extension/\.$outputExtension/ig;
12072             Util_convertStatMLDataToTypedLambdaCalculus("$inputsDirectory/$fileIn","$outputsDirectory/$fileOut",$criterion);
12073             }
12074            
12075             $/ = $oldFileInputSeparator;
12076            
12077             }
12078            
12079            
12080            
12081             #---------------------------------------------------------------------------
12082            
12083            
12084             sub TLC_getModel
12085             {
12086             my ($fileIn) = @_;
12087            
12088             open(FILE,$fileIn) or die("Could not open $fileIn\n");
12089            
12090             my %abstractSyntaxTree = ();
12091            
12092             while()
12093             {
12094             chomp;
12095             next unless (/\w/);
12096             my @data = split(/,/,$_,4);
12097             for ( my $i = 0; $i < scalar(@data); $i++ )
12098             {
12099             $data[$i] =~ s/^\s+|\s+$//g;
12100             }
12101            
12102             my $initialField = $data[0];
12103            
12104             my ( $mainField, $subField ) = split(/\(|\[/,$data[1]);
12105             if ( defined($subField))
12106             {
12107             $subField =~ s/\)|\]//g;
12108             }
12109             my $expression = "";
12110             my $comment = "";
12111            
12112             my $relationalOp = $data[2];
12113             if ( $data[3] =~ /\#/)
12114             {
12115             if ( $data[3] =~ /^\s*\#\s*$/)
12116             {
12117             $expression = $data[3];
12118             $comment = "";
12119             }
12120             else
12121             {
12122             ( $expression, $comment ) = split(/\#/,$data[3]);
12123             $expression .= "\"";
12124             $comment = "\"" . $comment;
12125             }
12126             }
12127             else
12128             {
12129             $expression = $data[3];
12130             }
12131            
12132             $expression =~ s/\#|\"|\[|\]//g;
12133             $expression =~ s/^\s+|\s$//g;
12134             my @fieldNames = split(/[\s,]+/,$expression);
12135            
12136             my %tree = (
12137             mainField => $mainField,
12138             subField => $subField,
12139             relationalOp=>$relationalOp,
12140             expression => $expression,
12141             comment => $comment
12142             );
12143            
12144             my @arrayOfTrees = ();
12145             my $arrayOfTreesRef = $abstractSyntaxTree{$initialField};
12146             if ( defined($arrayOfTreesRef) && $arrayOfTreesRef ne "" )
12147             {
12148             @arrayOfTrees = @$arrayOfTreesRef;
12149             }
12150             else
12151             {
12152             @arrayOfTrees = ();
12153             }
12154             push(@arrayOfTrees,\%tree);
12155            
12156             $abstractSyntaxTree{$initialField} = \@arrayOfTrees;
12157             }
12158             close(FILE);
12159            
12160             return (\%abstractSyntaxTree);
12161             }
12162            
12163             sub Util_reformatMatlabCodeInDirectory
12164             {
12165             use strict;
12166             my @files = <*.M>;
12167             my $iLineReset = 0;
12168             foreach my $file ( @files)
12169             {
12170             open(FILE,$file) or die("Could not open monolix file $file");
12171             open(FILEOUT,">indented/$file");
12172             my @lines = ;
12173             my $indents = "";
12174             for ( my $iLine = 0; $iLine < scalar(@lines); $iLine++)
12175             {
12176             $_ = $lines[$iLine];
12177             chomp;
12178             if (/^\s*function.*=/)
12179             {
12180             $indents = "";
12181             $iLineReset = 0;
12182             }
12183            
12184             if (/^end\s+/)
12185             {
12186             $indents =~ s/ //o;
12187             }
12188             if (/^end\s+/)
12189             {
12190             $indents =~ s/ //o;
12191             }
12192             $_ =~ s/^\s+//g;
12193             $_ =~ s/^\t//g;
12194            
12195             print FILEOUT $indents;
12196             print FILEOUT $_;
12197             if (/^\s*for.*=/)
12198             {
12199             $indents .= " ";
12200             }
12201             if ( $iLineReset == 0 )
12202             {
12203             $indents = " ";
12204             }
12205             print FILEOUT "\n";
12206             }
12207             close(FILEOUT);
12208             }
12209             }
12210            
12211             sub TLC_getExpression
12212             {
12213             my ($abstractSyntaxTreeRef, $initialField) = @_;
12214            
12215             my %abstractSyntaxTree = %$abstractSyntaxTreeRef;
12216            
12217             my $arrayOfTreesRef = $abstractSyntaxTree{$initialField};
12218            
12219             my @arrayOfTrees = @$arrayOfTreesRef;
12220            
12221             my $treeRef = $arrayOfTrees[0];
12222            
12223             my %tree = %$treeRef;
12224            
12225             my $expression = $tree{"expression"};
12226            
12227             $expression =~ s/\#|\"|\[|\]//g;
12228            
12229             return ($expression);
12230             }
12231            
12232             sub TLC_getVector
12233             {
12234             my ($abstractSyntaxTreeRef, $initialField, $subField) = @_;
12235            
12236             my %abstractSyntaxTree = %$abstractSyntaxTreeRef;
12237            
12238             my $arrayOfTreesRef = $abstractSyntaxTree{$initialField};
12239             unless (defined($arrayOfTreesRef) && $arrayOfTreesRef =~ /ARRAY/)
12240             {
12241             print "Error in TLC_getVector - no vector data found for $initialField\n";
12242             return("")
12243             }
12244             my @arrayOfTrees = @$arrayOfTreesRef;
12245            
12246             my $expression = "";
12247             for ( my $i = 0; $i < scalar(@arrayOfTrees); $i++ )
12248             {
12249            
12250             my $treeRef = $arrayOfTrees[$i];
12251             my %tree = %$treeRef;
12252            
12253             my $subFieldHere = $tree{"mainField"};
12254            
12255             if ( !defined($subField) or $subField eq "" or $subFieldHere =~ /^$subField$/i )
12256             {
12257             $expression = $tree{"expression"};
12258             last;
12259             }
12260             }
12261            
12262             $expression =~ s/\#|\"|\[|\]//g;
12263             $expression =~ s/^\s+|\s$//g;
12264             my @fieldNames = split(/[\s,]+/,$expression);
12265            
12266             return (\@fieldNames);
12267             }
12268            
12269             sub TLC_getSetOfVectors
12270             {
12271             my ($abstractSyntaxTreeRef, $initialField,$subField ) = @_;
12272            
12273             my %abstractSyntaxTree = %$abstractSyntaxTreeRef;
12274            
12275             my $arrayOfTreesRef = $abstractSyntaxTree{$initialField};
12276             my @arrayOfArrays = ();
12277             unless ( $arrayOfTreesRef =~ /ARRAY/)
12278             {
12279             print "No set of vectors found for $initialField\n";
12280             return ( \@arrayOfArrays);
12281             }
12282             my @arrayOfTrees = @$arrayOfTreesRef;
12283            
12284             for ( my $i = 0; $i < scalar(@arrayOfTrees); $i++ )
12285             {
12286            
12287             my $treeRef = $arrayOfTrees[$i];
12288             my %tree = %$treeRef;
12289             my $expression = $tree{"expression"};
12290            
12291             $expression =~ s/\#|\"|\[|\]//g;
12292             $expression =~ s/^\s+|\s$//g;
12293             my @fieldNames = split(/[\s,]+/,$expression);
12294            
12295             push(@arrayOfArrays,\@fieldNames);
12296            
12297             }
12298            
12299             return (\@arrayOfArrays);
12300             }
12301            
12302             sub TLC_getLengthOfFirstDimension
12303             {
12304             my ($abstractSyntaxTreeRef, $initialField ) = @_;
12305            
12306             my %abstractSyntaxTree = %$abstractSyntaxTreeRef;
12307            
12308             my $sizeOfDimension = 0;
12309            
12310             my $arrayOfTreesRef = $abstractSyntaxTree{$initialField};
12311            
12312             if ( defined($arrayOfTreesRef ) && $arrayOfTreesRef =~ /ARRAY/)
12313             {
12314             my @arrayOfTrees = @$arrayOfTreesRef;
12315             $sizeOfDimension = scalar(@arrayOfTrees);
12316             }
12317             else
12318             {
12319             print "ERROR: No array info found for $initialField\n";
12320             return ("");
12321             }
12322            
12323             return ($sizeOfDimension);
12324             }
12325            
12326             sub TLC_getSingleVector
12327             {
12328             my ($abstractSyntaxTreeRef, $initialField,$subField ) = @_;
12329            
12330             my %abstractSyntaxTree = %$abstractSyntaxTreeRef;
12331            
12332             my $arrayOfTreesRef = $abstractSyntaxTree{$initialField};
12333            
12334             my @singleArray = ();
12335            
12336             if ( defined($arrayOfTreesRef ) && $arrayOfTreesRef =~ /ARRAY/)
12337             {
12338             my @arrayOfTrees = @$arrayOfTreesRef;
12339            
12340             for ( my $i = 0; $i < scalar(@arrayOfTrees); $i++ )
12341             {
12342            
12343             my $treeRef = $arrayOfTrees[$i];
12344             my %tree = %$treeRef;
12345             my $expression = $tree{"expression"};
12346            
12347             $expression =~ s/\#|\"|\[|\]//g;
12348             $expression =~ s/^\s+|\s$//g;
12349             my @fieldNames = split(/[\s,]+/,$expression);
12350            
12351             push(@singleArray,@fieldNames);
12352            
12353             }
12354             }
12355             else
12356             {
12357             print "ERROR: No array info found for $initialField\n";
12358             return ("");
12359             }
12360            
12361             return (\@singleArray);
12362             }
12363            
12364            
12365            
12366             sub TLC_getSetOfEquations
12367             {
12368             my ($abstractSyntaxTreeRef, $initialField) = @_;
12369            
12370             my %abstractSyntaxTree = %$abstractSyntaxTreeRef;
12371            
12372             my @arrayOfArrays = ();
12373            
12374             my $arrayOfTreesRef = $abstractSyntaxTree{$initialField};
12375             if ( ref($arrayOfTreesRef) && $arrayOfTreesRef =~ /ARRAY/ )
12376             {
12377             my @arrayOfTrees = @$arrayOfTreesRef;
12378            
12379            
12380             for ( my $i = 0; $i < scalar(@arrayOfTrees); $i++ )
12381             {
12382            
12383             my $treeRef = $arrayOfTrees[$i];
12384             my %tree = %$treeRef;
12385             my $expression = $tree{"expression"};
12386            
12387             my @parts;
12388             $parts[0] = $tree{"mainField"};
12389             $parts[1] = $tree{"subField"};
12390             $parts[2] = $tree{"relationalOp"};
12391             $parts[3] = $tree{"expression"};
12392             $parts[4] = $tree{"comment"};
12393            
12394             push(@arrayOfArrays,\@parts);
12395            
12396             }
12397             }
12398            
12399             return (\@arrayOfArrays);
12400             }
12401            
12402            
12403             sub TLC_getSubExpression
12404             {
12405             my ($abstractSyntaxTreeRef, $initialField, $subField) = @_;
12406            
12407             my %abstractSyntaxTree = %$abstractSyntaxTreeRef;
12408            
12409             my $arrayOfTreesRef = $abstractSyntaxTree{$initialField};
12410             my @arrayOfTrees = @$arrayOfTreesRef;
12411            
12412             my $expression = "";
12413             for ( my $i = 0; $i < scalar(@arrayOfTrees); $i++ )
12414             {
12415            
12416             my $treeRef = $arrayOfTrees[$i];
12417             my %tree = %$treeRef;
12418            
12419             my $subFieldHere = $tree{"mainField"};
12420            
12421             if ( $subFieldHere eq $subField )
12422             {
12423             $expression = $tree{"expression"};
12424             last;
12425             }
12426             }
12427            
12428             return ($expression);
12429             }
12430            
12431             sub deletedCode
12432             {
12433            
12434            
12435             my $stateVariablesRef = getSubTree($globalASTRef,"PK_STATE_VARIABLES");
12436             if ( ref($stateVariablesRef) )
12437             {
12438             my $stateVariables = $$stateVariablesRef;
12439             }
12440             else
12441             {
12442             my $stateVariables = $stateVariablesRef;
12443             }
12444            
12445             }
12446            
12447             sub toInteger
12448             {
12449             my $num = $_[0];
12450             my $iNum = sprintf("%d",$num);
12451             return ( $iNum );
12452             }
12453            
12454             1;
12455            
12456            
12457             #---------------------------------------------------------------------------
12458            
12459             1;
12460             __END__