ttyoff: nolabels, true$ /* Metric prefixes */ metricprefull : [[yotta,10^24,4],[zetta,10^21,4],[exa,10^18,4],[peta,10^15,3], [tera,10^12,3],[giga,10^9,2],[mega,10^6,2],[kilo,10^3,1], [hecto,10^2,2],[deka,10^1,2],[deci,10^-1,2],[centi,10^-2,1], [milli,10^-3,1],[micro,10^-6,2],[nano,10^-9,2],[pico,10^-12,3], [femto,10^-15,3],[atto,10^-18,4],[zepto,10^-21,4], [yocto,10^-24,4]]; metricpre : [[Y,10^24,4],[Z,10^21,4],[E,10^18,4],[P,10^15,3],[T,10^12,3], [G,10^9,2],[M,10^6,2],[k,10^3,1],[h,10^2,2],[da,10^1,2], [d,10^-1,2],[c,10^-2,1],[%%m,10^-3,1],[%mu,10^-6,2],[n,10^-9,2], [p,10^-12,3],[f,10^-15,3],[a,10^-18,4],[z,10^-21,4], [y,10^-24,4]]; globalbaseunitlisting : [%length,%mass,%time]; /*Length */ %lengthlisting : [[[m,meter,meters],1,m],[[%in,inch,inches],0.0254,e]]; /*Mass*/ %masslisting : [[[kg,kilogram,kilograms],1,0],[[g,gram,grams],1/1000,m], [[gr,grain,grains],0.06479891,e]]; /*Time*/ %timelisting : [[[s,second,seconds],1,m],[[%min,minute,minutes],1/60,e]]; globalderivedunitlisting:[%force,%pressure,%energy]; /*Force*/ %forcelisting : [kg*m/s^2,[[N,%Newton,Newtons],1,d], [[dyn,dyne,dynes],1*10^-5,d]]; /*Pressure*/ %pressurelisting : [kg/(m*s^2),[[Pa,pascal,pascals],1,d],[[torr],133.32239,d]]; /*Energy, Work, Quantity of Heat */ %energylisting : [kg*m^2/s^2,[[J,joule,joules],1,m],[[eV,electron_volt,electron_volts],1.6021765*10^-19,m]]; unitlet(expression,ruleset) := apply('let,[expression,ruleset]); unitletsimp(expression,ruleset) := apply('letsimp,[expression,ruleset]); killruleset(ruleset) := apply('kill,[ruleset]); checkforuniqueness(list1) := block([i,j,return], return : true, for i : 1 thru length(list1) do ( for j : i+1 thru length(list1) do ( if ?equal(list1[i],list1[j]) then ( return : false) )), return); metricexpandall(%limit) := block([i,j,k,l,unitlistname, unitlistusename,tempentry], modedeclare([i,j,k,l], fixnum), for i : 1 thru length(globalbaseunitlisting) do ( unitlistname : concat(globalbaseunitlisting[i],listing), unitlistusename : concat(globalbaseunitlisting[i],listing_use), unitlistusename :: ev(unitlistname), for j : 1 thru length(ev(unitlistname)) do ( if (?equal(unitlistname[j][3],m)) then ( for k : 1 thru length(metricpre) do ( tempentry : [[0],0,expanded], if is(metricpre[k][3] <= %limit) then ( if (not(?equal(metricpre[k][1],'k) and ?equal(unitlistname[j][1][1],g))) then ( tempentry[1][1] : concat(metricpre[k][1],unitlistname[j][1][1]), tempentry[2] : metricpre[k][2]*unitlistname[j][2])), if is(metricprefull[k][3] <= %limit) then ( for l : 2 thru length(unitlistname[j][1]) do( if (not(?equal(metricprefull[k][1],kilo) and (?equal(unitlistname[j][1][l],gram) or ?equal(unitlistname[j][1][l],grams)))) then ( tempentry[1] : append(tempentry[1],[concat(metricprefull[k][1], unitlistname[j][1][l])]) ))), if not(?equal(tempentry[1][1],0)) then ( unitlistusename :: append(ev(unitlistusename),[tempentry])))))), for i : 1 thru length(globalderivedunitlisting) do ( unitlistname : concat(globalderivedunitlisting[i],listing), unitlistusename : concat(globalderivedunitlisting[i],listing_use), unitlistusename :: ev(unitlistname), for j : 2 thru length(ev(unitlistname)) do ( if (?equal(unitlistname[j][3],m)) then ( for k : 1 thru length(metricpre) do ( tempentry : [[0],0,expanded], if is(metricpre[k][3] <= %limit) then ( tempentry[1][1] : concat(metricpre[k][1],unitlistname[j][1][1]), tempentry[2] : metricpre[k][2]*unitlistname[j][2]), if is(metricprefull[k][3] <= %limit) then ( for l : 2 thru length(unitlistname[j][1]) do( tempentry[1] : append(tempentry[1],[concat(metricprefull[k][1], unitlistname[j][1][l])])), unitlistusename :: append(ev(unitlistusename),[tempentry])))))) ); maketoquantitiesruleset() := block([i,j,k,b,unitlistname], modedeclare([i,j,k], fixnum), for i : 1 thru length(globalbaseunitlisting) do ( unitlistname : concat(globalbaseunitlisting[i],listing_use), for j : 1 thru length(ev(unitlistname)) do ( for k : 1 thru length(unitlistname[j][1]) do ( unitlet([unitlistname[j][1][k],globalbaseunitlisting[i]], toquantities) ))), /* j needs to start at the second entry for Derived Quantity Arrays */ for i : 1 thru length(globalderivedunitlisting_use) do ( unitlistname : concat(globalderivedunitlisting_use[i][2],listing_use), for j : 2 thru length(ev(unitlistname)) do ( for k : 1 thru length(unitlistname[j][1]) do ( unitlet([unitlistname[j][1][k],globalderivedunitlisting_use[i][2]], toquantities) ))) ); isunit(candidate) := block([letrat:true,result], if not(?atom(candidate)) then ( /*Error message if argument to isunit isn't an atom*/ (error ("Argument to isunit was not an atom. Maxima requires units to be atoms. Erroneous input: ",candidate)) ) else ( /* This test simply checks if the candidate will return a quantity under the previously defined rules. If it does, then it is a unit. If it does not, then it will not be impacted by those simplification rules and the condition of equality will be satisfied. In such a case the result is that candidate is not a unit. */ if ?equal(candidate,letsimp(candidate,toquantities)) then ( /*Error if input isn't a unit - mentions the addunit command.*/ (error ("Input is not a unit. To define your own unit, use the addunit command."),candidate)) else ( true))); isbase(unit) := block([letrat:true,result,quantity], /*Uses the simplify to quantity ruleset and checks if the quantity is present in the base list.*/ if not(lfreeof(globalbaseunitlisting, letsimp(unit,toquantities))) then ( result : true) else ( if isunit(unit) then (result : false)), result); base(unit):= block([letrat:true,result,i,j,listname], modedeclare([i,j], fixnum), if not(isbase(unit)) then ( listname:concat(letsimp(unit,toquantities),listing_use), for i:1 thru length(ev(listname)) do ( for j:1 thru length(listname[i][1]) do ( if (?equal(unit,listname[i][1][j])) then ( result : listname[1]*listname[i][2] ) ))) else ( result : unit), result); quanttomks(quantity):= block([letrat:true,result,listname], listname:concat(quantity,listing_use), if not(lfreeof(globalbaseunitlisting,quantity)) then ( result : listname[1][1]) else ( if not(lfreeof(globalderivedunitlisting,quantity)) then ( result : listname[1]) else ( error ("Quantity not found"))), result); makequantlist(unitlist) := block([current_let_rule_package : toquantities, return1], return1 : map('letsimp,unitlist)); /* This defines rules for converting all base units to MKS. This is only updated when a new base unit is added - otherwise these rules are constant. */ makebasetoMKSrules():= block([letrat:true,i,j,a,b,fakerule], killruleset(basetoMKSrules), unitlet([fakerule,fakerule],basetoMKSrules), for a : 1 thru length(globalbaseunitlisting) do ( unitlistname : concat(globalbaseunitlisting[a],listing_use), for i : 2 thru length(ev(unitlistname)) do ( for j : 1 thru length(unitlistname[i][1]) do ( unitlet([unitlistname[i][1][j], base(unitlistname[i][1][j])],basetoMKSrules) ))) ); baserules(currentunitlist,unitlistname,baseunitrules):= block([letrat:true,i,j,a,b,fakerule], killruleset(baseunitrules), unitlet([fakerule,fakerule],baseunitrules), for i : 1 thru length(ev(unitlistname)) do ( if lfreeof(unitlistname[i][1],currentunitlist[1]) then ( for j : 1 thru length(unitlistname[i][1]) do ( if ?equal(abbrevsimp,1) then ( unitlet([unitlistname[i][1][j], unitlistname[i][2]/currentunitlist[2]* first(currentunitlist[1])],baseunitrules) )else( if ?equal(abbrevsimp,2) then ( unitlet([unitlistname[i][1][j], unitlistname[i][2]/currentunitlist[2]* last(currentunitlist[1])],baseunitrules) )else( a : length(unitlistname[i][1]), b : length(currentlistname[1]), if (?equal(a,b) or ?equal(j,1)) then ( unitlet([unitlistname[i][1][j], unitlistname[i][2]/currentunitlist[2]* currentunitlist[1][j]],baseunitrules) )else( unitlet([unitlistname[i][1][j], unitlistname[i][2]/currentunitlist[2]* last(currentunitlist[1])],baseunitrules) )) )))) ); rankquant(newquantity, listsanshighranks) := block([letrat : true, i,j,highnum,lower,lowerin,return1,lowerpart,higherpart, highestrank], kill(testfornew), unitlet([quanttomks(newquantity),newquantity],testfornew), listsanshighranks : reverse(sort(listsanshighranks)), highestrank : listsanshighranks[1][1], i : 1, highnum : 0, lower : true, while (?is(i<=length(listsanshighranks)) and ?equal(listsanshighranks[i][1],highestrank)) do ( highnum : highnum + 1, i : i + 1), for i : 1 thru highnum do ( if (?equal(ratsimp(letsimp(quanttomks(listsanshighranks[i][2]),testfornew)/ quanttomks(listsanshighranks[i][2])),1)) then ( lower : false) ), if (lower and ?equal(highestrank,1)) then ( for i : 1 thru length(listsanshighranks) do( listsanshighranks[i][1] : listsanshighranks[i][1] + 1), return1 : append(listsanshighranks,[[1,newquantity]]) ) else ( if lower then ( lowerpart : rankquant(newquantity,rest(listsanshighranks,highnum)), higherpart : rest(listsanshighranks,highnum-length(listsanshighranks)), if ?equal(lowerpart[1][1],last(higherpart)[1]) then ( for i : 1 thru length(higherpart) do ( higherpart[i][1] : higherpart[i][1] + 1)), return1 : append(higherpart,lowerpart) ) else ( if not(lower) then ( i : 1, lowerin : true, for i : 1 thru highnum do ( if (?equal(ratsimp(ratsubst('test,quanttomks(listsanshighranks[i][2]),quanttomks(newquantity))/ quanttomks(newquantity)),1)) then ( lowerin : false)), if lowerin then ( return1 : append([[highestrank+1,newquantity]],listsanshighranks) ) else ( return1 : append([[highestrank,newquantity]],listsanshighranks)) ))), return1); rankquants(quantityarray) := block([letrat : true, ranknew, rankmax, currentrank,i,j,returna], returna : [[1,quantityarray[1]]], quantityarray : rest(quantityarray,1), while ?is(length(quantityarray) > 0) do ( returna : rankquant(quantityarray[1],returna), quantityarray : rest(quantityarray,1)), returna); /* This defines rules for converting all derived units to MKS. This is only updated when a new derived unit is added - otherwise these rules are constant. */ makederivedtoMKSrules():= block([letrat:true,i,j,a,b,fakerule], killruleset(derivedtoMKSrules), unitlet([fakerule,fakerule],derivedtoMKSrules), for a : 1 thru length(globalderivedunitlisting_use) do ( unitlistname : concat(globalderivedunitlisting_use[a][2],listing_use), for i : 2 thru length(ev(unitlistname)) do ( for j : 1 thru length(unitlistname[i][1]) do ( unitlet([unitlistname[i][1][j], base(unitlistname[i][1][j])],derivedtoMKSrules) ))) ); /* This routine takes a list of definitions for a derived unit, and makes a ruleset for coverting from MKS to the derived quantitiy.*/ makeMKStoderivedrules(currentunit,unitlistname,derivedunitrules):= block([letrat:true,i,j,fakerule], killruleset(derivedunitrules), unitlet([fakerule,fakerule],derivedunitrules), if lfreeof(dontuselist,letsimp(currentunit,toquantities)) then ( for i : 2 thru length(ev(unitlistname)) do ( if not(lfreeof(unitlistname[i][1],currentunit)) then ( unitlet([unitlistname[1]*unitlistname[i][2],unitlistname[i][1][1]],derivedunitrules) )))); setunits(units):= block([letrat:true,unittype,unitlistname, unitrules,currentunitlist, flag, i, derivedunits], if listp(units) then ( if (checkforuniqueness(makequantlist(units))) then ( for i : 1 thru length(units) do ( unittype : letsimp(units[i],toquantities), unitlistname : concat(unittype,listing_use), unitrules : concat(unittype,'rules), if (not(isbase(units[i])) and (isunit(units[i]))) then ( makeMKStoderivedrules(units[i],unitlistname,unitrules) ) else ( flag : 0, i:0, while ?equal(flag,0) do ( i : i+1, if not(lfreeof(unitlistname[i][1],units)) then ( currentunitlist : unitlistname[i], flag : 1), if ?equal(i, length(ev(unitlistname))) then (flag : 1) ), baserules(currentunitlist,unitlistname,unitrules) )) ) else ( error ("Error - two or more of these units describe the same quantity.")) ) else ( error ("Error - argument to setunits must be a list, e.g. [N] instead of N.")) ); processunits(expression) := block([letrat:true,unitrules,result1], result1 : letsimp(expression,derivedtoMKSrules), result1 : letsimp(result1,basetoMKSrules), for i : 1 thru length(globalderivedunitlisting_use) do ( unitrules : concat(globalderivedunitlisting_use[i][2],'rules), result1 : unitletsimp(result1,unitrules) ), result1 : letsimp(result1,%lengthrules), result1 : letsimp(result1,%massrules), result1 : letsimp(result1,%timerules), result1); /* This variable controls how many of the metric prefixes are added on to the default lists*/ %unitexpand : 2; /* This is a list which contains quantities the user doesn't want simplified by the derived units simplifier. Default is empty. */ dontuselist : []; /* Places all relevant metric definitons into the %quantitylist lists.*/ metricexpandall(%unitexpand); /* Creates global list of derived quantities with rank assigned to each quantity to allow for proper simplification. Remember for addunit command and any similar commands to add a new quantity to the globalderivedunitlist, then recreate the use list. */ globalderivedunitlisting_use : rankquants(globalderivedunitlisting); /* Variable to control how simplification behaves with respect to fullnames and abbreviations. The default, 0, simplifies abbrev. to abbrev. and fullnames to fullnames, also preserving plurals when possible. There are two other possible settings: 1 : fullname -> abbreviation (singular and plural fullnames -> abbrev.) 2 : abbreviation -> fullname (will use plural form) */ abbrevsimp : 0; /* Create default toquantities ruleset*/ maketoquantitiesruleset(); makebasetoMKSrules(); makederivedtoMKSrules(); /* Activate processunits as a post_eval_function in order to enable automatic simplification of all unit output */ /*post_eval_functions : [processunits];*/