The current version I'm working from as of May 7th:
# A rough program written in Perl to convert Cosy Infinity to a C++ format
# The resultant c++ program requires the presence of the Cosy class
# Laura Chapin, Feb. 8, 2002 : chapinl1@msu.edu
# On behalf of MSU's Beam Theory and Dynamical Systems Group
$Cosy = "Cosy" ; #makes use of the Cosy class, may be approximated with double
$open = "cosy.fox" ; #replace with the file to be converted
open(IN,"$open") || die "Can't open the input file" ;
$cpp = "output.cpp"; #replace with the file name for the converted program
open(OUT, ">../cygwin/home/chapinl1/ConMan/$cpp") || die "Can't open the output file.";
$testing = "testing.cpp"; #replace with the file name for the converted program
open(TESTING, ">../cygwin/home/chapinl1/ConMan/$testing") || die "Can't open the testing output file.";
@elements = ("variable","begin","read","loop","while","include","if","write") ;
@StandardOneArgs = ("type","length","varmem","varpoi","not","exp","log","sin","tan","asin","acos","atan","sinh","cosh","tanh","sqrt","isrt","sqr","erf","werf","norm","cons","width","Real","Imag","nint","cmplx","conj","memall","memfre","closef","rewf","backf","cpusec","quit","scrlen","danot","daeps","reran","imunit","lture","lfalse","insrnd","rditig","rdnpnt","rdpris","clear","polset","memwrt","varmax");
@FunAndProCalls ;
@FunAndProCallArgs ;
while() {
s/\n/~/g ;
# Switches basic operations to the appropriate format
s/'/"/g ;
s/\}/\*\/;\n/g ;
s/=/==/g ;
s/:==/=/g;
s/\#/!=/g ;
s/(\w*)\^(\w*)/pow(\1,\2)/g ;
#s/\b(?i)end\b/}/g ;
s/\b(?i)end\b/ /g ;
s/\b(?i)endif\b/}/g ;
s/\b(?i)endwhile\b/}/g ;
s/\b(?i)endloop\b/}/g ;
s/(?i)ELSEIF/} else if/g ;
s/(?i)QUIT/break/g ;
s/VARIABLE TRUE 1 \; // ;
s/TRUE/true/g ;
s/\bend\b/ /g;
s/SAVE "COSY"/ / ;
$a.=" $_" ; #Reads the entire document onto one string
$a =~ s/ ; /; \n /g ;
}
@Lines=split(/;/,$a) ; #Separates the document into an array of lines
$size = scalar @Lines ;
$index = 0 ;
foreach $Lines (@Lines) { #This takes care of comments
if ($Lines =~ m/{/) {
$Lines =~ s/{\*/{/g ;
$Lines =~ s/{/\/\*/g ;
foreach $element (@elements) {
$Lines =~ s/(?i)$element/G$element/g ;
}
foreach $Arg (@StandardOneArgs) {
$Lines =~ s/(?i)$Arg/G$element/g ;
}
$Lines =~ s/(?i)function/GfunctionG/g ;
$Lines =~ s/(?i)procedure/GprocedureG/g ;
$Lines =~ s/IN/gINg/g ;
}
if ($Lines =~ m/(?i)write 6/) {
foreach $element (@elements) {
if ($element != "write") {
$Lines =~ s/(?i)$element/G$element/g ;
}
}
foreach $Arg (@StandardOneArgs) {
$Lines =~ s/(?i)$Arg/G$element/g ;
}
$index++ ;
$Lines =~ s/~/\n/g ;
}
}
for ($i = 0 ; $i < (scalar @Lines ) ; $i++ ) {
if ($Lines[$i] =~ m/(?i)\bENDFUNCTION\b/) {
$endfunction = $i ;
FINDSTARTF:
for ($j = $i ; $j >= 0 ; $j-- ) {
if ($Lines[$j] =~ m/\b(?i)FUNCTION\b/) {
$startfunction = $j ;
$i = 0 ;
last FINDSTARTF ;
}
}
$blockLine = "" ;
for ($p = $startfunction ; $p <= $endfunction ; $p++) {
$blockLine .= $Lines[$p]." ;" ;
}
push @FBlocks, $blockLine ;
splice @Lines, $startfunction, ($endfunction - $startfunction + 1) ;
}
}
foreach $FBlocks (@FBlocks) {
$FBlocks = function($FBlocks);
@FSplit = split(/;/,$FBlocks) ;
foreach $FSplit (@FSplit) {
push @Lines,$FSplit ;
}
}
for ($i = 0 ; $i < (scalar @Lines ) ; $i++ ) {
if ($Lines[$i] =~ m/(?i)\bENDPROCEDURE\b/) {
$endprocedure = $i ;
FINDSTARTP:
for ($j = $i ; $j >= 0 ; $j-- ) {
if ($Lines[$j] =~ m/\b(?i)PROCEDURE\b/) {
$startprocedure = $j ;
$i = 0 ;
last FINDSTARTP ;
}
}
$blockLine = "" ;
for ($p = $startprocedure ; $p <= $endprocedure ; $p++) {
$blockLine .= $Lines[$p]." ;" ;
}
push @PBlocks, $blockLine ;
splice @Lines, $startprocedure, ($endprocedure - $startprocedure + 1) ;
}
}
foreach $PBlocks (@PBlocks) {
$PBlocks = procedure($PBlocks);
@PSplit = split(/;/,$PBlocks) ;
foreach $PSplit (@PSplit) {
push @Lines,$PSplit ;
}
}
@ArrayNames ; #To Fill with Array names for proper element access using get
$index = 0 ;
foreach $Lines (@Lines) {
$test = 0 ;
CHECKELEMENTS:
foreach $elements (@elements)
{
if ($Lines =~ m/\b(?i)$elements\b/) {
$argument = $Lines[$index] ;
$Lines[$index] = &{$elements}($argument);
$test = 1 ; }
elsif ($Lines =~ m/}/) { $test = 1 ; }
elsif ($Lines =~ m/\/\*/) { $test = 1 ; }
elsif ($Lines =~ m/void/) { $test = 1 ; }
}
if ($test == 0) { $Lines .= " ;\n" ; }
$index++ ;
foreach $StanOne (@StandardOneArgs) {
if ($Lines =~ m/(?i)$StanOne/) {
$Lines =~ s/(?i)$StanOne/$StanOne/g ;
$Lines =~ s/\b$StanOne (\S*)(?!\*\/)/$StanOne(\1)/g ; } #TEST
}
reverse @ArrayNames ;
foreach $ArrayNames (@ArrayNames) {
if($Lines =~ s/(\W)$ArrayNames\(/) {
if ($Lines =~ m/\) =/) {
$Lines =~ s/(\W)$ArrayNames\((\S*)\) = (\S*)/__dim__$ArrayNames = \{\2\}\;\n$ArrayNames.set(\3, __dim__$ArrayNames, #length __dim__$ArrayNames \)/
}
else {
$Lines =~ s/(\W)$ArrayNames\(/$ArrayNames.get(__dim__$ArrayNames,\(/g ;
}
}
}
$Lines =~ s/~/\n/g ;
$Lines =~ s/GfunctionG/function/g ;
$Lines =~ s/GprocedureG/procedure/g ;
#COSY Intrisic Procedures
$Lines =~ s/SUBSTR (\S*) (\S*) (\S*) (\S*)(?!\*\/) +;/substr(\1,\2,\3,\4) ;/g ;
$Lines =~ s/STCRE (\S*) (\S*)(?!\*\/) +;/stcre(\1,\2) ;/g ;
$Lines =~ s/RECST (\S*) (\S*) (\S*)(?!\*\/) +;/recst(\1,\2,\3);/g ;
$Lines =~ s/DAPEE (\S*) (\S*) (\S*)(?!\*\/) +;/dapee(\1,\2,\3);/g ;
$Lines =~ s/DADER (\S*) (\S*) (\S*)(?!\*\/) +;/dader(\1,\2,\3);/g ;
$Lines =~ s/DAINT (\S*) (\S*) (\S*)(?!\*\/) +;/daint(\1,\2,\3);/g ;
$Lines =~ s/RDINT (\S*) (\S*) (\S*)(?!\*\/) +;/rdint(\1,\2,\3);/g ;
$Lines =~ s/DANOW (\S*) (\S*) (\S*)(?!\*\/) +;/danow(\1,\2,\3);/g ;
$Lines =~ s/INTERV (\S*) (\S*) (\S*)(?!\*\/) +;/interv(\1,\2,\3);/g ;
$Lines =~ s/INLO (\S*) (\S*)(?!\*\/) +;/inlo(\1,\2);/g ;
$Lines =~ s/INUP (\S*) (\S*)(?!\*\/) +;/inup(\1,\2);/g ;
$Lines =~ s/RDVAR (\S*) (\S*) (\S*) (\S*)(?!\*\/) +;/rdvar(\1,\2,\3,\4);/g ;
$Lines =~ s/DAPEP (\S*) (\S*) (\S*) (\S*)(?!\*\/) +;/dapep(\1,\2,\3,\4);/g ;
$Lines =~ s/DAFLO (\S*) (\S*) (\S*) (\S*)(?!\*\/) +;/daflo(\1,\2,\3,\4);/g ;
$Lines =~ s/DAPLU (\S*) (\S*) (\S*) (\S*)(?!\*\/) +;/daplu(\1,\2,\3,\4);/g ;
$Lines =~ s/GRMOVE (\S*) (\S*) (\S*) (\S*)(?!\*\/) +;/grmove(\1,\2,\3,\4);/g ;
$Lines =~ s/GRDRAW (\S*) (\S*) (\S*) (\S*)(?!\*\/) +;/grdraw(\1,\2,\3,\4);/g ;
$Lines =~ s/DAPEA (\S*) (\S*) (\S*) (\S*)(?!\*\/) +;/dapea(\1,\2,\3,\4);/g ;
$Lines =~ s/GRCOLOR (\S*) (\S*)(?!\*\/) +;/grcolor(\1,\2);/g ;
$Lines =~ s/CG (\S*) (\S*) (\S*) (\S*)(?!\*\/) +;/cg(\1,\2,\3,\4);/g;
$Lines =~ s/GRCHAR (\S*) (\S*)(?!\*\/) +;/grchar(\1,\2);/g ;
$Lines =~ s/INT/Int/g ;
$Lines =~ s/\bINT (\S*)(?!\*\/)/Int(\1)/g ;
$Lines =~ s/COS/cos/g ;
$Lines =~ s/\bcos (\S*)(?!\*\/)/cos(\1)/g ;
$Lines =~ s/\bIN\b/in/g ;
$Lines =~ s/\bRE\b/re/g ;
$Lines =~ s/\bDA\b/da/g ;
$Lines =~ s/\bABS\b/abs/g ;
foreach $element (@element) {
$Lines =~ s/G$element/$element/g ;
}
foreach $Arg (@StandardOneArgs) {
$Lines =~ s/G$Arg/$Arg/g ;
}
for ($i = 0 ; $i < (scalar @FunAndProCalls) ; $i++) {
if ($Lines =~ m/$FunAndProCalls[$i]/) {
# $Lines =~ s/$FunAndProCalls[$i] (\S*)/$FunAndProCalls[$i] (\1/g ;
while ($FunAndProCallArgs[$i] > 1) {
#skip to the next word and make it put a comma before it and ) at the end
#ieieieieieiei
$FunAndProCallArgs[$i]-- ;
}
}
} #WORK HERE!
}
foreach $i (@FunAndProCalls) {
print TESTING " $i " ; }#TEST
foreach $i (@FunAndProCallArgs) {
print TESTING " $i " ; }#TEST
print OUT "#include \n#include \n#include \"cosy.h\" \n\nusing namespace std ; \n \n$funSignitures\n$proSignitures Cosy get(Cosy I, Cosy J) { } ; " ;
# TESTING Cosy get(Cosy &a, int i, int j) { \n int c[2] = {i+1, j+1} ; \n return a.get(c,2) ; \n } \n \n " ;
foreach $Lines (@Lines) {
print OUT $Lines ; #TEST
}
sub begin
{
# "\n\nint main()\n{\n\t" ;
}
sub variable
{
my($Name) = $_[0] ;
$Name =~ m/\b(?i)VARIABLE\b/ig ;
my($pos) = (pos $Name) +1 ;
$Name = substr($Name, $pos) ;
my($VArgs) = $Name ;
$VArgs =~ s/ +/ /g ;
$VArgs =~ / / ;
$VArgs = $' ;
$Name = $` ;
my($Args) ;
my(@funLines) = split (/;/, $VArgs) ;
my(@VArgs) = split / /,$funLines[0] ;
my($argumentnumber) = scalar @VArgs ;
my($i) = 0 ;
my($Dim) = 0 ;
foreach $VArgs (@VArgs){
if ($Dim < ($argumentnumber - 1)) {
$Dim++ ;
}
if ($i < ($argumentnumber -1)){
$VArgs = $VArgs.", " ;
$i++ ;
}
# if $Dim then substitute $Dim for $Args
$Args = $Args." ".$VArgs ;
}
$by = "" ;
for ($i = 1 ; $i < $argumentnumber ; $i++) { $by .= "$VArgs[$i]" ;} #TEST
my($Array) = "int __dim__$Name\[$Dim\] = \{$by\} \;" ; #TEST
if ($Dim > 0) { $variable = "\n\t$Array\n\t$Cosy ".$Name." ($VArgs[0] $Dim, __dim__$Name) ;" ; push @ArrayNames, $Name ;} #TEST
else {
$variable = "\n\t$Cosy ".$Name." (".$Args.") ;" ; } #(0,'.$Args.")
$variable ;
} # write a function to count the arguements: if there are more than two, make
# an array of of that many dimensions
#VARIABLE SSCR 2000 3 3 3 ;
#int __dim__SSCR[3] = {3,3};
#Cosy(2000, 3, __dim__SSCR);
sub write
{
my($write) = $_[0] ;
$write =~ s/\b&\b/+/g ;
$write =~ s/(?i)write 6/ /i ;
$write =~ s/'/"/g ;
$write =~ s/\n// ;
$write =~ s/ *// ;
$write = "cout << ".$write." ;\n" ;
}
sub read
{
my($read) = $_[0] ;
$read =~ s/(?i)read 5/ /i ;
$read =~ s/\n//g ;
$read =~ s/ *// ;
$read = "cin >> ".$read." ;\n" ;
}
sub function
{
my($function) = $_[0] ;
my($functionName) = $function;
my($pos) ;
$functionName =~ m/\b(?i)FUNCTION\b/ig ;
$pos = (pos $functionName) +1 ;
$functionName = substr($function, $pos) ;
my($functionArgs) = $functionName ;
$functionArgs =~ s/ +/ /g ;
$functionArgs =~ / / ;
$functionArgs = $' ;
$functionName = $` ;
my(@funLines) = split (/;/, $functionArgs) ;
my(@functionArgs) = split / /,$funLines[0] ;
my($Ls) ;
for ($r = 1 ; $r < scalar @funLines -1 ; $r++ ) {
$funLines[$r] .= ";" ;
$Ls .= "\t$funLines[$r]" ; }
my($Args) ;
my($argumentnumber) = scalar @functionArgs ;
my($i) = 0 ;
foreach $funArgs (@functionArgs){
if ($i < ($argumentnumber -1)){
$funArgs = $funArgs.", " ;
$i++ ;
}
$Args = $Args."$Cosy ".$funArgs ;
}
if ($function =~ m/\b(?i)FUNCTION\b (\w*)\;/) {
$Args = "" ;
$functionName =~ s/\;// ;}
$function = "\n$Cosy ".$functionName." (".$Args.") \n{\n\t$Cosy $functionName;"."$Ls"."\n\treturn $functionName;\n}" ;
my($funSigniture) = "$Cosy ".$functionName." (".$Args."); \n" ;
$funSignitures .= $funSigniture ;
push @FunAndProCallArgs, $argumentnumber ;
push @FunAndProCalls, $functionName ;
$function ;
}
sub if
{
my($if) = $_[0] ;
my(@If) =split(/\n/,$if) ;
my($IF) ;
foreach $If (@If) {
# $If =~ s/\*/&&/g ;
# $If =~ s/\+/||/g ;
# $If =~ s/(?i)NOT/!/g ;
# $If =~ s/(?!<=\:)=/==/g ; #(?<=:)
# $If =~ s/:=/=/g;
$If =~ s/(?i)if\b/if(/g ; #TEST
$If =~ s/\;// ;
$If .= ")\n{\n\t" ;
if ($If =~ m/if/) {
$IF .= $If ; }}
$IF ;
}
sub loop
{
my($loop) = $_[0] ;
if ($loop =~ m/(?i)loop (\S*) (\S*) (\S*) (\S*)\b/) {
$loop =~ s/(?i)loop (\S*) (\S*) (\S*) (\S*)/for ($cosy \1 = \2 ; \1 <= \3 ; \1+=\4) \n{\n\t/g ;
}
elsif ($loop =~ m/(?i)loop (\S*) (\S*) (\S*)\b/) {
$loop =~ s/(?i)loop (\S*) (\S*) (\S*)/for ($cosy \1 = \2 ; \1 <= \3 ; \1++)\n {\n\t/g ; }
$loop ;
}
sub while
{
my($while) = $_[0] ;
# $while =~ s/\*/&&/g ;
# $while =~ s/\+/||/g ;
# $while =~ s/(?i)NOT/!/g ;
$while =~ s/(?i)while/while(/i ;
$while .= ")\n{\n\t" ;
$while ;
}
sub include
{
my($include) = $_[0] ;
$include =~ s/(?i)include (\w*)/\#include "\1"/ ;
$include ;
}
sub procedure
{
my($procedure) = $_[0] ;
my($procedureName) = $procedure;
$procedureName =~ m/\b(?i)PROCEDURE\b/ig ;
my($pos) = (pos $procedureName) +1 ;
$procedureName = substr($procedure, $pos) ;
my($procedureArgs) = $procedureName ;
$procedureArgs =~ s/ +/ /g ;
$procedureArgs =~ / / ;
$procedureArgs = $' ;
$procedureName = $` ;
my(@proLines) = split (/;/, $procedureArgs) ;
my(@procedureArgs) = split / /,$proLines[0] ;
my($ProLs) ;
for ($r = 1 ; $r < scalar @proLines -1 ; $r++ ) {
$proLines[$r] .= ";" ;
$ProLs .= "\t$proLines[$r]" ; }
my($Args) ;
my($argumentnumber) = scalar @procedureArgs ;
my($i) = 0 ;
foreach $proArgs (@procedureArgs){
if ($i < ($argumentnumber -1)){
$proArgs = $proArgs.", " ;
$i++ ;
}
$Args = $Args."$Cosy ".$proArgs ;
}
if ($procedure =~ m/\b(?i)PROCEDURE (\w*)\;/) {
$Args = "" ;
$procedureName =~ s/\;// ;
$ProLs = $procedureArgs;
$ProLs =~ s/\bENDPROCEDURE\;// ;}
$procedure = "\nvoid ".$procedureName." (".$Args.") \n{\;"."$ProLs"."\n}" ;
my($proSigniture) ;
$proSigniture = "void ".$procedureName." (".$Args."); \n" ;
$proSignitures .= $proSigniture ;
push @FunAndProCallArgs, $argumentnumber ;
push @FunAndProCalls, $procedureName ;
$procedure ;
}
#sub abs {
# my($abs) = $_[0] ;
# $abs =~ $s/ABS/abs/g ;
# $abs =~ s/\babs (\S*)(?!\*\/)/abs(\1)/g ;
# # ?fabs? check what fabs does and where it applies
#}
#sub exp {
# my($exp) = $_[0] ;
# $exp =~ s/EXP/exp/g ;
# $exp =~ s/exp (\S*)(?!\*\/)/exp(\1)/g ;
#}
#sub log {
# my($log) = $_[0] ;
# $log =~ s/LOG/log/g ;
#}
#$Lines =~ s/ASIN\((\S*)(?!\*\/)/asin(\1/g ;
# $Lines =~ s/ACOS\((\S*)(?!\*\/)/acos(\1/g ;
# $Lines =~ s/ATAN\((\S*)(?!\*\/)/atan(\1/g ;
# $Lines =~ s/SINH\((\S*)(?!\*\/)/sinh(\1/g ;
# $Lines =~ s/COSH\((\S*)(?!\*\/)/cosh(\1/g ;
# $Lines =~ s/TANH\((\S*)(?!\*\/)/tanh(\1/g ;
# $Lines =~ s/SIN\((\S*)(?!\*\/)/sin(\1/g ;
# $Lines =~ s/COS\((\S*)(?!\*\/)/cos(\1/g ;
# $Lines =~ s/TAN\((\S*)(?!\*\/)/tan(\1/g ;
# $Lines =~ s/\bSQRT\((\S*)(?!\*\/)/sqrt(\1/g ;
# $Lines =~ s/\bISRT\((\S*)(?!\*\/)/isrt(\1/g ;
# $Lines =~ s/\bSQR\((\S*)(?!\*\/)/sqr(\1/g ;
# $Lines =~ s/ABS\((\w*)\)/abs(\1)/g ; #TEST 675 and 642 must both work!
# # ?fabs? check what fabs does and where it applies
# $Lines =~ s/\bTYPE\((\S*)(?!\*\/)/type(\1/g ;
# $Lines =~ s/\bLENGTH\((\S*)(?!\*\/)/length(\1/g ;
# $Lines =~ s/\bVARMEN\((\S*)(?!\*\/)/varmen(\1/g ;
# $Lines =~ s/\bNOT\((\S*)(?!\*\/)/not(\1/g ;
# $Lines =~ s/\bERF\((\S*)(?!\*\/)/erf(\1/g ;
# $Lines =~ s/\bWERF\((\S*)(?!\*\/)/werf(\1/g ;
# $Lines =~ s/\bNORM\((\S*)(?!\*\/)/norm(\1/g ;
# $Lines =~ s/\bCONS\((\S*)(?!\*\/)/cons(\1/g ;
# $Lines =~ s/\bRE\((\S*)(?!\*\/)/re(\1/g ;
# $Lines =~ s/\bIN\((\S*)(?!\*\/)/in(\1/g ;
# $Lines =~ s/\bWIDTH\((\S*)(?!\*\/)/width(\1/g ;
# $Lines =~ s/\bREAL\((\S*)(?!\*\/)/Real(\1/g ;
# $Lines =~ s/\bIMAG\((\S*)(?!\*\/)/Imag(\1/g ;
# $Lines =~ s/\bINT\((\S*)(?!\*\/)/Int(\1/g ;
# $Lines =~ s/\bNINT\((\S*)(?!\*\/)/nint(\1/g ; # Check rint
# $Lines =~ s/\bDA\((\S*)(?!\*\/)/da(\1/g ;
# $Lines =~ s/\bCMPLX\((\S*)(?!\*\/)/cmplx(\1/g ;
# $Lines =~ s/\bCONJ\((\S*)(?!\*\/)/conj(\1/g ;
#With Spaces
# $Lines =~ s/LOG (\S*)(?!\*\/)/log(\1)/g ;
# $Lines =~ s/LOG/log/g ; #TEST
# $Lines =~ s/ASIN (\S*)(?!\*\/)/asin(\1)/g ;
# $Lines =~ s/ACOS (\S*)(?!\*\/)/acos(\1)/g ;
# $Lines =~ s/ATAN (\S*)(?!\*\/)/atan(\1)/g ;
# $Lines =~ s/SINH (\S*)(?!\*\/)/sinh(\1)/g ;
# $Lines =~ s/COSH (\S*)(?!\*\/)/cosh(\1)/g ;
# $Lines =~ s/TANH (\S*)(?!\*\/)/tanh(\1)/g ;
# $Lines =~ s/SIN (\S*)(?!\*\/)/sin(\1)/g ;
# $Lines =~ s/COS (\S*)(?!\*\/)/cos(\1)/g ;
# $Lines =~ s/TAN (\S*)(?!\*\/)/tan(\1)/g ;
# $Lines =~ s/\bSQRT (\S*)(?!\*\/)/sqrt(\1)/g ;
# $Lines =~ s/\bISRT (\S*)(?!\*\/)/isrt(\1)/g ;
# $Lines =~ s/\bSQR (\S*)(?!\*\/)/sqr(\1)/g ;
# $Lines =~ s/\bTYPE (\S*)(?!\*\/)/type(\1)/g ;
# $Lines =~ s/\bLENGTH (\S*)(?!\*\/)/length(\1)/g ;
# $Lines =~ s/\bVARMEN (\S*)(?!\*\/)/varmen(\1)/g ;
# $Lines =~ s/\bNOT (\S*)(?!\*\/)/not(\1)/g ;
# $Lines =~ s/\bERF (\S*)(?!\*\/)/erf(\1)/g ;
# $Lines =~ s/\bWERF (\S*)(?!\*\/)/werf(\1)/g ;
# $Lines =~ s/\bNORM (\S*)(?!\*\/)/norm(\1)/g ;
# $Lines =~ s/\bCONS (\S*)(?!\*\/)/cons(\1)/g ;
# $Lines =~ s/\bRE (\S*)(?!\*\/)/re(\1)/g ;
# $Lines =~ s/\bIN (\S*)(?!\*\/)(?!\*\/)/in(\1)/g ;
# $Lines =~ s/\bWIDTH (\S*)(?!\*\/)/width(\1)/g ;
# $Lines =~ s/\bREAL (\S*)(?!\*\/)/Real(\1)/g ;
# $Lines =~ s/\bIMAG (\S*)(?!\*\/)/Imag(\1)/g ;
# $Lines =~ s/\bINT (\S*)(?!\*\/)/Int(\1)/g ;
# $Lines =~ s/\bRINT (\S*)(?!\*\/)/rint(\1)/g ; # Check nint
# $Lines =~ s/\bDA (\S*)(?!\*\/)/da(\1)/g ;
# $Lines =~ s/\bCMPLX (\S*)(?!\*\/)/cmplx(\1)/g ;
# $Lines =~ s/\bCONJ (\S*)(?!\*\/)/conj(\1)/g ;
THE LATEST, GREATEST, SO GOOD I DON'T EVEN KNOW WHAT TO FIX (In short [367 lines], the COSY to C++ converter)!!!!!!!:
#CURRENT PROJECT: ~ Specifically:
$cosy = "Cosy" ;
$open = "cosyneat.fox" ;
open(IN,"$open") || die "Can't open the input file" ;
$cpp = "output.cpp";
open(OUT, ">$cpp") || die "Can't open the output file.";
$funTest = "11Test.cpp" ; #TEST
open(TEST, ">$funTest") || die "Can't open the test output file." ; #TEST
@elements = ("variable","begin","read","loop","while","include","if","wirte"); #TEST SPECIALIZATION: PUT THIS BACK!!!!
# end has been removed as well as function and procedure
while()
{
#s/{/{\n/g ; #TEST COMMENT SEPARATION from actual lines of code
# s/ +/ /g ; #test space fixation
s/\n/~/g ; #TEST
s/\}/\*\/;\n/g; #TEST COMMENT REMOVAL
s/:=/=/g;
s/\#/!=/g ;
s/(\w*)\^(\w*)/pow(\1,\2)/g ;
s/\b(?i)end\b/}/g ;
s/\b(?i)endif\b/}/g ;
s/\b(?i)endwhile\b/}/g ;
s/\b(?i)endloop\b/}/g ;
s/(?i)ELSEIF/}\nelse if/g ;
s/(?i)QUIT/break/g ;
s/(?i)EXP/exp/g ;
s/(?i)LOG/log/g ;
s/(?i)SIN\(/sin\(/g ;
s/(?i)COS\(/cos\(/g ;
s/(?i)TAN\(/tan\(/g ;
s/(?i)ASIN/asin/g ;
s/(?i)ACOS/acos/g ;
s/(?i)ATAN/atan/g ;
s/(?i)SINH/sinh/g ;
s/(?i)COSH/cosh/g ;
s/(?i)TANH/tanh/g ;
s/(?i)SQRT/sqrt/g ;
s/(?i)ISRT/1\/sqrt/g ;
s/(?i)SQR (\w*)/\1*\1/g ;
s/(?i)ABS (\w*)/sqrt(\1*\1)/g ;
s/\bend\b/}/g;
$a.=" $_" ;
$a =~ s/ ; /; \n /g ; #TEST
}
@Lines=split(/;/,$a) ;
$size = scalar @Lines ;
$index = 0 ;
foreach $Lines (@Lines) { #THIS IS WHERE COMMENTS GO.
# if ($Lines =~ m/NORMSU2/) {print $Lines ;} #TEST
if ($Lines =~ m/{/) { #TEST
$Lines =~ s/{\*/{/g ;
$Lines =~ s/{/\/\*/g ;
foreach $element (@elements) {
$Lines =~ s/(?i)$element/G$element/g ; #TEST
}
$Lines =~ s/(?i)function/GfunctionG/g ;
$Lines =~ s/(?i)procedure/GprocedureG/g ; }
if ($Lines =~ m/(?i)write 6/) { #TEST
foreach $element (@elements) {
if ($element != "write") {
$Lines =~ s/(?i)$element/G$element/g ;}
}
$Lines =~ s/(?i)function/GfunctionG/g ;
$Lines =~ s/(?i)procedure/GprocedureG/g ; }
$index++ ;$Lines =~ s/~/\n/g ; #TEST
}
for ($i = 0 ; $i < (scalar @Lines ) ; $i++ ) {
if ($Lines[$i] =~ m/(?i)\bENDFUNCTION\b/) {
$endfunction = $i ;
FINDSTART:
for ($j = $i ; $j > 0 ; $j-- ) {
if ($Lines[$j] =~ m/(?i)\bFUNCTION\b/ ) {
$startfunction = $j ;
$i = 0 ;
last FINDSTART ; } }
$blockLine = "" ;
for ($p = $startfunction ; $p <= $endfunction ; $p++) {
$blockLine .= $Lines[$p].";" ; }
push @SBlocks, $blockLine ;
splice @Lines, $startfunction, ($endfunction - $startfunction + 1) ; } }
#foreach $SBlocks (@SBlocks) {
# push @Lines,$SBlocks ;
#} #TEST
foreach $SBlocks (@SBlocks) {
$SBlocks = function($SBlocks);
@Split = split(/;/,$SBlocks) ;
foreach $Split (@Split) {
push @Lines,$Split ; } #TEST
}
$CountDend = 0 ; #TEST
$CountDbegin = 0 ; #TEST
for ($i = 0 ; $i < (scalar @Lines ) ; $i++ ) {
if ($Lines[$i] =~ m/(?i)\bENDPROCEDURE\b/) {
$CountDend++ ; #TEST
$endprocedure = $i ;
FINDSTARTP:
for ($j = $i ; $j >= 0 ; $j-- ) { #TEST >= instead of just >
if ($Lines[$j] =~ m/\b(?i)PROCEDURE\b/) { #TEST: removal of start bound
$CountDbegin++ ; #TEST
$startprocedure = $j ;
$i = 0 ;
last FINDSTARTP ; } }
$blockLine = "" ;
for ($p = $startprocedure ; $p <= $endprocedure ; $p++) {
$blockLine .= $Lines[$p].";" ; }
push @PBlocks, $blockLine ;
splice @Lines, $startprocedure, ($endprocedure - $startprocedure + 1) ; } }
#print "B: $CountDbegin \n E: $CountDend" ; #TEST
#foreach $PBlocks (@PBlocks) {
# push @Lines,$PBlocks ; } #TEST
foreach $PBlocks (@PBlocks) {
$PBlocks = procedure($PBlocks);
@PSplit = split(/;/,$PBlocks) ;
foreach $PSplit (@PSplit) {
push @Lines,$PSplit ; } #TEST
}
$index = 0 ;
foreach $Lines (@Lines)
{ $test = 0 ; # $SBlocks = &{function}($SBlocks);
CHECKELEMENTS:
foreach $elements (@elements)
{
if ($Lines =~ m/\b(?i)$elements\b/) {
$argument = $Lines[$index] ;
$Lines[$index] = &{$elements}($argument);
$test = 1 ; }
elsif ($Lines =~ m/}/) { $test = 1 ; }
elsif ($Lines =~ m/\/\*/) { $test = 1 ; } #TEST
elsif ($Lines =~ m/void/) { $test = 1 ; } #TEST
}
if ($test == 0) { $Lines .= ";\n" ; }
$index++ ;
}
print OUT "#include \n#include \n\nusing namespace std ; \n \n$funSignitures\n$proSignitures" ;
foreach $Lines (@Lines) {
$Lines =~ s/~/\n/g ; #TEST
$Lines =~ s/GfunctionG/function/g ; #TEST
$Lines =~ s/GprocedureG/procedure/g ; #TEST
foreach $element (@element) {
$Lines =~ s/G$element/$element/g ; #TEST
}
#if ($Lines =~ /PROCEDURE/ or $Lines =~ /void/) {print TEST $Lines; } #TEST
print OUT $Lines ; }
sub begin
{
"\n\nint main()\n{\n\t" ;
}
sub variable
{
my($Name) = $_[0] ;
$Name =~ m/\b(?i)VARIABLE\b/ig ;
my($pos) = (pos $Name) +1 ;
$Name = substr($Name, $pos) ;
my($VArgs) = $Name ;
$VArgs =~ s/ +/ /g ;
$VArgs =~ / / ;
$VArgs = $' ;
$Name = $` ;
my($Args) ;
my(@funLines) = split (/;/, $VArgs) ;
my(@VArgs) = split / /,$funLines[0] ;
my($argumentnumber) = scalar @VArgs ;
my($i) = 0 ;
foreach $VArgs (@VArgs){
if ($i < ($argumentnumber -1)){
$VArgs = $VArgs.", " ;
$i++ ;
}
$Args = $Args.$Cosy." ".$VArgs ;
}
$Cosy = Cosy ; #TEST
$variable = "\n\t$Cosy ".$Name." (".$Args.") ;" ;
$variable ;
}
sub write
{
my($write) = $_[0] ;
$write =~ s/\b&\b/+/g ;
$write =~ s/(?i)write 6/ /i ;
$write =~ s/'/"/g ;
$write =~ s/\n// ;
$write =~ s/ *// ;
$write = "cout << ".$write." ;\n" ;
}
sub read
{
my($read) = $_[0] ;
$read =~ s/(?i)read 5/ /i ;
$read =~ s/\n//g ;
$read =~ s/ *// ;
$read = "cin >> ".$read." ;\n" ;
}
sub comment
{
my($comment) = $_[0] ;
# print "A: $comment" ;
$comment = "//".$comment ;
# print "B: $comment" ;
$comment ;
}
sub end
{
"}";
}
sub function
{
my($function) = $_[0] ;
my($functionName) = $function;
my($pos) ;
$functionName =~ m/\b(?i)FUNCTION\b/ig ;
$pos = (pos $functionName) +1 ;
$functionName = substr($function, $pos) ;
my($functionArgs) = $functionName ;
$functionArgs =~ s/ +/ /g ; #TEST
$functionArgs =~ / / ;
$functionArgs = $' ;
$functionName = $` ;
my(@funLines) = split (/;/, $functionArgs) ;
my(@functionArgs) = split / /,$funLines[0] ;
my($Ls) ;
for ($r = 1 ; $r < scalar @funLines -1 ; $r++ ) {
$funLines[$r] .= ";" ;
$Ls .= "\t$funLines[$r]" ; }
my($Args) ;
my($argumentnumber) = scalar @functionArgs ;
my($i) = 0 ;
foreach $funArgs (@functionArgs){
if ($i < ($argumentnumber -1)){
$funArgs = $funArgs.", " ;
$i++ ;
}
$Cosy = "Cosy" ;
$Args = $Args."$Cosy ".$funArgs ;
}
if ($function =~ m/\b(?i)FUNCTION\b (\w*)\;/) {
$Args = "" ;
$functionName =~ s/\;// ;}
$function = "\n$Cosy ".$functionName." (".$Args.") \n{\n\t$Cosy $functionName;"."$Ls"."\n\treturn $functionName;\n}" ;
my($funSigniture) ;
$funSigniture = "$Cosy ".$functionName." (".$Args."); \n" ;
$funSignitures .= $funSigniture ;
$function ;
}
sub if
{
my($if) = $_[0] ;
my(@If) =split(/\n/,$if) ;
my($IF) ;
foreach $If (@If) {
$If =~ s/\*/&&/g ;
$If =~ s/\+/||/g ;
$If =~ s/(?i)NOT/!/g ;
$If =~ s/(?i)if/if(/g ;
$If =~ s/\;// ; #TEST
$If .= ")\n{\n\t" ;
if ($If =~ m/if/) {
$IF .= $If ; }}
$IF ;
}
sub loop
{
my($loop) = $_[0] ;
if ($loop =~ m/(?i)loop (\S*) (\S*) (\S*) (\S*)/) {
$loop =~ s/(?i)loop (\S*) (\S*) (\S*) (\S*)/for ($cosy \1 = \2 ; \1 <= \3 ; \1+=\4) \n{\n\t/g ;
}
elsif ($loop =~ m/(?i)loop (\S*) (\S*) (\S*)/) {
$loop =~ s/(?i)loop (\S*) (\S*) (\S*)/for ($cosy \1 = \2 ; \1 <= \3 ; \1++)\n {\n\t/g ; }
$loop ;
}
sub endloop
{
"}" ;
}
sub while
{
my($while) = $_[0] ;
$while =~ s/\*/&&/g ;
$while =~ s/\+/||/g ;
$while =~ s/(?i)NOT/!/g ;
$while =~ s/(?i)while/while(/i ;
$while .= ")\n{\n\t" ;
$while ;
}
sub endwhile
{
"}" ;
}
sub include
{
my($include) = $_[0] ;
$include =~ s/(?i)include (\w*)/\#include "\1"/ ;
$include ;
}
sub procedure
{
my($procedure) = $_[0] ;
if ($procedure =~ m/MexpSU2/) {print TEST "$procedure" ;} #TEST
my($procedureName) = $procedure;
my($pos) ;
$procedureName =~ m/\b(?i)PROCEDURE\b/ig ;
$pos = (pos $procedureName) +1 ;
$procedureName = substr($procedure, $pos) ;
my($procedureArgs) = $procedureName ;
$procedureArgs =~ s/ +/ /g ; #TEST
$procedureArgs =~ / / ;
$procedureArgs = $' ;
$procedureName = $` ;
my(@proLines) = split (/;/, $procedureArgs) ;
my(@procedureArgs) = split / /,$proLines[0] ;
my($ProLs) ;
for ($r = 1 ; $r < scalar @proLines -1 ; $r++ ) {
$proLines[$r] .= ";" ;
$ProLs .= "\t$proLines[$r]" ; }
my($Args) ;
my($argumentnumber) = scalar @procedureArgs ;
my($i) = 0 ;
foreach $proArgs (@procedureArgs){
if ($i < ($argumentnumber -1)){
$proArgs = $proArgs.", " ;
$i++ ;
}
$Cosy = "Cosy" ;
$Args = $Args."$Cosy ".$proArgs ;
}
if ($procedure =~ m/\b(?i)PROCEDURE (\w*)\;/) {
$Args = "" ;
$procedureName =~ s/\;// ;
$ProLs = $procedureArgs;
$ProLs =~ s/\bENDPROCEDURE\;// ;}
$procedure = "\nvoid ".$procedureName." (".$Args.") \n{\;"."$ProLs"."\n}" ;
my($proSigniture) ;
$proSigniture = "void ".$procedureName." (".$Args."); \n" ;
$proSignitures .= $proSigniture ;
if ($procedure =~ m/MexpSU2/) {print TEST "~~~$procedure~~~" ;} #TEST
$procedure ;
}
My first attempts at having my cosy-c++ converter convert to c++ (as a variation on Perl)
summer.pl (smushed real good)
print "Please type the .fox file you would like to convert to Perl using Perl"; #prompts file input $cosy=chop(); #identifies target file open(IN,"$cosy") || die "Can't read the fox file"; #opens the target file if possible #open(IN,"onward.fox") || die "Can't read the fox file"; #testing other way $a=$_; #reassigns the input to $a (because the program is stupid and won't do it directly) line by line print OUT "$a \n"; #prints each modified line print "Please type the .pl file you would like save your converted program in"; #prompts file output location $perl=chop( ); open(OUT, ">$perl") || die "Can't open the Perl file. Make sure that it exists."; #open(OUT, ">datadump.pl") || die "Can't open datadump"; #testing other way print OUT "sub arccos { \n \t atan2( sqrt(1 - \$_[0] * \$_[0]), \$_[0] ); \n} \n"; print OUT "sub tan { \n \t sin(\$_[0]) / cos(\$_[0]); \n } \n"; print OUT "sub arcsin { \n \t 1 / sin(\$_[0]); \n } \n"; print OUT "sub arctan { \n \t atan2(\$_[0]/1); \n } \n"; print OUT "sub sinh { \n \t (exp(\$_[0])-exp(-\$_[0]))/2 ; \n } \n"; print OUT "sub cosh { \n \t (exp(\$_[0])+exp(-\$_[0]))/2 ; \n } \n"; print OUT "sub tanh { \n \t (exp(\$_[0])-exp(-\$_[0]))/(exp(\$_[0])+exp(-\$_[0])) ; \n } \n"; while ( ) { chop; $a=$_; $a =~ s/\#/ != /g; if (/\bvariable\b/) { $i = index($_,"variable")+9; $v = substr($_,$i,\D); @split = split(/ /,$v); if ($split[2]) { $a = "\@". reverse $split[0]; } push(@variables,$split[0]); $a = "# ". $a; } #see which ones work $a =~ s/read 5 ([^; ]+)/\1 = chop()/g; $a =~ s/'/"/g; $a =~ s/([^:])=( *")/\1 eq \2/g; $a =~ s/([^:])=( *[^"])/\1 == \2/g; $a =~ s/:=/=/g; $a =~ s/write 6/print/g; $a =~ s/begin;/ /g; $a =~ s/elseif/elsif/g; $a =~ s/endwhile;|endif;/}/g; $a =~ s/if/if (/g; $a =~ s/endfunction\;/}/g; $a =~ s/function (\w*) (\w*) (\w*) *;/sub \1 { \2 \3 /g; $a =~ s/while/while (/g; $a =~ s/function/sub/g; $a =~ s/loop/for\(/g; #see which ones work $a =~ s/type((\d*))=1/(\/\1/\d\/){/g; #supposively identifies whether the variable is a number $a =~ s/type((\w*))=2/(\/\1/\w\/){/g; #supposively identifies whether the variable is a string :*: $a =~ s/ss($(\w*),1,(\w*))='(\w*)/\$\1 =~ s\\3\/g/g; #changes substring matching to regular expressions $a =~ s/read 5 ([^; ]+)/\1 = chop( )/g; #changes the input format from cosy's read to Perl's STDIN $a =~ s/'/"/g; #changes the single quotes around strings to double quotes, the proper Perl format $a =~ s/([^:])=( *")/\1 eq \2/g; #an old attempt to match strings, the same purpose as :*:, incomplete $a =~ s/([^:])=( *[^"])/\1 == \2/g; #identifies true/false statements $a =~ s/:=/=/g; #changes := to the proper Perl assigning format of = $a =~ s/write 6/print/g; #changes write 6 to the proper print command $a =~ s/begin;/ /g; #removes the unneccessary begin $a =~ s/elseif/elsif/g; #fixes the spelling of elseif for Perl $a =~ s/endwhile;|endif;/}/g; #removes the unused endwhiles and endifs and closes the brackets $a =~ s/if/if (/g; #opens the if statement parenthesises $a =~ s/endfunction\;/}/g; #closes the function brackets and removes the endfunction $a =~ s/function (\w*) (\w*) (\w*) *;/sub \1 { \2 \3 /g;#names the functions as subroutines and formats them $a =~ s/while/while (/g; #opens the while parenthesises $a =~ s/\#/ != /g; #changes the unequals sign to the proper Perl != if (/if/) { $a =~ s/;/) {/g; } if (/@/){ $a =~ s/@/ @/g; } foreach $i (@variables) { $a =~ s/\b$i\b/\$$i/g; } print OUT "$a \n"; } close(IN); close(OUT);
newyear.pl
print "Please type the .fox file you would like to convert to Perl using Perl"; #prompts file input $cosy=chop(); #identifies target file open(IN,"$cosy") || die "Can't read the fox file"; #opens the target file if possible $a=$_; #reassigns the input to $a (because the program is stupid and won't do it directly) line by line print "$a \n"; #prints each modified line while ( ) { chop; $a=$_; if (/\bvariable\b/) { #identifies variables to be used throughout $i = index($_,"variable")+9; $v = substr($_,$i,\D); @split = split(/ /,$v); if ($split[2]) { # $a = "\@". reverse $split[0]; } push(@variables,$split[0]); $a = "# ". $a; } $a =~ s/type((\d*))=1/(\/\1/\d\/){/g; #supposively identifies whether the variable is a number $a =~ s/type((\w*))=2/(\/\1/\w\/){/g; #supposively identifies whether the variable is a string :*: $a =~ s/ss($(\w*),1,(\w*))='(\w*)/\$\1 =~ s\\3\/g/g; #changes substring matching to regular expressions $a =~ s/read 5 ([^; ]+)/\1 = chop( )/g; #changes the input format from cosy's read to Perl's STDIN $a =~ s/'/"/g; #changes the single quotes around strings to double quotes, the proper Perl format $a =~ s/([^:])=( *")/\1 eq \2/g; #an old attempt to match strings, the same purpose as :*:, incomplete $a =~ s/([^:])=( *[^"])/\1 == \2/g; #identifies true/false statements $a =~ s/:=/=/g; #changes := to the proper Perl assigning format of = $a =~ s/write 6/print/g; #changes write 6 to the proper print command $a =~ s/begin;/ /g; #removes the unneccessary begin $a =~ s/elseif/elsif/g; #fixes the spelling of elseif for Perl $a =~ s/endwhile;|endif;/}/g; #removes the unused endwhiles and endifs and closes the brackets $a =~ s/if/if (/g; #opens the if statement parenthesises $a =~ s/endfunction\;/}/g; #closes the function brackets and removes the endfunction $a =~ s/function (\w*) (\w*) (\w*) *;/sub \1 { \2 \3 /g;#names the functions as subroutines and formats them $a =~ s/while/while (/g; #opens the while parenthesises $a =~ s/\#/ != /g; #changes the unequals sign to the proper Perl != foreach $i (@variables) { $a =~ s/\b$i\b/\$$i/g; } print "$a \n"; }
To Do:
With a few summer additons
The result (onward.fox is the latest version of my cosy calculator)
The most modern
strife.pl. Well, it looks like progress...
Trash to sort: convert.pl:
Some of the mini-perl programs
Some useful testing cosy programs
My COSY calculator in all it's glory
Root Finding program using Newton's Method
Sheesh. This isn't nearly as many program bits as I have. This shouldn't be hard. RHRAHAHAHHA. Must...do...other....homework...and not stubbornly sit here trying to get this to work. Always something. Check out the bottom entry. Hmm-hhm-hmm. Apparently (according to Yahoo), the first few digits of pi are 3.14159 26535 89793 23846.
The closest I can get my program to give me is 3.141592653589789, which is good until the last two digits. Arrgrgrg. It worked and now it doesn't. I must have accidently changed something. Getting frustrated. Going to stop now. Tomorrow. Humph. And so it works fairly well. You can guess somepoint with a derivative of zero, you can put in a function without roots, you can find up to two different roots. It'll have trouble if you take a really stupid guess for some functions, but not generally. Hmm, I can't remember if Jens had any other things I should fix. Ah, well.
Yeah, I know. Must fix calc. program so that
open(IN,"onward.fox") || die "Can't read the fox file";
$a=$_;
open(OUT, ">datadump.pl") || die "Can't open datadump";
print OUT "$a \n";
print OUT "sub arccos { \n \t atan2( sqrt(1 - \$_[0] * \$_[0]), \$_[0] ); \n} \n";
print OUT "sub tan { \n \t sin(\$_[0]) / cos(\$_[0]); \n } \n";
print OUT "sub arcsin { \n \t 1 / sin(\$_[0]); \n } \n";
print OUT "sub arctan { \n \t atan2(\$_[0]/1); \n } \n";
print OUT "sub sinh { \n \t (exp(\$_[0])-exp(-\$_[0]))/2 ; \n } \n";
print OUT "sub cosh { \n \t (exp(\$_[0])+exp(-\$_[0]))/2 ; \n } \n";
print OUT "sub tanh { \n \t (exp(\$_[0])-exp(-\$_[0]))/(exp(\$_[0])+exp(-\$_[0])) ; \n } \n";
while (
sub arccos {
atan2( sqrt(1 - $_[0] * $_[0]), $_[0] );
}
sub tan {
sin($_[0]) / cos($_[0]);
}
sub arcsin {
1 / sin($_[0]);
}
sub arctan {
atan2($_[0]/1);
}
sub sinh {
(exp($_[0])-exp(-$_[0]))/2 ;
}
sub cosh {
(exp($_[0])+exp(-$_[0]))/2 ;
}
sub tanh {
(exp($_[0])-exp(-$_[0]))/(exp($_[0])+exp(-$_[0])) ;
}
# variable $n 80;
# @kcats
# variable $b 80;
# variable $a 80;
# variable $q 02;
# variable $stacknew 80;
# variable $y 80;
# variable $c 80;
# variable $r 01;
# variable $s 80;
# variable $w 80;
# variable $t 80;
# variable $g 01;
# variable $aone 80;
# variable $atwo 80;
sub ex { $c $a
ex=($c^$a);
}
sub hyper $c;
hyper=$c-int($c);
}
sub ss $a I1 I2 ;
substr $a I1 I2 ss ;
}
sub result1 $c;
if ( ss($b,1,3) eq "sin") {
result1 = sin($c);
elsif ( ss($b,1,3) eq "cos") {
result1 = cos($c);
elsif ( ss($b,1,3) eq "tan") {
result1 = tan($c);
elsif ( ss($b,1,2) eq "e^") {
result1 = exp($c);
elsif ( ss($b,1,2) eq "ln") {
result1 = log($c);
elsif ( ss($b,1,6) eq "arcsin") {
if ( $c ! == hyper($c)) {
result1 =$c;
elsif ( 1 == 1) {
result1 =asin($c);
}
elsif ( ss($b,1,6) eq "arccos") {
if ( $c ! == hyper($c)) {
result1 =$c;
elsif ( 1 == 1) {
result1 =acos($c);
}
elsif ( ss($b,1,6) eq "arctan") {
result1 =atan($c);
elsif ( ss($b,1,4) eq "sinh") {
result1 =sinh($c);
elsif ( ss($b,1,4) eq "cosh") {
result1 =cosh($c);
elsif ( ss($b,1,4) eq "tanh") {
result1 =tanh($c);
elsif ( ss($b,1,4) eq "sqrt") {
result1 =sqrt($c);
}
}
sub result { $a $c
if ( ss($b,1,3) eq "add") {
result = ($a+$c);
elsif ( ss($b,1,5) eq "minus") {
result = ($c-$a);
elsif ( ss($b,1,5) eq "times") {
result = ($c*$a);
elsif ( ss($b,1,6) eq "divide") {
if ( $a == 0) {
result =$c;
elsif ( 1 == 1) {
result = ($c/$a);
}
elsif ( ss($b,1,2) eq "ex") {
result =ex($c,$a);
elsif ( 1 == 1) {
result=$c;
}
}
$q=1;
$y=1;
print "Welcome to my calculator program.";
print "Available subs include: add, minus, divide, times, sin";
print "cos, tan, tanh, sinh, cosh, e^, ex(but it still has troubles)";
print "arcsin, arccos, arctan, sqrt, ln, and exit.";
print "We run in reverse polish here. Enjoy.";
while ( $r == 0;
$b == chop();
if ( type($b) == 1) { {if ( the user input is $a number}
for( $n 1 $q 1;
$stack($n+$q)=$b;
$aone=$stack($n+1);
$atwo=$stack($n);
endfor(;
$q=$q+1;
elsif ( type($b) == 2) { {if ( the user input is $a string}
if ( (ss($b,1,3) eq "sin")+(ss($b,1,3) eq "cos")+(ss($b,1,3) eq "tan")) {
$g=2;
elsif ( (ss($b,1,2) eq "e^")+(ss($b,1,2) eq "ln")+(ss($b,1,6) eq "arcsin")) {
$g=2;
elsif ( (ss($b,1,6) eq "arccos")+(ss($b,1,6) eq "arctan")+(ss($b,1,4) eq "sinh")) {
$g=2;
elsif ( (ss($b,1,4) eq "cosh")+(ss($b,1,4) eq "tanh")+(ss($b,1,4) eq "sqrt")) {
$g=2;
elsif ( (ss($b,1,3) eq "add")+(ss($b,1,5) eq "minus")) {
$g=0;
elsif ( (ss($b,1,5) eq "times")+(ss($b,1,6) eq "divide")+(ss($b,1,2) eq "ex")) {
$g=0;
elsif ( 1 == 1) {
$g=1;
}
if ( ss($b,1,4) ! eq "exit") {
if ( $g == 0) {
if ( ($n-$y) == 1) {
print "Warning: End of Stack";
}
$stacknew=result($atwo,$aone);
print result($atwo,$aone);
$aone=$stacknew;
$atwo=$stack($n-$y);
$y=($y+1);
elsif ( $g == 2) {
if ( ($n-$y) == 1) {
print "Warning: End of Stack";
{note you need at least two numbers on the $stack to perform
subs of two numbers, like adding}
}
$stacknew=result1($aone);
print result1($aone);
$aone=$stacknew;
elsif ( ss($b,1,4) ! eq "exit") {
print "Error: Not Proper Input";
}
elsif ( ss($b,1,4) eq "exit") {
$r=1;
}
}
}
print "End";
end;
open(IN,"../cosy/onward.fox") || die "Can't read the fox file";
$a=$_;
print "$a \n";
while (
open(IN,"../cosy/onward.fox") || die "Can't read the fox file";
$a=$_;
print "$a \n";
while (
open(IN,"test.fox") || die "Can't read the fox file";
$a=$_;
print "$a \n";
while (
open(EP,"test.fox") || die "Error 1";
# perl calc.pl
trigun.pl
open(IN,"test.fox") || die "Can't read the fox file";
while (
For the weekend's spare time.
Ok, here are my randev testing programs:
open(IN,"randev.fox") || die "Can't read the fox file";
while (
open(EP,"onward.fox") || die "Error 1";
# perl calc.pl
Bruce Newton's Method in progress:
clam.fox: YEAH! It works! Well, so long as you aren't too mean to it. It occures to me that I should probably write the root-finder in a loop and the the user specify how many they want to look for, or at least give an option of changing the number (though it would be easy enough just the copy the old script and modify x). On second thought, I should try to fix the calculator. Or try the Quadratum integral method. On with that. Hopefully, I won't completely screw the math up again. That tends to make these things fairly impossible. Internet says: "Grattan-Guinness, Ivor, '"Ad quadratum" and beyond: right-angled triangles generate all rectangles with sides in integral ratio', Zentralblatt für Didaktik der Mathematik 95/4 (1995), 138-9
A little-known but remarkably simple and beautiful theorem, concerning the geometry of right-angled triangles with integral sides, may be associated with the history of architecture and with Masonic symbolism. But the history remains to be explored.
" Is that what I'm using, hmm? There appears to be more information, but it's in German. Figures. Where's Pat when I need to know about obscure mathematics? Ok, maybe not tonight.
Root Finding program for only one root using Newton's Method
1
sin
arcsin
add
add
runs. Aieeieieieiei!