gauss naar matlab via perl HELP

[Verwijderd]

Beste allemaal,

Voor mijn scriptie maak ik gebruik van het programma matlab, het idee is dat ik voor een deel een oud onderzoek repliceer. Nu ben ik niet echt een held met programmeren en is dit ook niet echt het doel van mijn studie (financiele economie) en heb ik de gauss code / program gevonden die het werk voor mij doet. Het enige is dat ik dien te werken in Matlab aangezien Gauss niet beschikbaar is op mijn universiteit (EUR). Verder heb ik een programma gevonden dat gauss code kan omzetten/converteren naar Matlab. Alleen dit gaat 'via' Perl en dit heb ik niet in mijn bezit. Het is een relatief klein programma en de vraag is zou iemand dit voor mij kunnen doen?

Als er dus iemand is die in het bezit is van Perl en die zo vriendelijk zou willen zijn om het programma om te zetten zou dat voor mij fantastisch zijn.

onderstaand vind je de code in gauss en het program om het in 'via' perl om te zetten.

p.s. als iemand me uit kan leggen hoe ik het zelf doe dan is dat ook al helemaal geweldig.


gauss code:

@ program for computing the equity premium in the Mehra
and Prescott, JME 1985, economy @
ns=2; @ specify the no. of states @


@ specify the Markov Transition probabilities @
fi11=0.43;
fi12=1-fi11;
fi22=0.43;
fi21=1-fi22;

fi=zeros(ns,ns);
fi[1,1]=fi11; fi[1,2]=fi12;
fi[2,1]=fi21; fi[2,2]=fi22;

@ Here we solve for the stationary probabilities of the states
we solve the system of equations: pi = fi'*pi st. sum(pi)=1
where pi is the vector of stationary probabilities. @
pi1=fi';
pi2=pi1[1:ns-1,1:ns-1]-ones(ns-1,1)*pi1[1:ns-1,ns]';
pi3=pi1[1:ns-1,ns];
plr=(inv(eye(ns-1)-pi2))*pi3;
pst=zeros(ns,1);
pst[1:ns-1]=plr; pst[ns,1]=1-sumc(plr);

@ specify the mean growth rates for the ns states of nature @
l1=1.054;
l2=0.982;
l=zeros(ns,1);
l[1,1]=l1; l[2,1]=l2;

@ create a vector with different values of alfa - the
coefficient of relative risk aversion @
alfa=seqa(0.01,0.025,400);

@ create a vector with different values of beta @
bstar=seqa(0.999999999,-0.000075,10);

rft=zeros(rows(alfa),rows(bstar));
re=zeros(rows(alfa),rows(bstar));
ep=zeros(rows(alfa),rows(bstar));

@ now compute risk-free rate, equity return, and the
equity premium for all combinations of the risk
aversion parameter and the discount factor @
i=1;
do until i>rows(alfa);
alfa1=alfa[i,1];
j=1;
do until j>rows(bstar);
beta=bstar[j,1];

@ compute the uncontional expectation of the risk free rate @
pf=beta*fi*(l^(-alfa1));
rfs=pf^(-1)-1;
rf=pst'*rfs;

@ set up the matrices for the computation of the
constants w @
la=l^(1-alfa1);
lb=eye(ns).*la;
x=beta*fi*lb;
f=eye(ns)-x; g=sumc(x');
w=(inv(f))*g;

@ compute the unconditional expectation of equity return @
wa=w+ones(ns,1); wb=(wa./w')';
la=eye(ns).*l;
rss=wb*la-ones(ns,ns);
rs=sumc((fi.*rss)');

rft[i,j]=rf;
re[i,j]=pst'*rs;
ep[i,j]=100*(re[i,j]-rf);

j=j+1;
endo;
i=i+1;
endo;


ep1=zeros(rows(alfa),rows(bstar));
rf1=zeros(rows(alfa),rows(bstar));


@ now we eliminate those observations which imply a risk-free
rate above 4 percent @
i=1;
do until i>rows(rft);

if rft[i,1]<0.04;

j=1;
do until J>cols(rft);

if rft[i,j]<0.04;
rf1[i,j]=rft[i,j];
ep1[i,j]=ep[i,j];
j=j+1;
else; goto stop1;
endif;
endo;

stop1:

endif;
i=i+1;
endo;

@ now we put all the risk free rates and equity premia
in one long vector @
rf2=reshape(rf1,rows(rf1)*cols(rf1),1);
ep2=reshape(ep1,rows(rf1)*cols(rf1),1);

@ now we sort the observations in terms of increasing risk free
rates @
ind=sortind(rf2);
rf3=rf2[ind];
ep3=ep2[ind];

@ finally we plot the result @
library pgraph;
title("the Equity premium in the Mehra-Prescott, 1985, economy");
xlabel("the risk-free rate (%)");
ylabel("the equity premium (%)");

bar(100*rf3,ep3);


program + link voor conversie program ( http://www.cameronrookley.com/gtoml/maingtm.html )

#!/bin/usr/perl;
# GAUSS TO MATLAB PERL SCRIPT (Ver. 1.0) - FOR GAUSS PROGRAM SCRIPTS (which
# start with the new command) OR PROCEDURES WITH A SINGLE MAIN FUNCTION
#
#
# USAGE: perl gtoml gauss_file_name > output_file_name
#
# where: gauss_file_name is the source code to translate (eg. program.g)
# output_file_name is the m-file created
#
#
# WRITTEN BY CAMERON ROOKLEY, DEPT. OF FINANCE, UNIV. OF ARIZONA
# e-mail: [e-mail]
# homepage: http://www.goodnet.com/~dh74673/home.htm
# GTOML homepage: http://www.goodnet.com/~dh74673/gtoml.htm
#
## THE FIRST COMMENT LINE IS UNIX SPECIFIC, WINTEL SYSTEMS WILL IGNORE IT
# first check to see if gauss "new" command issued
# new indicates program is a script
# absense of new indicates it is a self-contained procedure
# also in first pass toss proc() and retp() statements into an array
# and check to see if any global declaration files are need due to a
# #include statement
$pcasedum=0; #dummy to print main cases line by line for debugging
$newdum=0; #dummy to flag whether the gauss 'new' command issued
$nuke1proc=0; #dummy to deal with where 1st procedure printed
$incldum=0; #dummy indicating whether an #include file is found
$pi=0; $ri=0; $ei=0; #indices for number of proc,retp,endp statements
$frethit=0; #used to help count number of retp statements in each proc
# SECTION 1 obtain key information for setting up functions
while (<>){
if (/\s?new\;/){ $newdum=1;}
if (/\s?proc.*\;/){
$proc[$pi]= $_;
++$pi;
}
if (/\s?retp.*\;/ || /\s?retp\;/){
$rets[$ri]= $_;
if ($frethit==0){
$mretdum[$ri]=0; # multiple return dummy
$firstretdum[$ri]=1; # first return dummy
}
else{$mretdum[$ri-1]=1;
$mretdum[$ri]=1;
$firstretdum[$ri]=0; # first return dummy
}
++$ri;
$frethit=1;} # first return hit flag
if (/endp/){ $frethit=0; ++$ei;};
if (/\#include/){
$decdum=1;
$incfname=$_;
$incfname =~ s/(\#include )(.*)(\;)/\2/;
$incfname =~ s/(\#include )(.*)/\2/; # in the event ; not incl.
# drop any path or drive letter associated with new dec filename
if ($incfname =~ /\\/){
$incfname =~ s/(.*)(\\)(.*)/\3/;}
if ($incfname =~ /\:/){
$incfname =~ s/(.*)(\:)(.*)/\3/;}
$outfname=$incfname;
$outfname =~ s/(.*)(\..*)/\1d\.m/;
$outfname =~ s/\n//;
}
}
close(ARGV);
open(ARGV);
#SECTION 2
# initilize arrays for procs and rets strings
if ($ei != $pi){
print "Error: number of proc( ) statements ".$pi." does not match number
of endp\n statements!!!".$ei."\n";
exit;}
$retind=0;
$nrets=$ri-1;
$i=0; $ri=0;
while ($i <= $nrets)
{
$rets[$i] =~ s/retp\((.*)\,(.*)\)\;/\[\1\,\2\]/;
$rets[$i] =~ s/retp\((.*)\)\;/\1/;
$rets[$i] =~ s/retp\;//;
$rets[$i] =~ s/\n//;
$rets[$i] =~ s/\/\*.*\*\///;
if ($rets[$i] =~ /[\(\)\~\|\+\-\*\/\^\>\<\=]/ || $mretdum[$i]==1)
{
if ($firstretdum[$i]==1){
$compos=index($rets[$i],",");
if ($compos != -1)
{
# grab whole string ['s and all
$reststring=substr($rets[$i],$compos+1,length($reststring)-1);
# first chunk up to first comma
$retarg="ret".$retind."=".substr($rets[$i],0,$compos);
$newretarg=&transproc($retarg);
$spec[$i]=$newretarg;
$retind=$retind+1;
$compos=index($reststring,",");
while ($compos !=-1)
{
$retarg="ret".$retind."=".substr($rets[$i],0,$compos);
$newretarg=&transproc($retarg);
$spec[$i]=$spec[$i].$newretarg;
$reststring=substr($reststring,$compos+1);
$compos=index($reststring[$i],",");
$retind=$retind+1;
}
$retarg="ret".$retind."=".$reststring;
$newretarg=&transproc($retarg);
$spec[$i]=$spec[$i].$newretarg;
$spec[$i]=~ s/\[//;
$spec[$i]=~ s/\]//;
$rets[$i]="["."ret".$ri.",";
$ri=$ri+1;
while ($ri<($retind))
{
$rets[$i]=$rets[$i]."ret".$ri.",";
$ri=$ri+1;
}
$rets[$i]=$rets[$i]."ret"."$ri"."]";
}
else{
$spec[$i]="ret".$retind."=".$rets[$i].";\n";
$rets[$i]="ret".$ri;}
$retind=$retind+1; $ri=$ri+1;
$lastspec=$spec[$i];
$lastret=$rets[$i];
}
else{ $spec[$i]=$lastspec;
$rets[$i]=$lastret;}

}
else{$spec[$i] = "";}
$i=$i+1;
}

$i=0; $fni=0;
#SECTION 3
while ($i <= $nrets){
$proc[$i] =~ s/proc\(.*\)\=(.*\(.*\))\;/\1/;
$proc[$i] =~ s/proc(.*\(.*\))\;/\1/;
$proc[$i] =~ s/proc\(.*\)\=(\w.*)\;/\1/;
$proc[$i] =~ s/proc\s*(\w*)\;/\1/;
# remove and identify any function names passed as arguments
# start mining for &'s
if ($proc[$i] =~ /\&/){
$nfnames[$i]=0;
while ($proc[$i] =~ /\&/){
if ($proc[$i] =~ /\,\&(\w*)(\)|\,)/){
$proc[$i] =~ s/\,\&(\w*)(\)|\,)/\,\1\2/;
$fnamestr[$fni]=$1;
if ($nfnames[$i]==0){
$prfnames[$i]=$1;}
else{$prfnames[$i]=$prfnames[$i]." and ".$1;}
$nfnames[$i]=$nfnames[$i]+1;
$fni=$fni+1;}
elsif ($proc[$i] =~ /\(\&(\w*)(\)|\,)/){
$proc[$i] =~ s/\(\&(\w*)(\)|\,)/\(\1\2/;
$fnamestr[$fni]=$1;
$prfnames[$i]=" ".$prfnames[$i].$1;
$fni=$fni+1;}
}
}
else{$prfnames[$i]="";
$nfnames[$i]=0;}
$proc[$i] =~ s/proc\(.*\)\=(.*\(.*\))\;/\1/;
$proc[$i] =~ s/proc (.*\(.*\))\;/\1/;
$proc[$i] =~ s/proc\(.*\)\=(\w*)\;/\1/;
$proc[$i] =~ s/proc\s*(\w*)\;/\1/;
# purge line feed on procedure declaration
$proc[$i] =~ s/\n//;
# purge comments attached to procedure declaration
$proc[$i] =~ s/\/\*.*\*\///;
$i=$i+1;
}
# if newdum=0 assume code is a procedure and write main function call line
# also write Matlab specific messages to file header in comments
if ($newdum == 0){
if ($proc[0] =~ /\(.*\)/){
print "function ".$rets[0]."=".$proc[0]."\n";
print "% ".$rets[0]."=".$proc[0]."\n";
}else{
print "function ".$proc[0]."\n";
print "% ".$proc[0]."\n";
}
print "%\n";
print "% Add brief description for function in line above for Matlab help searches\n";
if ($prfnames[$0] ne ""){
if ($nfnames[$0]>1){
print "% Note: ".$prfnames[$0]." are function names and must be passed as strings\n";
}else{
$prfnames[$0]=~ s/and//;
print "% Note: ".$prfnames[$0]." is a function name and must be passed as a string\n";
}
}
if ($decdum==1){
$outfname=~ s/\n//;
print "%\n";
print "% NOTE: YOU MUST ISSUE THE COMMAND: \"run ".$outfname."\"\n";
print "% TO INITIALIZE GLOBAL VARIABLES BEFORE CALLING THIS PROCEDURE!!! \n";
print "%\n";}
$procind=1;
$nuke1proc=1;}
$retind=0;
$j=0; $k=0;
# set up a main return index
while ($j<$ri+1){
if ($firstretdum[$j]==1)
{ $mainret[$k]=$rets[$j];
++$k;
++$j;}
else{++$j;}}

###################################################################
# START OF MAIN PROCEDURE IS HERE - GO THROUGH COMMENTS AND CODE ONE
# LINE AT A TIME, SEPERATING CODE AND COMMENT FRAGMENTS
# CALLING TRANSCODE TO TRANSLATE CODE TO GAUSS ETC.

$comflag=0; # open comment flag
while (<>){
if ($newdum==0)
{
if ($nuke1proc==1) #nuke1proc is a dummy to nuke 1st proc & do nothing
#as replacement already taken care of in header
{
if (/proc.*\;/)
{
s/proc\(.*\)\=(.*\(.*\))\;//;
s/proc (.*\(.*\))\;//;
s/proc\(.*\)\=(\w*)\;//;
s/proc\s*(\w*)\;//;
$nuke1proc=0;}
}
else{
if (/proc.*\;/)
{
print "function ".$mainret[$procind]."=".$proc[$procind]."\n";
if ($prfnames[$procind] ne ""){
if ($nfnames[$procind]>1){
print "% Note: ".$prfnames[$procind]." are function names and must be passed as strings\n";
}else{
$prfnames[$procind]=~ s/and//;
print "% Note: ".$prfnames[$procind]." is a function name and must be passed as strings\n";
}
}
s/proc\(.*\)\=(.*\(.*\))\;//;
s/proc (.*\(.*\))\;//;
s/proc\(.*\)\=(\w*)\;//;
s/proc\s*(\w*)\;//;
$procind=$procind+1;
}
}
}
if (/retp/)
{
print $spec[$retind];
s/\s?retp\(.*\).*//;
s/\s?retp\;//;
$retind=$retind+1;
}
s/\s?endp\s?\;/\/\* End of function \*\//;
if ( /^(\/\*|\s \/\*|\s\/\*|\s *\/\*)/ && (/(\*\/\s |\*\/)$/) && (/;/==0) &&
($comflag==0)) {
#closed comment
if ($pcasedum==1){ print "case1: \n"; }
$opcomind=index($_,"/*");
$chcom=substr($_,$opcomind+3);
$clcomind=index($chcom,"*/");
$chcom=substr($chcom,0,$clcomind-1);
print "% ".$chcom;
print "\n";
$comflag=0;
}
elsif (/^(\/\*|\s \/\*|\s\/\*|\s *\/\*)/ && ((/;/)==0) && ($comflag==0)) {
#open left comment
if ($pcasedum==1){ print "case2: \n";}
$opcomind=index($_,"/*");
$chcom=substr($_,$opcomind+3);
print "% ".$chcom;
$comflag=1;
}
elsif ((/(\*\/\s |\*\/)$/) && /\/\*/==0 && /;/==0 && ($comflag==1)) {
# closing right comment
if ($pcasedum==1){ print "case3: \n";}
$opcomind=index($_,"*/");
if (opcomind>2){
$chcom=substr($_,$opcomind-2);
print "% ".$chcom;}
else {
print "% "; }
print "\n";
$comflag=0;
}
elsif (/\/\*/ && (/(\*\/\s |\*\/)$/) && (/;/ == 1) && ($comflag==0)){
#code-closed comment
if ($pcasedum==1){ print "case4: \n";}
$comflag=0;
$comind=index($_,"/*");
$code=substr($_,0,$comind-1);
$comm=substr($_,$comind,length($_));
$comm =~ s/\/\*/\%/g;
$comm =~ s/\*\///g;
$newcode=&transproc($code);
print $newcode.$comm;
}
elsif (/\/\*/ && (/\*\//==0) && (/;/ == 1) and ($comflag==0)) {
#code followed by open left comment
if ($pcasedum==1){ print "case5: \n";}
$comflag=1;
$comind=index($_,"/*");
$code=substr($_,0,$comind-1);
$comm=substr($_,$comind,length($_));
$comm=~s/\/\*/\%/g;
$comm=~s/\*\\//g;
$newcode=&transproc($code);
print $newcode.$comm;
}
elsif ((/\/\*/==0) && (/\*\//==1) && (/;$/==1) and ($comflag==0)) {
#closing right comment followed by completed code
if ($pcasedum==1){ print "case6: \n";}
$comflag=0;
$comind=index($_,"/*");
$comm=substr($_,0,$comind-1);
$comm=~s/\/\*/\%/g;
$comm=~s/\*\\//g;
$code=substr($_,$comind+2,length($_)-length($comm));
$newcode=&transproc($code);
print $comm;
print "\n";
print $newcode;
}
elsif ((/\/\*/==0) && (/\*\//==0) && (/(;\s |;)$/) && ($comflag==0)) {
if ($pcasedum==1){ print "case7: \n";}
#single line of code
$comflag=0;
$newcode=&transproc($_);
print $newcode;
}
elsif ((/\/\*/==0) && (/\*\//==0) && (/;/==0) && ($comflag==0) && ($_ ne "\n")
&& ($_ ne ""))
{
if ($pcasedum==1){ print "case8: \n";}
#incomplete line of code continued on next line
$comflag=0;
$newcode=&transproc($_);
$newcode =~ s/\n//;
if ($newcode =~ /\;/){
print $newcode;}
else{
if ($newcode =~ /\w/){
print $newcode."...";
print "\n";}}
}
elsif ($_ eq ""){
if ($pcasedum==1){ print "case9: \n";}
if ($comflag==1){
print "% \n";}
else {
print "\n";}
}
elsif ((/\*\//==0) && ($comflag==1))
{#continuation of a comment
if ($pcasedum==1){ print "case10: \n";}
print "% ".$_;
$comflag=1;
}
elsif ((/\*\//==1) && (/\/\*/==1) && index($_,"/*")<index($_,"*/") &&
($comflag==1))
{#continuation of comment in the presense of nested comment
if ($pcasedum==1){ print "case11: \n";}
print "% ".$_;
$comflag=1;
}
elsif ((/\/\*/==0) && (/\*\//==0) && (/;/==0) && ($comflag==0)){
#completion of code from previous line
if ($pcasedum==1){ print "case12: \n";}
$newcode=&transproc($_);
print $newcode;
$comflag=0;
}
else {
if ($pcasedum==1){ print "case13: \n";}
print "% UNKNOWN LINE STRUCTURE ENCOUNTERED THE FOLLOWING\n";
print "% LINE OF CODE WAS NOT TRANSLATED:\n";
print $_;
}
}
close(ARGV); # close standard input file
exit;

################################################################
# MAIN ENGINE TO TRANSLATE GAUSS CODE TO MATLAB
# SEVERAL SIMPLE SEARCH AND REPLACES
# FOLLOWED BY AN UGLY SECTION WHICH DEALS WITH VERT. AND HORIZ.
# CONCATINATION

sub transproc{
#purge extraneous spaces
$thiscode=@_[0];
if ($thiscode =~ /^\s/==1){
$initspace=$thiscode;
$initspace =~ s/(^\s?)(\S*)/\1/g;}
else{
$initspace="";
}
while ($thiscode =~/\W\s/){
$thiscode =~ s/(\W)(\s)/\1/;
}
while ($thiscode =~/\s\W/){
$thiscode =~ s/\s(\W)/\1/;
}
$initspace =~ s/\n//g;
$initspace =~ s/\S*//g;
$thiscode= $initspace.$thiscode;
$thiscode = $thiscode."\n";
# convert code fragments to lower case
$thiscode =~ tr/A-Z/a-z/;
#nuke local declarations with and without carriage returns
$thiscode =~ s/local .*;\n//ig;
$thiscode =~ s/local .*;//ig;
# search for any include (global declaration) files
if (/\#include/){
$incfname=$_;
$incfname =~ s/(\#include\;)(.*)(\;)/\2/;
$incfname =~ s/(\#include)(.*)/\2/; # in the event ; not incl.
$decline=&decproc($incfname);
$thiscode=$decline;
#if (($thiscode=~ /\n/)==0){ $thiscode=$thiscode."\n";}
}
if ($fni>0)
{
$i=0;
while ($i <= $fni-1){
$thiscode =~s/($fnamestr[$i])\(/feval\(\1\,/;
$i=$i+1;
}
}
# change function names passed to functions to strings
if ($thiscode =~ /\w\(.*\&\w*\W?\)/){
$thiscode =~ s/(\w\(.*)(\&)(\w*)(\W?\))/\1\'\3\'\4/;
}
# change square brackets to round for matrix indexing
# do this before {'s changed to ]
$thiscode =~ s/\[/\(/g;
$thiscode =~ s/\]/\)/g;
#change notation for matrix assignments
$thiscode =~ s/\{(.*)\}\s?\=/\[\1\]\=/;
if ($thiscode =~ /\=\s?\{(.*)\}/){
$lbind=index($thiscode,"{");
$rbind=index($thiscode,"}");
$argum=substr($thiscode,$lbind+1,$rbind-$lbind);
$argum =~ s/\,/\;/;
$thiscode=substr($thiscode,0,$lbind)."[".$argum."]".
substr($thiscode,$rbind+1);
print "newline:";
}
#simple search and replacements
# FEEL FREE TO ADD YOUR OWN REPLACEMENTS IN THIS SECTION
$thiscode =~ s/sumc/sum/ig;
$thiscode =~ s/prodc/prod/ig;
$thiscode =~ s/meanc/mean/ig;
$thiscode =~ s/dos\s?\^(\w*)\;/dos\(\1\)\;/ig;
$thiscode =~ s/dos\s?\"(.*)\"\;/dos \(\'\1\'\)\;/ig;
$thiscode =~ s/seqa\((.*)\,(.*)\,(.*)\)/\(\1\:\2:\3\)/ig;
$thiscode =~ s/cumsumc/cumsum/ig;
$thiscode =~ s/cumprodc/cumprod/ig;
$thiscode =~ s/meanc/mean/ig;
$thiscode =~ s/stdc/std/ig;
$thiscode =~ s/minc/min/ig;
$thiscode =~ s/maxc/max/ig;
$thiscode =~ s/sortc/sortrows/ig;
$thiscode =~ s/rndu/rand/ig;
$thiscode =~ s/eigv/eig/ig;
$thiscode =~ s/maxc/max/ig;
$thiscode =~ s/cdfn\((.*)/normcdf\(\1,0,1/ig;
$thiscode =~ s/pdfn\((.*)/normpdf\(\1,0,1/ig;
$thiscode =~ s/title\(\"(.*)\"\)/title\(\'\1\')/ig;
$thiscode =~ s/xlabel\(\"(.*)\"\)/xtitle\(\'\1\')/ig;
$thiscode =~ s/ylabel\(\"(.*)\"\)/ytitle\(\'\1\')/ig;
$thiscode =~ s/zlabel\(\"(.*)\"\)/ztitle\(\'\1\')/ig;
$thiscode =~ s/title\((.*)\)/title\(\1\)/ig;
$thiscode =~ s/xlabel\((.*)\)/xtitle\(\1\)/ig;
$thiscode =~ s/ylabel\((.*)\)/ytitle\(\1\)/ig;
$thiscode =~ s/zlabel\((.*)\)/ztitle\(\1\)/ig;
$thiscode =~ s/(\s*)(xy)(\(.*)/plot\3/ig;
$thiscode =~ s/(\s*)(xyz)(\(.*)/plot3\3/ig;
$thiscode =~ s/^(xy)(\(.*)/plot\2/ig;
$thiscode =~ s/^(xyz)(\(.*)/plot3\2/ig;
$thiscode =~ s/(surface)(\(.*)/surf\2/ig;
$thiscode =~ s/zlabel\((.*)\)/ztitle\(\1\)/ig;
$thiscode =~ s/\[\.,/\[:,/g;
$thiscode =~ s/\,\.\]/\,\:\]/g;
$thiscode =~ s/endif/end/ig;
$thiscode =~ s/endo/end/ig;
$thiscode =~ s/do while/while/ig;
$thiscode =~ s/and/&/ig;
$thiscode =~ s/\Wor\W/\|/ig;
$thiscode =~ s/\!\=/~=/ig;
$thiscode =~ s/\.</</ig;
$thiscode =~ s/\.>/>/ig;
$thiscode =~ s/\.\=\=/\=\=/ig;
$thiscode =~ s/(\W)(le)(\W)/\1\<\=\3/ig;
$thiscode =~ s/(\W)(ge)(\W)/\1\>\=\3/ig;
$thiscode =~ s/(\W)(\.le)(\W)/\1\<\=\3/ig;
$thiscode =~ s/(\W)(\.ge)(\W)/\1\>\=\3/ig;

#### CONCATINATION SECTION
# find the index of any |'s if they exist
$pos=index($thiscode,"|");
while ($pos != -1) # if |'s exist continue
{
$lbpos=$pos-1; # initialize left [ bracket to fall to left of |
# if position to immed. left of | is a ) or ")'" start counting L&R )'s
if ( (substr($thiscode,$lbpos,1) eq ")") ||
(substr($thiscode,$lbpos-1,2) eq ")'")){
if (substr($thiscode,$lbpos,1) eq ")"){
$nrb=1;
$lbpos=$lbpos-1;}
elsif (substr($thiscode,$lbpos,1) eq "'" &&
substr($thiscode,$lbpos-1,1)){
$nrb=1;
$lbpos=$lbpos-2;
}
else{$lbpos=$lbpos-1;}
$nlb=0;
while ($nrb>$nlb){
if (substr($thiscode,$lbpos,1) eq ")"){
$nrb=$nrb+1; }
if (substr($thiscode,$lbpos,1) eq "("){
$nlb=$nlb+1; }
$lbpos=$lbpos-1;
}
}
# once [ position pushed beyond last bracket match start looking for
# first non-word to the left
$cont=1;
while ($cont==1){
if ((substr($thiscode,$lbpos,1) =~/\W/)
&& (substr($thiscode,$lbpos,1) ne "'"))
{
$cont=0;}
else{
$lbpos=$lbpos-1;}
}
# insert left bracket at appropriate position, truncate "newstring" to first |
# create reststring which consists of what follows
if (substr($thiscode,$lbpos,1) eq "("){
#start counting brackets and drop ] immediately before match
$newstring=substr($thiscode,0,$lbpos+1)."[";
$reststring=substr($thiscode,$lbpos+1);
$nlb=1; $nrb=0;
$cont=1;
while ($cont==1){
if (substr($reststring,0,1) eq ")"){$nrb=$nrb+1;}
if (substr($reststring,0,1) eq "("){$nlb=$nlb+1;}
if (substr($reststring,0,1) eq "|"){
$newstring=$newstring.";";
$reststring=substr($reststring,1);}
else{
$newstring=$newstring.substr($reststring,0,1);
$reststring=substr($reststring,1);}
if ($nlb==$nrb){$thiscode=substr($newstring,0,length($newstring)-1)
."]".substr($newstring,length($newstring)-1,1).$reststring;
$cont=0;}
}
$pos=index($thiscode,"|"); # check for more | left off by ~
}
else{
$newstring=substr($thiscode,0,$lbpos+1)."[".substr($thiscode,$lbpos+1,$pos-$lbpos-1).";";
$reststring=substr($thiscode,$pos+1);

$cont=1;
$rbpos=0;
while ($cont==1)
{
# check to see if any more |'s exist before next ~ or terminating ;
$pos=index($reststring,"|");
# if not, initialize right bracket position for ] to immed. right last |
if ($pos==-1){
$cont=0;}
else{
# if more |'s exist, check to see if ~ exist
if ( (index($reststring,"~")<index($reststring,"|"))
&& index($reststring,"~") != -1)
{
$cont=0;}
else{
# if not keep adding chunks to "newstring"
$newstring=$newstring.substr($reststring,0,$pos).";";
$reststring=substr($reststring,$pos+1);
}}}
$rbpos=0;
$nrb=0; $nlb=0;
# ] position is currently to immediate right of last |
# check to see if this position is a left bracket
if (substr($reststring,$rbpos,1) eq "("){
# if it is, count brackets and push ] position to right
$nrb=0; $nlb=1; $rbpos=$rbpos+1;
while ($nlb>$nrb){
if (substr($reststring,$rbpos,1) eq ")"){
$nrb=$nrb+1;
}
if (substr($reststring,$rbpos,1) eq "("){
$nlb=$nlb+1;
}
$rbpos=$rbpos+1
}
if (substr($reststring,$rbpos,1) eq "'"){
$rbpos=$rbpos+1;}

}
$cont=1;
while ($cont==1){
# if non-word hit piece everything together
if (substr($reststring,$rbpos,1) =~ /\(/){
$rbpos=$rbpos+1;
$nlb=$nlb+1;}
if (substr($reststring,$rbpos,1) =~ /\)/){
$rbpos=$rbpos+1;
$nrb=$nrb+1;}
if (substr($reststring,$rbpos,1) =~/\W/){
if ($nlb==$nrb){
$cont=0;
if (substr($reststring,$rbpos,1) eq "'"){
$rbpos=$rbpos+1;}
$thiscode=$newstring.substr($reststring,0,$rbpos).
"]".substr($reststring,$rbpos);
}
else{$rbpos=$rbpos+1;}
}
# else keep sliding right
else{
$rbpos=$rbpos+1;}
}

} # this ends bracket searching branch
$pos=index($thiscode,"|"); # check for more | left off by ~
}

# now do horizontal concatination
# may have to count square brackets as well
# find the index of any ~'s if they exist
$pos=index($thiscode,"~");
while ($pos != -1) # if ~'s exist continue
{
$lbpos=$pos-1; # initialize left [ bracket to fall to left of ~
# if position to immed. left of ~ is a ) start counting L&R )'s
if ( (substr($thiscode,$lbpos,1) eq ")") ||
(substr($thiscode,$lbpos-1,2) eq ")'")){
if (substr($thiscode,$lbpos,1) eq ")"){
$nrb=1;
$lbpos=$lbpos-1;}
elsif (substr($thiscode,$lbpos,1) eq "'" &&
substr($thiscode,$lbpos-1,1)){
$nrb=1;
$lbpos=$lbpos-2;
}
else{$lbpos=$lbpos-1;}
$nlb=0;
while ($nrb>$nlb){
if (substr($thiscode,$lbpos,1) eq ")"){
$nrb=$nrb+1; }
if (substr($thiscode,$lbpos,1) eq "("){
$nlb=$nlb+1; }
$lbpos=$lbpos-1;
}
}
# once [ position pushed beyond last bracket match start looking for
# first non-word to the left
$cont=1;
while ($cont==1){
if ((substr($thiscode,$lbpos,1) =~/\W/)
&& (substr($thiscode,$lbpos,1) ne "'")){
$cont=0;}
else{
$lbpos=$lbpos-1;}
}
# insert left bracket at appropriate position, truncate "newstring" to first ~
# create reststring which consists of what follows
if (substr($thiscode,$lbpos,1) eq "("){
#start counting brackets and drop ] immediately before match
$newstring=substr($thiscode,0,$lbpos+1)."[";
$reststring=substr($thiscode,$lbpos+1);
$nlb=1; $nrb=0;
$cont=1;
while ($cont==1){
if (substr($reststring,0,1) eq ")"){$nrb=$nrb+1;}
if (substr($reststring,0,1) eq "("){$nlb=$nlb+1;}
if (substr($reststring,0,1) eq "~"){
$newstring=$newstring." ";
$reststring=substr($reststring,1);}
else{
$newstring=$newstring.substr($reststring,0,1);
$reststring=substr($reststring,1);}
if ($nlb==$nrb){$thiscode=substr($newstring,0,length($newstring)-1)
."]".substr($newstring,length($newstring)-1,1).$reststring;
$cont=0;}
}
$pos=index($thiscode,"~"); # check for more ~ left off by ~
}
else{
$newstring=substr($thiscode,0,$lbpos+1)."[".substr($thiscode,$lbpos+1,$pos-$lbpos-1)." ";
$reststring=substr($thiscode,$pos+1);


$cont=1;
$rbpos=0;
while ($cont==1)
{
# check to see if any more ~'s exist before next ~ or terminating ;
$pos=index($reststring,"~");
# if not, initialize right bracket position for ] to immed. right last ~
if ($pos==-1){
$cont=0;}
else{
# if more ~'s exist, check to see if ~ exist
if ( (index($reststring,"~")<index($reststring,"~"))
&& index($reststring,"~") != -1)
{
$cont=0;}
else{
# if not keep adding chunks to "newstring"
$newstring=$newstring.substr($reststring,0,$pos)." ";
$reststring=substr($reststring,$pos+1);
}}}
# ] position is currently to immediate right of last ~
# check to see if this position is a left bracket
$rbpos=0;
$nrb=0; $nlb=0;
if (substr($reststring,$rbpos,1) eq "("){
# if it is, count brackets and push ] position to right
$nrb=0; $nlb=1; $rbpos=$rbpos+1;
while ($nlb>$nrb){
if (substr($reststring,$rbpos,1) eq ")"){
$nrb=$nrb+1;
}
if (substr($reststring,$rbpos,1) eq "("){
$nlb=$nlb+1;
}
$rbpos=$rbpos+1
}
if (substr($reststring,$rbpos,1) eq "'"){
$rbpos=$rbpos+1;}
}
# search for first non-word to right of ~_, or last matching )
$cont=1;
while ($cont==1){
# if non-word hit piece everything together
if (substr($reststring,$rbpos,1) =~ /\(/){
$rbpos=$rbpos+1;
$nlb=$nlb+1;}
if (substr($reststring,$rbpos,1) =~ /\)/){
$rbpos=$rbpos+1;
$nrb=$nrb+1;}
if (substr($reststring,$rbpos,1) =~/\W/){
if ($nlb==$nrb){
$cont=0;
if (substr($reststring,$rbpos,1) eq "'"){
$rbpos=$rbpos+1;}
$thiscode=$newstring.substr($reststring,0,$rbpos).
"]".substr($reststring,$rbpos);
}
else{$rbpos=$rbpos+1;}
}
# else keep sliding right
else{
$rbpos=$rbpos+1;}
}

} # this ends bracket searching branch
$pos=index($thiscode,"~"); # check for more ~ left off by ~
}
# convert != to ~= after concat. section for obvious reasons
$thiscode =~ s/\!\=/\~\=/;
# convert double qutoes strings to single quote
# do last to avoid transpose confusion
$thiscode =~ s/\"/\'/g;
return $thiscode;}

############################################################
# declaration file subroutine
############################################################
sub decproc{
$incfname=@_[0];
# CONVERT DECLARATION FILES INTO A SERIES OF GLOBAL DECLARATIONS
# USE global var; within code, and global var; var=value within
# new dec file named {origname}d.m"
$incfname =~s/;//;
open (DECIN,$incfname);
# drop any path or drive letter associated with new dec filename
if ($incfname =~ /\\/){
$incfname =~ s/(.*)(\\)(.*)/\3/;}
if ($incfname =~ /\:/){
$incfname =~ s/(.*)(\:)(.*)/\3/;}
# change the file extension and drop any line feed
$outfname=$incfname;
$outfname =~ s/(.*)(\..*)/\1d\.m/;
open (DECOUT,">".$outfname);
$decline="";
while (<DECIN>){
$thisdecline=$_;
if (/declare/){
$fileline =~ s/declare matrix//;
$fileline =~ s/declare string//;
s/(\/\*)(.*)(\*\/)(\n)/% \2\4/;
if (/\s?\w*\s?\!\=\s?\.*/){
/(\s?)(\w*)(\s?\!\=)(.*)/;
$fileline="global ".$2."; ".$2."=".$4."\n";
$thisdecline="global ".$2.";\n";}
elsif (/\s?\w*\s?\=\s?\.*/){
/(\s?)(\w*)(\s?\=)(.*)/;
$fileline="global ".$2."; ".$2."=".$4."\n";
$thisdecline="global ".$2.";\n";}
elsif (/\s?\w*\s?\?\=\s?\.*/){
/(\s?)(\w*)(\s?\?\=)(.*)/;
$fileline="global ".$2."; ".$2."=".$4."\n";
$fileline =~ s/\n//;
$thisdecline="global ".$2.";\n";}
print DECOUT $fileline;
$decline=$decline.$thisdecline;
}
else{s/\/\*//;
s/\*\///;
# change file extensions in declaration header
s/\.dec/d\.m/;
s/(\w)\.g/\1\.m/;
s/\.DEC/d\.m/;
s/(\w)\.G/\1\.m/;
print DECOUT "%".$_;}

}
close(DECOUT);
if (($decline =~ /\;/)==0){
$decline=$decline.";";}
return $decline;}

[whoami]

Sorry hoor, maar dit is echt niet de bedoeling van dit forum.
Het is niet de bedoeling om hier een lap code te posten, en dan de request plaatsen of er iemand zo vriendelijk wil zijn om dat stuk code voor jou om te zetten.

Hier gaat het om zelf programmeren, en het discussieren ivm problemen waartegen je botst tijdens het programmeren. Indien je iemand zoekt die een stuk code voor jou kan vertalen, dan zijn er andere wegen om jouw doel te bereiken, monster.com bv.

Hoe je het zelf kan omzetten: Perl leren, de code die je nu gepost hebt bestuderen, en stapje voor stapje proberen om te zetten.
succes.