ssVersion:="Equation Library 0.05 by Han Duong";
// colors
ssFG:=#0h;
ssBG:=#FFFFFFh;
ssR:=#FF0000h;
ssG:=#FF00h;
ssB:=#FFh;
// error messages
ssInvDat:="Invalid library data.";
ssNoDat:="Unable to locate library data.";
ssNullName:="Null name not allowed.";
ssInvName:="Invalid name.";
ssAbort:="Operation aborted; improper initialization.";
ssBadVar:="Conflict with existing variable:\n";
ssSubmitBug:="This should never happen!\nPLease submit bug report.";
ssNotEqn:="Non-equation on page ";
ssNonVar:="No such var. on page ";
ssNoLibDat:="No library data found.\nCreating empty library and empty\ninitial system.";
ssEOW:="Overwrite disabled and name already exists:\n";
ssNotSaved:="SAVE CANCELED!";
ssMustChoose:="Select a system or create a new one.";
ssNoVars:="No variables for this system!";
ssNoSystems:="No systems in library!";
// app messages
ssTNewVar:="Create/Edit Variable";
ssLName:="Name:";
ssLDescr:="Description:";
ssLOWrite:="Overwrite";
ssHName:="Enter the variable name";
ssHDescr:="Enter a description for the variable";
ssHOWrite:="Overwrite if variable already exists?";
ssTSaveSys:="Save Current System";
ssHSysName:="Enter a name for the system.";
ssLEqns:="Eqns:";
ssLVars:="Vars:";
ssHEqns:="Verify equations in system.";
ssHVars:="Verify variables for system.";
ssTNewSys:="New System";
ssTChooseSys:="Choose a System";
ssHMakeConst:="Make this variable constant?";
ssTDeleteSys:="Select Systems to Delete";
ssHMarkDel:="Mark for deletion?";
ssTSettings:="Equation Library Settings";
ssLSaving:="When switching systems, always";
ssCSaving:={ "prompt to save", "save automatically", "discard all changes"};
ssHSaving:="Select default save behavior";
// misc
ssVLoadEqns:="Populating equations in Symb view...";
ssVLoadVars:="Setting up equation variables...";
ssVCheckVars:="Verifying variables in system...";
ssVCheckLibDat:="Verifying library data...";
ssVUpdateEqns:="Equations modified; updating lib data...";
ssVUpdateVars:="Variables modified; updating lib data...";
ssVNoEqns:="(No equations)";
ssVNoVars:="(No variables)";
ssVVarMade:="Created variable: ";
// View menu options
ssTSEP:="Select Equations Page";
ssTSelPage:="Select New Page";
ssTNewPage:="Create New Page";
ssMsgRow;
export ssInit;
ssLibFN;
export ssCurSys;
export ssCurSysIndex;
export ssCurLib;
ssLibSize;
export ssSysTitles;
ssVarKey:="SSVersion";
export ssEqPages;
export ssEqPage;
export ssNullSys;
export ssWarning;
export ssSolveVars:={};
// DO NOT MODIFY BELOW HERE
ssGlobal:={ "A", "B", "C", "D", "E", "F", "G",
"H", "I", "J", "K", "L", "M", "N",
"O", "P", "R", "S", "T", "U", "V",
"W", "X", "Y", "Z", "θ",
"Z0", "Z1", "Z2", "Z3", "Z4",
"Z5", "Z6", "Z7", "Z8", "Z9"
};
ssUpdateSys()
begin
local n;
ssEqPages:={1,10};
n:=size(ssCurSys(2));
ssNullSys:=NOT(n);
ssEqPages(1):=ip((n-1)/10);
ssEqPages(2):=(n-1) mod 10;
ssEqPage:=0;
for n from 1 to size(ssCurSys(4)) do
if NOT(ssCurSys(7,n)) then ssSolveVars(0):=ssCurSys(4,n); end;
end;
DelAVars(AVars);
end;
ssInitSSApp()
begin
local j,run:=1;
local cmd:="";
if ssInit then return; end;
dimgrob_p(G1,320,240);
ssLibFN:="Equation Library.lib";
ssVarKey:="SSVersion";
ssWarning:=1;
iferr
ssCurLib:=AFiles(ssLibFN);
then
msgbox(ssNoLibDat);
ssCurLib:={};
AFiles(ssLibFN):=ssCurLib;
end;
for j from 0 to 9 do
cmd:="E" + string(j,1,0) + ":=" + string("");
expr(cmd);
end;
// always start app with new system
ssCurSys:={ssTNewSys, {}, {}, {}, {}, {}, {} };
ssLibSize:=size(ssCurLib);
if ssLibSize then
ssSysTitles:=makelist(ssCurLib(j,1),j,1,ssLibSize);
end;
ssCurSysIndex:=0;
ssUpdateSys();
ssInit:=1;
end;
ssPrint(msg)
begin
textout_p(msg,G1,0,12*ssMsgRow,1,ssFG,320,ssBG);
line_p(G1,0,12*ssMsgRow+12,12,12*ssMsgRow+12,ssR);
ssMsgRow:=(ssMsgRow+1) mod 20;
end;
ssError(msg)
begin
textout_p(msg,G1,0,12*ssMsgRow,1,ssR,320,ssBG);
line_p(G1,0,12*ssMsgRow+12,12,12*ssMsgRow+12,ssR);
ssMsgRow:=(ssMsgRow+1) mod 20;
end;
ssWarn(msg)
begin
if ssWarning then
msgbox(msg);
end;
end;
ssCheckType(list,t)
begin
local n:=size(list);
if n then
if type(list(n))<>t then return(1); end;
else
return(1);
end;
return(0);
end;
//******************************************
// Library Data format
// { sys1, sys2, ... , sysN }
//
// Each sys (system) is a list of the form
// {
// "Title",
// { "eq1", "eq2", ... },
// { sel1, sel2, ... },
// { "var1", "var2", ... },
// { "des1", "des2", ... },
// { val1, val2, ... },
// { con1, con2, ... }
// }
//
// eq = equation
// sel = 0 or 1 for selection of corresponding
// equation in the system
// var = variable
// des = description of variable
// val = value of corresponding variable
// con = 0 or 1 for whether var is constant
//
// returns 0 if error or 1 if OK
//******************************************
export ssCheckLibDat()
begin
ssPrint(ssVCheckLibDat);
ssInitSSApp();
local syseqs,j,k;
local lib, isbad:=0;
local types:={2,2,0,2,2,0,0};
iferr
if ssLibSize then
for j from 1 to ssLibSize do
lib:=ssCurLib(j);
if type(lib)<>6 then
ssError(ssInvDat); return(0);
else
k:=size(lib);
if (k<1) OR (k>7) then
ssError(ssInvDat); return(0);
end;
for k from 2 to 7 do
if type(lib(k))<>6 then
ssError(ssInvDat); return(0);
end;
if ssCheckType(lib(k),types(k)) then
ssError(ssInvDat); return(0);
end;
end; // for k
end; // if type(lib)
end; // for j
end; // if ssLibSize
then
ssError(ssNoDat); return(0);
end;
return(1);
end;
// initialize variables
ssInitVars()
begin
local varslist:=ssCurSys(4);
local valslist:=ssCurSys(6);
local n:=size(varslist);
local j,varval;
iferr
if (AVars(ssVarKey) == ssVersion) then
return;
end;
then
// nop
end;
ssPrint(ssVLoadVars);
for j from 1 to n do
if pos(ssGlobal,varslist(j)) then
expr(varslist(j) + ":=" + valslist(j));
else
varval:=CAS(EVAL(varslist(j)));
purge(EVAL(varslist(j)));
if (type(CAS(EVAL(varslist(j)))) <> 8) then
ssWarn(ssBadVar+varslist(j));
end;
if ( (type(varval) == 0) OR (type(varval) == 3) ) then
AVars(varslist(j)):=varval;
else
AVars(varslist(j)):=valslist(j);
end;
end;
end;
AVars(ssVarKey):=ssVersion;
end;
// checks to see if AVars and system of equations
// vars match; excludes version key
export ssCheckVars()
begin
ssPrint(ssVCheckVars);
ssInitSSApp();
ssInitVars();
local j,n;
local avarlist:=AVars();
local varlist:=ssCurSys(4);
n:=size(varlist);
for j from 1 to n do
if NOT(pos(avarlist,varlist(j)) OR pos(ssGlobal,varlist(j))) then
return(0);
end;
end;
n:=size(avarlist);
for j from 1 to n do
if ( (avarlist(j) <> ssVarKey) AND NOT(pos(varlist,avarlist(j))) ) then
return(0);
end;
end;
return(1);
end;
// do we have any equations
// 1: yes, equations in symb view
// 0: no equations at all
// -1: yes, but only saved in library
ssHaveEqns()
begin
local j;
for j from 0 to 9 do
if ISCHECK(j) then return(1); end;
end;
if (ssLibSize == 0) then return(0); end;
if (type(ssCurSys) <> 6) then return(0); end;
if size(ssCurSys) then
if size(ssCurSys(2)) then
return(-1);
else
return(0);
end;
else
return(0);
end;
end;
// UI for creating new variables
ssCreateVar()
begin
local run:=1;
local n;
local varname:="", varinfo:="";
local ow:=0;
ssInitSSApp();
ssInitVars();
while run do
if input(
{
{varname, [2], {30, 65, 0}},
{varinfo, [2], {30, 65, 1}},
{ow, 1, {30,10,2}}
},
ssTNewVar,
{ ssLName, ssLDescr, ssLOWrite },
{ ssHName, ssHDescr, ssHOWrite }
)
then
if size(varname)<1 then
msgbox(ssNullName);
else
n:=pos(AVars,varname);
if n then
if ow then
n:=pos(ssCurSys(4),varname);
ssCurSys(5,n):=varinfo;
run:=0;
else
msgbox(ssEOW + varname);
end;
else
iferr
if NOT(pos(ssGlobal,varname)) then
AVars(varname):=0;
end;
then
msgbox(ssInvName);
else
purge(EVAL(varname));
ssCurSys(4,0):=varname;
ssCurSys(5,0):=varinfo;
ssCurSys(6,0):=0;
ssCurSys(7,0):=0;
msgbox(ssVVarMade + varname);
varname:=""; varinfo:="";
end;
end;
end; // end null name
else
run:=0;
end;
end; // end while
end;
// save current equations
ssSaveEqns()
begin
local j,k,n1,n2;
local cmd:="";
local oldeqn:="";
local neweqn:="";
local markadd:=0;
local neweqns:={};
local teqnlist:={};
local tsellist:={};
if ssCheckVars() then
ssPrint(ssVLoadEqns);
n1:=ssEqPage*10+1;
if (ssEqPage < ssEqPages(1)) then
n2:=n1+9;
else
n2:=n1+ssEqPages(2);
end;
for j from n1 to n2 do
k:= j mod 10;
cmd:="string(E" + string(k,1,0) + ",1,12)";
iferr
neweqn:=expr(cmd);
then
neweqn:="";
else
if ssNullSys then
oldeqn:="";
else
cmd:="E" + string(k,1,0) + ":=" + string(ssCurSys(2,j));
iferr expr(cmd); then end;
cmd:="string(E" + string(k,1,0) + ",1,12)";
iferr oldeqn:=expr(cmd); then end;
end;
if (oldeqn <> neweqn) then
if ssNullSys then
ssCurSys(2,0):=neweqn;
else
ssCurSys(2,j):=neweqn;
end;
end;
end;
cmd:="E" + string(k,1,0) + ":=" + string(neweqn);
iferr expr(cmd); then
// msgbox(ssSubmitBug);
end;
if ISCHECK(k) then
ssCurSys(3,j):=1;
else
ssCurSys(3,j):=0;
end;
if (size(neweqn) == 0) then
ssCurSys(3,j):=-1; // mark for delete
end;
end; // end for j
n2:=n1+9;
for k from j to n2 do
n1:=k mod 10;
cmd:="string(E" + string(n1,1,0) + ",1,12)";
iferr
neweqn:=expr(cmd);
then
// nop
else
if size(neweqn) then
neweqns(0):=neweqn;
neweqns(0):=ISCHECK(n1);
markadd:=1;
end;
end;
end; // end for k
// rebuilt existing equations
k:=0;
n2:=size(ssCurSys(2));
for j from 1 to n2 do
if (ssCurSys(3,j) >= 0) then
teqnlist(0):=ssCurSys(2,j);
tsellist(0):=ssCurSys(3,j);
k:=k+1;
end;
end;
ssCurSys(2):=teqnlist;
ssCurSys(3):=tsellist;
if markadd then
n2:=size(neweqns)/2;
for j from 1 to n2 do
ssCurSys(2,0):=neweqns(2*j-1);
ssCurSys(3,0):=neweqns(2*j);
k:=k+1;
end;
end;
ssEqPages(1):=ip((k-1)/10);
ssEqPages(2):=(k-1) mod 10;
ssEqPage:=min(max(0,ssEqPage),ssEqPages(1));
if k then
ssNullSys:=0;
else
ssNullSys:=1;
end;
return(1);
else
msgbox(ssAbort);
return(0);
end;
end;
// set up equations in Symb view
export ssLoadSymb()
begin
local j,k,n1,n2;
local cmd:="";
// no equations to populate Symb view?
if ssNullSys then
for j from 0 to 9 do
cmd:="E" + string(j,1,0) + ":=" + string("");
expr(cmd);
end;
return(1);
end;
ssPrint(ssVLoadEqns);
n1:=ssEqPage*10+1;
if (ssEqPage < ssEqPages(1)) then
n2:=n1+9;
else
n2:=n1+ssEqPages(2);
end;
for j from n1 to n2 do
k:= j mod 10;
cmd:="E" + string(k,1,0) + ":=" + string(ssCurSys(2,j));
iferr expr(cmd); then end;
if (ssCurSys(3,j)==1) then CHECK(k); else UNCHECK(k); end;
end;
n2:=n1+9;
for k from j to n2 do
n1:=k mod 10;
cmd:="E" + string(n1,1,0) + ":=" + string("");
expr(cmd);
end;
return(1);
end;
// select an equations page
ssSelectEqPage()
begin
ssInitSSApp();
local j;
local n:=ssEqPages(1)+1;
local page:=ssEqPage+1;
local curpage:=page;
local pagelist:={};
local title:="[" + string(page,1,0) + "/" + string(ssEqPages(1)+1,1,0) + "] " + ssTSelPage;
pagelist:=makelist(j,j,1,n);
pagelist(0):=ssTNewPage;
if choose(page,title,pagelist) then
if (curpage <> page) then
ssSaveEqns();
if (page == (n+1)) then
if (ssNullSys == 0) then
ssEqPages(1):=n+1;
// fill last page
if (ssEqPages(2) < 9) then
n:=9-ssEqPages(2);
for j from 1 to n do
ssCurSys(2,0):="";
ssCurSys(3,0):=-1; // mark for deletion
end;
end;
end;
// create new page
for j from 1 to 10 do
ssCurSys(2,0):="";
ssCurSys(3,0):=-1; // mark for deletion
end;
n:=size(ssCurSys(2));
ssEqPage:=ip((n-1)/10);
ssEqPages(1):=ssEqPage;
ssEqPages(2):=(n-1) mod 10;
ssNullSys:=0;
else
// not creating new blank page
ssEqPage:=min(max(0,page-1),ssEqPages(1));
end; // if newpage or existing page
end; // if selpage <> page
ssLoadSymb();
end; // if choose
end;
// set new system
export ssSetSystem(n)
begin
if (n > ssLibSize) then
return(0);
end;
ssCurSysIndex:=n;
ssCurSys:=ssCurLib(n);
ssUpdateSys();
ssInitVars();
ssLoadSymb();
end;
ssErrorPage(n,msg,eqn)
begin
local p:=ip((n-1)/10)+1;
msgbox(msg + n + ":\n" + eqn);
end;
// check if equations are valid
// assumes equations have been saved
export ssCheckEqns()
begin
local n:=size(ssCurSys(2));
local eqn:="";
local j,k,v;
local varlist:={};
if n then
// check each equation
for j from 1 to n do
eqn:=ssCurSys(2,j);
// do we have = symbol?
if instring(eqn,"=") then
iferr eqn:=string(E0,1,12); then eqn:=""; end;
E0:=ssCurSys(2,j);
varlist:=LNAME(E0);
v:=size(varlist);
if v then
for k from 1 to v do
if (pos(ssCurSys(4),string(varlist(k))) == 0) then
ssErrorPage(ip((j-1)/10)+1,ssNonVar,ssCurSys(2,j)+"\n> "+varlist(k));
iferr E0:=eqn; then end;
return(0);
end;
end;
else
// constants only? not equation
ssErrorPage(j,ssNotEqn,ssCurSys(2,j));
iferr E0:=eqn; then end;
return(0);
end;
iferr E0:=eqn; then end;
else
// no equal symbol; report page
ssErrorPage(j,ssNotEqn,eqn);
return(0);
end;
end;
// all eqns seem ok
return(1);
else
// no equations to check
return(-1);
end;
end;
// save current system
// no null names but does not check
// validity of names beyond whether
// AVars will accept such a name
ssSaveSystem()
begin
ssSaveEqns();
local sysname:=ssCurSys(1);
local eqns:=ssCurSys(2);
local vars:=ssCurSys(4);
local eqn,var,n;
local run:=1;
// bug in input when choose lists are empty
if (size(eqns) < 1) then eqns:={ ssVNoEqns }; end;
if (size(vars) < 1) then vars:={ ssVNoVars }; end;
while run do
if input(
{
{ sysname, [2], { 15, 75, 0 } },
{ eqn, eqns, { 15, 75, 1 } },
{ var, vars, { 15, 75, 2 } }
},
ssTSaveSys,
{ ssLName, ssLEqns, ssLVars },
{ ssHSysName, ssHEqns, ssHVars }
)
then
if size(sysname) then
// maybe later add check for dupes
n:=pos(ssSysTitles, sysname);
if ssCheckEqns() then
ssCurSys(1):=sysname;
ssCurLib(ssCurSysIndex):=ssCurSys;
AFiles(ssLibFN):=ssCurLib;
if (ssCurSysIndex == 0) then ssCurSysIndex:=size(ssCurLib); end;
ssLibSize:=size(ssCurLib);
else
ssWarn(ssNotSaved);
end;
run:=0;
else
msgbox(ssNullName);
end;
else
// user canceled
ssWarn(ssNotSaved);
run:=0;
end;
end; // end while;
end;
// create a system
ssNewSystem()
begin
ssCurSys:={ssTNewSys, {}, {}, {}, {}, {}, {} };
ssCurSysIndex:=0;
ssUpdateSys();
ssInitVars();
ssLoadSymb();
startview(0,1);
end;
ssChooseSys()
begin
local n,t;
local run:=1;
local systitles:={};
n:=ssCurSysIndex;
iferr
ssCurLib:=AFiles(ssLibFN);
then
ssWarn(ssNoLibDat);
ssCurLib:={};
AFiles(ssLibFN):=ssCurLib;
end;
ssLibSize:=size(ssCurLib);
if ssLibSize then
systitles:=makelist(ssCurLib(n,1),n,1,ssLibSize);
else
systitles:={};
end;
ssSysTitles:=systitles;
systitles(0):=ssTNewSys;
t:=choose(n, ssTChooseSys, systitles);
if t then
if ( n <= ssLibSize ) then
ssSetSystem(n);
else
ssNewSystem();
end;
return(1);
end;
return(0);
end;
// UI for deleting systems
export ssDeleteSys()
begin
local cmd:="input({";
local systitles;
local j;
local selected:={};
local lib:={};
if ssLibSize then
selected:=makelist(0,j,1,ssLibSize);
systitles:=makelist(ssCurLib(j,1),j,1,ssLibSize);
for j from 1 to ssLibSize do
cmd:=cmd + "{selected(" + string(j,1,0) + "),0,{94,5," + string(j-1,1,0) + "}}";
if (j<ssLibSize) then cmd:=cmd + ",\n"; end;
end;
cmd:=cmd + "},\n" + string(ssTDeleteSys) + ",\n{";
for j from 1 to ssLibSize do
cmd:=cmd + string(ssCurLib(j,1));
if (j<ssLibSize) then cmd:=cmd + ",\n"; end;
end;
cmd:=cmd + "},\n{";
for j from 1 to ssLibSize do
cmd:=cmd + string(ssHMarkDel);
if (j<ssLibSize) then cmd:=cmd + ",\n"; end;
end;
cmd:=cmd + "},\n" + string(selected,1,0) + ",\n" + string(selected,1,0) + ")";
Notes("eqlib_debug.log"):=cmd;
j:=expr(cmd);
if j then
// current system deleted? if so set index to 0
if ssCurSysIndex then
if selected(ssCurSysIndex) then
ssCurSysIndex:=0;
end;
end;
// rebuild library and adjust index
for j from 1 to ssLibSize do
if NOT(selected(j)) then
lib(0):=ssCurLib(j);
if (j < ssCurSysIndex) then
ssCurSysIndex:= ssCurSysIndex - 1;
end;
end;
end;
ssCurLib:=lib;
AFiles(ssLibFN):=ssCurLib;
end;
else
ssWarn(ssNoSystems);
end;
end;
// variable browser
export ssVarBrowser()
begin
local vals:=ssCurSys(6);
local cons:=ssCurSys(7);
local cmd:="input({";
local n:=size(vals);
local j,k;
local tmp:="";
local xloc:="15,75";
if (n<1) then
msgbox(ssNoVars);
return(0);
end;
k:=1;
for j from 1 to n do
k:=max(k,size(ssCurSys(4,j)));
end;
if (k > 3) then xloc:="30,60"; end;
// build input( ... )
// { variable, type, { pos } }
for j from 1 to n do
k:=pos(ssGlobal, ssCurSys(4,j));
if (k<28) then tmp:="0"; else tmp:="0,3"; end;
cmd:=cmd + "{vals(" + string(j,1,0) + "),[" + tmp + "],{" + xloc + "," + string(j-1,1,0) + "}}, ";
cmd:=cmd + "{cons(" + string(j,1,0) + "),0,{94,5," + string(j-1,1,0) + "}}";
if ((n>1) AND (j<n)) then cmd:=cmd + ",\n"; end;
end;
// add title
cmd:=cmd + "},\n" + string(ssCurSys(1) + " Variables") + ",\n{";
// add labels
for j from 1 to n do
cmd:=cmd + string(ssCurSys(4,j) + "=") + ", " + string("");
if ((n>1) AND (j<n)) then cmd:=cmd + ",\n"; end;
end;
cmd:=cmd + "},\n{";
// add help
for j from 1 to n do
cmd:=cmd + string(ssCurSys(4,j) + ": " + ssCurSys(5,j)) + "," + string(ssHMakeConst);
if ((n>1) AND (j<n)) then cmd:=cmd + ",\n"; end;
end;
cmd:=cmd + "},\n";
// add init and reset vals
tmp:="{";
for j from 1 to n do
tmp:=tmp + vals(j) + "," + cons(j);
if ((n>1) AND (j<n)) then tmp:=tmp + ","; end;
end;
tmp:=tmp + "}";
cmd:=cmd + tmp + ",\n" + tmp + ")";
Notes("eqlib_debug.log"):=cmd;
j:=expr(cmd);
if j then
ssCurSys(6):=vals;
ssCurSys(7):=cons;
for j from 1 to n do
if pos(ssGlobal,ssCurSys(4,j)) then
expr(ssCurSys(4,j) + ":=" + vals(j));
else
AVars(ssCurSys(4,j)):=vals(j);
end;
end;
end;
return(j);
end;
// build F, F(var1, var2, ...) and Jacobian
// assumes all equations and variables have been
// validated; also assumes equations are saved and
// that selectd equations form a non-null list
// saves F as ssF (CAS variable)
export casMakeF()
begin
local cmd:="['";
local cmd2:="[";
local j,n;
local varlist:={};
local eqnlist:={};
local k:=size(ssCurSys(4));
local vstr1:="";
local vstr2:="";
local vstr3:="";
n:=size(ssCurSys(2));
for j from 1 to n do
if ssCurSys(3,j) then
eqnlist(0):=ssCurSys(2,j);
end;
end;
for j from 1 to k do
if NOT(ssCurSys(7,j)) then
varlist(0):=j;
end;
end;
ssSolveVars:=varlist;
n:=k-1;
for j from 1 to n do
vstr1:=vstr1 + ssCurSys(4,j) + ",";
end;
vstr1:=vstr1 + ssCurSys(4,k);
n:=size(varlist)-1;
for j from 1 to n do
vstr2:=vstr2 + ssCurSys(4,varlist(j)) + ",";
end;
vstr2:=vstr2 + ssCurSys(4,varlist(n+1));
// ssF:=( vars ) -> [ f1, f2, ... ]
n:=size(eqnlist)-1;
for j from 1 to n do
cmd:=cmd + eqnlist(j) + ")','";
cmd2:=cmd2 + eqnlist(j) + "),";
end;
cmd:=cmd + eqnlist(n+1) + ")']";
cmd:=replace(cmd,"=","-(");
CAS(EVAL("ssF:=" + cmd));
cmd2:=cmd2 + eqnlist(n+1) + ")]";
cmd2:=replace(cmd2,"=","-(");
CAS(EVAL("ssFx:=(" + vstr1 + ")->(" + cmd2 + ")"));
cmd:="ssJ:=transpose(diff(" + cmd + ",[" + vstr2 + "]))";
CAS(EVAL(cmd));
end;
// Newton's Method
// dx = - J^(-1) * F
// x[n+1] = x[n] + dx
export casNewton()
begin
local j,k,nsv,nv;
local dx;
local var;
local tolF:=1.0E-8; // exit if F.F < tolF
local nsF=2*tolF; // initial squared norm of F
local vecNewt:={};
L1:={};
nv:=size(ssCurSys(4));
nsv:=size(ssSolveVars);
for j from 1 to nv do
vecNewt(0):=ssCurSys(6,j);
end;
for k from 1 to 100 do
nsF:=CAS("approx(ssF*ssF)");
if (nsF < tolF) then break; end;
dx:=CAS("-ssJ^(-1)*transpose(approx(ssF))");
for j from 1 to nsv do
var:=ssCurSys(4,ssSolveVars(j));
if pos(ssGlobal,var) then
expr(var + ":=" + var + "+" + dx(j,1));
else
AVars(var):=AVars(var) + dx(j,1);
end;
ssCurSys(6,ssSolveVars(j)):=expr(var);
end; // for j
for j from 1 to nv do
vecNewt(0):=ssCurSys(6,j);
end;
end; // for k
return(list2mat(vecNewt,nv));
end;
START()
begin
// startview(-1,1);
ssInitSSApp();
ssInitVars();
startview(0,1);
end;
// Equations Editor
Symb()
begin
if ssInit then
ssSaveEqns();
else
ssInitSSApp();
ssInitVars();
end;
ssLoadSymb();
startview(0,1);
end;
// System of Equations browswer
Plot()
begin
if ssInit then
ssSaveSystem();
else
ssInitSSApp();
ssInitVars();
end;
ssChooseSys();
startview(0,1);
end;
// run solver
Num()
begin
local matNewt:=[[0]];
local j;
local tlist:={};
local labels:={};
if ssInit then
ssSaveEqns();
ssVarBrowser();
casMakeF();
matNewt:=casNewton();
tlist(0):=ssCurSys(1);
tlist(0):={};
for j from 1 to size(ssSolveVars) do
labels(0):=ssCurSys(4,ssSolveVars(j));
end;
tlist(0):=labels;
editmat(matNewt,tlist);
else
ssInitSSApp();
ssInitVars();
end;
end;
// Set up initial guess
NumSetup()
begin
if ssInit then ssSaveEqns(); end;
ssVarBrowser();
end;
// select equations page (View Menu)
view "Select Page", ssMenuEqnPage()
begin
ssSelectEqPage();
startview(0,1);
end;
// UI for creating new variables (View Menu)
view "Add/Edit Variable", ssMenuNewVar()
begin
ssCreateVar();
end;
// reload saved equations (View Menu)
view "Restore Equations", ssMenuLoadEqns()
begin
if ssCurSysIndex then
ssCurSys:=ssCurLib(ssCurSysIndex);
ssUpdateSys();
ssInitVars();
end;
ssLoadSymb();
startview(0,1);
end;
// save current system (View Menu)
view "Save System", ssMenuSaveSys()
begin
ssSaveSystem();
end;
// create new system (View Menu)
view "New System", ssMenuNewSys()
begin
ssSaveSystem();
ssNewSystem();
end;
// delete existing system (View Menu)
view "Delete System", ssMenuDelSys()
begin
ssSaveSystem();
ssDeleteSys();
end;
// select system (View Menu)
view "Select System", ssMenuSetSys()
begin
ssSaveSystem();
if ssChooseSys() then startview(0,1); end;
end;
Search
Member List
Calendar
Help
/
Creating an equation library (Updated 03-FEB-2017)
