dcfsfkacem.red 139 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687268826892690269126922693269426952696269726982699270027012702270327042705270627072708270927102711271227132714271527162717271827192720272127222723272427252726272727282729273027312732273327342735273627372738273927402741274227432744274527462747274827492750275127522753275427552756275727582759276027612762276327642765276627672768276927702771277227732774277527762777277827792780278127822783278427852786278727882789279027912792279327942795279627972798279928002801280228032804280528062807280828092810281128122813281428152816281728182819282028212822282328242825282628272828282928302831283228332834283528362837283828392840284128422843284428452846284728482849285028512852285328542855285628572858285928602861286228632864286528662867286828692870287128722873287428752876287728782879288028812882288328842885288628872888288928902891289228932894289528962897289828992900290129022903290429052906290729082909291029112912291329142915291629172918291929202921292229232924292529262927292829292930293129322933293429352936293729382939294029412942294329442945294629472948294929502951295229532954295529562957295829592960296129622963296429652966296729682969297029712972297329742975297629772978297929802981298229832984298529862987298829892990299129922993299429952996299729982999300030013002300330043005300630073008300930103011301230133014301530163017301830193020302130223023302430253026302730283029303030313032303330343035303630373038303930403041304230433044304530463047304830493050305130523053305430553056305730583059306030613062306330643065306630673068306930703071307230733074307530763077307830793080308130823083308430853086308730883089309030913092309330943095309630973098309931003101310231033104310531063107310831093110311131123113311431153116311731183119312031213122312331243125312631273128312931303131313231333134313531363137313831393140314131423143314431453146314731483149315031513152315331543155315631573158315931603161316231633164316531663167316831693170317131723173317431753176317731783179318031813182318331843185318631873188318931903191319231933194319531963197319831993200320132023203320432053206320732083209321032113212321332143215321632173218321932203221322232233224322532263227322832293230323132323233323432353236323732383239324032413242324332443245324632473248324932503251325232533254325532563257325832593260326132623263326432653266326732683269327032713272327332743275327632773278327932803281328232833284328532863287328832893290329132923293329432953296329732983299330033013302330333043305330633073308330933103311331233133314331533163317331833193320332133223323332433253326332733283329333033313332333333343335333633373338333933403341334233433344334533463347334833493350335133523353335433553356335733583359336033613362336333643365336633673368336933703371337233733374337533763377337833793380338133823383338433853386338733883389339033913392339333943395339633973398339934003401340234033404340534063407340834093410341134123413341434153416341734183419342034213422342334243425342634273428342934303431343234333434343534363437343834393440344134423443344434453446344734483449345034513452345334543455345634573458345934603461346234633464346534663467346834693470347134723473347434753476347734783479348034813482348334843485348634873488348934903491349234933494349534963497349834993500350135023503350435053506350735083509351035113512351335143515351635173518351935203521352235233524352535263527352835293530353135323533353435353536353735383539354035413542354335443545354635473548354935503551355235533554355535563557355835593560356135623563356435653566356735683569357035713572357335743575357635773578357935803581358235833584358535863587358835893590359135923593359435953596359735983599360036013602360336043605360636073608360936103611361236133614361536163617361836193620362136223623362436253626362736283629363036313632363336343635363636373638363936403641364236433644364536463647364836493650365136523653365436553656365736583659366036613662366336643665366636673668366936703671367236733674367536763677367836793680368136823683368436853686368736883689369036913692369336943695369636973698369937003701370237033704370537063707370837093710371137123713371437153716371737183719372037213722372337243725372637273728372937303731373237333734373537363737373837393740374137423743374437453746374737483749375037513752375337543755375637573758375937603761376237633764376537663767376837693770377137723773377437753776377737783779378037813782378337843785378637873788378937903791379237933794379537963797379837993800380138023803380438053806380738083809381038113812381338143815381638173818381938203821382238233824382538263827382838293830383138323833383438353836383738383839384038413842384338443845384638473848384938503851385238533854385538563857385838593860386138623863386438653866386738683869387038713872387338743875387638773878387938803881388238833884
  1. % ----------------------------------------------------------------------
  2. % $Id: dcfsfkacem.red,v 1.4 2004/03/23 11:31:45 dolzmann Exp $
  3. % ----------------------------------------------------------------------
  4. % copyright (c) 2004 thomas sturm
  5. % ----------------------------------------------------------------------
  6. % $Log: dcfsfkacem.red,v $
  7. % Revision 1.4 2004/03/23 11:31:45 dolzmann
  8. % Corrected tags for cvs.
  9. %
  10. % revision 1.1 2004/03/22 12:31:49 sturm
  11. % initial check-in.
  12. % mostly copied from acfsf.
  13. % includes diploma thesis by kacem plus wrapper for this.
  14. %
  15. % ----------------------------------------------------------------------
  16. lisp <<
  17. fluid '(dcfsfkacem_rcsid!* dcfsfkacem_copyright!*);
  18. dcfsfkacem_rcsid!* := "$Id: dcfsfkacem.red,v 1.4 2004/03/23 11:31:45 dolzmann Exp $";
  19. dcfsfkacem_copyright!* := "copyright (c) 2004 t. sturm"
  20. >>;
  21. module dcfsfkacem;
  22. % diferentially closed field standard form.
  23. % part 1
  24. fluid '(dqe_counter!* !*dqeverbose !*dqegradord !*dqeoptqelim !*dqeoptsimp);
  25. switch dqeverbose;
  26. switch dqegradord;
  27. switch dqeoptqelim;
  28. switch dqeoptsimp;
  29. on1 'dqeverbose;
  30. on1 'dqegradord;
  31. on1 'dqeoptqelim;
  32. on1 'dqeoptsimp;
  33. algebraic (for all x,n let df(x d n,x)=0);
  34. % part 2
  35. symbolic procedure dqe_isconstant(phi);
  36. % is a constant. [phi] is differential polynomial. Returns nom-nil
  37. % iff phi is a constant.
  38. numberp phi or (pairp phi and car phi eq 'quotient and
  39. numberp caddr phi and numberp reval cadr phi);
  40. %%%%%%%%%%%%%% dqe_isatomarp %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  41. % %
  42. % diese prozedur testet ob phi eine atomare formel ist. %
  43. % (siehe kapitel 4 abschnitt 4.8) %
  44. % %
  45. % eingabe : beliebige formel phi . %
  46. % %
  47. % ausgabe : true falls phi atomar ist d.h. in sm. ist phi von %
  48. % der form list(elem,f,g) wobei elem = equal %
  49. % order neq und f,g differentiale polynome sind%
  50. % false sonst . %
  51. % %
  52. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  53. procedure dqe_isatomarp(phi);
  54. pairp phi and (car phi eq 'neq or car phi eq 'equal);
  55. %%%%%%%%%%%%%% dqe_isquantfree %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  56. % %
  57. % diese prozedur testet ob eine formel phi quantorenfrei ist. %
  58. % (siehe kapitel 4 abschnitt 4.8) %
  59. % %
  60. % eingabe : beliebige formel phi . %
  61. % %
  62. % ausgabe : true falls phi quantorenfreie formel ist. %
  63. % false sonst . %
  64. % %
  65. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  66. symbolic procedure dqe_isquantfree(phi);
  67. begin scalar erg;
  68. if atom phi or (not phi) or dqe_isatomarp phi then
  69. return T;
  70. if car phi = 'nott then
  71. return dqe_isquantfree cadr phi;
  72. if car phi eq 'or or car phi eq 'and then <<
  73. phi := cdr phi;
  74. erg := T;
  75. while erg and phi do <<
  76. erg := dqe_isquantfree car phi;
  77. phi := cdr phi
  78. >>;
  79. return erg;
  80. >>;
  81. return nil;
  82. end;
  83. %%%%%%%%%%%%%% dqe_isprenexp %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  84. % %
  85. % diese prozedur testet ob eine formel phi in prenexform ist. %
  86. % (siehe kapitel 4 abschnitt 4.8) %
  87. % %
  88. % eingabe : beliebige formel phi . %
  89. % %
  90. % ausgabe : true falls phi quantorenfrei ist oder phi von der %
  91. % q_1 x_1...q_n x_n psi wobei q_i = ex oder all%
  92. % und psi quantorenfrei ist. %
  93. % false sonst . %
  94. % %
  95. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  96. procedure dqe_isprenexp(phi);
  97. begin scalar erg;
  98. if atom phi or (not phi) then
  99. erg := t
  100. else <<
  101. while (car phi ='ex) or (car phi ='all) do
  102. phi := caddr phi;
  103. erg := dqe_isquantfree phi
  104. >>;
  105. return erg;
  106. end;
  107. %%%%%%%%%%%%%%%% dqe_modatomar %%%%%%%%%%%%%%%%%%%%%%%%%%%%
  108. % %
  109. % dqe_modatomar ist eine sub-routine fuer dqe_helpelim. %
  110. % (siehe kapitel 4 abschnitt 4.6) %
  111. % %
  112. % eingabe : atomare formel von der form "f = g" oder "not(f =g)"%
  113. % %
  114. % ausgabe : "f - g = 0" bzw "not(f - g = 0 )". %
  115. % %
  116. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  117. procedure dqe_modatomar(phi);
  118. if caddr phi = 0 then
  119. phi
  120. else
  121. {car phi,reval {'difference,cadr phi,caddr phi},0};
  122. %%%%%%%%%%%%%%%% dqe_helpelim %%%%%%%%%%%%%%%%%%%%%%%%%%%
  123. % %
  124. % dqe_helpelim ist eine hilfsprozedur fuer dqe_elim. %
  125. % (siehe kapitel 4 abschnitt 4.6) %
  126. % %
  127. % eingabe : eine teilformel phi. %
  128. % %
  129. % ausgabe : list(g) falls phi von der form not(g= 0) oder %
  130. % g = g1*g2*..*gm und phi von der form %
  131. % not(g1=0) and ...and not(gm=0) . %
  132. % list(1,f) falls phi von der form f = 0 %
  133. % list(1,f1,...,fn) falls phi von der form %
  134. % f1 = 0 and ...and fn = 0 . %
  135. % list(g,f1,...,fn) falls phi von der form %
  136. % f1 = 0 and ...and fn = 0 and %
  137. % not(g1=0) and ...and not(gm=0) %
  138. % wobei g = g1*g2*..*gm . %
  139. % %
  140. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  141. procedure dqe_helpelim(phi);
  142. begin scalar op;
  143. if (phi eq t) or (not phi) then
  144. return phi;
  145. op := car phi;
  146. if op eq 'neq then
  147. return {reval cadr dqe_modatomar phi};
  148. if op eq 'equal then
  149. return {1,reval cadr dqe_modatomar phi};
  150. if op eq 'and then
  151. return dqe_helpelim!-and cdr phi;
  152. rederr "dqe_helpelim: internal error";
  153. end;
  154. procedure dqe_helpelim!-and(phi);
  155. begin scalar a,eqs,g;
  156. g := 1;
  157. while phi do <<
  158. a := car phi;
  159. if car a eq 'equal then
  160. eqs := adjoin(reval cadr dqe_modatomar a,eqs)
  161. else
  162. g := reval {'times,g,reval cadr dqe_modatomar a};
  163. phi := cdr phi
  164. >>;
  165. return g . reversip eqs
  166. end;
  167. %%%%%%%%%%%%%%%% dqe_andorvaleur %%%%%%%%%%%%%%%%%%%%%%%%%%%%
  168. % %
  169. % and-or-valeur gibt bei einer disjunktion bzw. konjunktion %
  170. % zweier formeln eine vereinfachte flache formel aus, die zur %
  171. % disjunktion bzw. konjunktion aequivalent ist. %
  172. % (siehe kapitel 4 abschnitt 4.9) %
  173. % %
  174. % eingabe : eine liste der form list(elem,phi,psi) %
  175. % wobei elem = ' and oder elem = 'or. %
  176. % %
  177. % ausgabe : cons(elem,cons(phi,cdr psi) falls car psi = elem %
  178. % und not(car phi = elem) . %
  179. % %
  180. % cons(elem,cons(psi,cdr phi) falls car phi = elem %
  181. % und not(car psi = elem). %
  182. % %
  183. % appand(phi,cdr psi) falls car phi = car psi = elem. %
  184. % %
  185. % phi falls psi leer ist. %
  186. % %
  187. % psi falls phi leer ist. %
  188. % %
  189. % list(elem,phi,psi) sonst %
  190. % %
  191. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  192. symbolic procedure dqe_andorvaleur(phi);
  193. begin scalar erg,hilf,hilff,andor;
  194. erg := nil;andor := car phi; hilf := cadr phi; hilff:= caddr phi;
  195. if hilf
  196. then
  197. <<if hilff
  198. then
  199. << if car hilf = andor
  200. and car hilff = andor
  201. then
  202. << hilf := reverse cdr hilf;
  203. hilff := cdr hilff;
  204. while hilf do
  205. << hilff := dqe_consm(car hilf,hilff);
  206. hilf := cdr hilf >> ;
  207. if not cdr hilff then erg := car hilff
  208. else
  209. erg := cons(andor,hilff) >>
  210. else
  211. if car hilf = andor
  212. then erg := dqe_modcons(hilff,hilf)
  213. else
  214. if car hilff = andor
  215. then erg := cons(andor,
  216. dqe_consm(hilf,cdr hilff))
  217. else erg := phi >>
  218. else erg := hilf >>
  219. else erg := hilff ;
  220. return erg;
  221. end;
  222. %%%%%%%%%%%%%% dqe_consm %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  223. % %
  224. % durch dieser prozedur wird jedes element nur einmal in der %
  225. % liste eingetragen. %
  226. % falls es schon in der liste enthalten ist, so bleibt die liste%
  227. % unveraendert. (siehe kapitel 4 abschnitt 4.9) %
  228. % %
  229. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  230. symbolic procedure dqe_consm(elem,liste);
  231. if elem member liste
  232. then liste
  233. else cons(elem,liste);
  234. %%%%%%%%%%%%%% dqe_modcons %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  235. % %
  236. % durch dieser prozedur wird jedes element nur einmel in der %
  237. % liste eingetragen. %
  238. % falls es schon in der liste enthalten ist, so bleibt die liste%
  239. % unveraendert. sonst wird es an das ende der liste angehaengt. %
  240. % (siehe kapitel 4 abschnitt 4.9) %
  241. % %
  242. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  243. symbolic procedure dqe_modcons(elem,liste);
  244. if elem member liste
  245. then liste
  246. else reverse cons(elem,reverse liste);
  247. % part 3
  248. %%%%%%%%%%%%%%% dqe_makepositiveat %%%%%%%%%%%%%%%%%%%%%%%%%%%% %
  249. % %
  250. % diese prozedur wurde von k.d. burhenne uebernommen und ent- %
  251. % sprechend geandert. (siehe kapitel 3 abschnitt 3.1) %
  252. % dqe_makepositiveat berechnet bei eingabe einer negierten ato- % %
  253. % maren formel die entsprechende aequivalente positive formel. %
  254. % %
  255. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  256. symbolic procedure dqe_makepositiveat (phi);
  257. begin scalar psi;
  258. psi := cadr phi;
  259. return if car psi eq 'equal then
  260. {'neq,cadr psi,caddr psi}
  261. else
  262. {'equal,cadr psi,caddr psi}
  263. end;
  264. %%%%%%%%%%%%%%% dqe_makepositive %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  265. % %
  266. % dqe_makepositive berechnet zu einer gegebenen formel die ent- %
  267. % sprechend aequivalente positive formel. %
  268. % die rechenvorschrift fuer diese berechnung wurde von %
  269. % k.d. burhenne uebernommen. anstelle der von burhenne verwen- %
  270. % verwendeten stack-verwaltung bei der programmierung wurde %
  271. % jedoch der rekursive programmierstil benutzt, d.h. die %
  272. % positive formel wird durch rekursion ueber den aufbau von %
  273. % formeln berechnet. (siehe kapitel 3 abschnitt 3.1) %
  274. % %
  275. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  276. symbolic procedure dqe_makepositive(formel);
  277. begin scalar erg,hilfserg,hilf;
  278. if (formel = t) or (not formel) then erg := formel
  279. else
  280. if car formel='nott
  281. then
  282. << formel:=cadr formel;
  283. if formel = t then erg := nil
  284. else
  285. if formel = nil then erg := t
  286. else
  287. if car formel='nott
  288. then erg:=dqe_makepositive(cadr formel)
  289. else
  290. if car formel='ex
  291. then <<erg:=dqe_makepositive(list('nott,caddr formel));
  292. erg:=list('all,cadr formel,erg)>>
  293. else
  294. if car formel='all
  295. then <<erg:=dqe_makepositive(list('nott,caddr formel));
  296. erg:=list('ex,cadr formel,erg)>>
  297. else
  298. if car formel='and
  299. then <<hilf:=cdr formel;hilfserg:=nil;
  300. while hilf do
  301. <<hilfserg:= dqe_makepositive(list('nott,car hilf));
  302. erg := cons(hilfserg,erg);
  303. hilf:=cdr hilf >>;
  304. if cdr erg
  305. then erg:=cons('or,reverse erg)>>
  306. else
  307. if car formel='or
  308. then <<hilf:=cdr formel;hilfserg:=nil;
  309. while hilf do
  310. <<hilfserg:= dqe_makepositive(list('nott,car hilf));
  311. erg := cons(hilfserg,erg);
  312. hilf:=cdr hilf >>;
  313. if cdr erg
  314. then erg:=cons('and,reverse erg) >>
  315. else
  316. erg:=dqe_makepositiveat(list('nott,formel)) >>
  317. else
  318. <<
  319. if car formel='ex
  320. then <<erg:=dqe_makepositive(caddr formel);
  321. erg:=list('ex,cadr formel,erg)>>
  322. else
  323. if car formel='all
  324. then <<erg:=dqe_makepositive(caddr formel);
  325. erg:=list('all,cadr formel,erg)>>
  326. else
  327. if car formel='and
  328. then <<hilf:=cdr formel;hilfserg:=nil;
  329. while hilf do
  330. <<hilfserg:= dqe_makepositive(car hilf);
  331. erg := cons(hilfserg,erg);
  332. hilf:=cdr hilf >>;
  333. if cdr erg
  334. then erg:=cons('and,reverse erg)>>
  335. else
  336. if car formel='or
  337. then <<hilf:=cdr formel;hilfserg:=nil;
  338. while hilf do
  339. <<hilfserg:= dqe_makepositive(car hilf);
  340. erg := cons(hilfserg,erg);
  341. hilf:=cdr hilf >>;
  342. if cdr erg
  343. then erg:=cons('or,reverse erg) >>
  344. else erg:=formel >>;
  345. return erg;
  346. end;
  347. %%%%%%%%%%%%%%% dqe_interchange7 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  348. % %
  349. % dqe_interchange7 ist eine subroutine von dqe_makeprenex und wurde% %
  350. % unveraendert von k.d. burhenne uebernommen. %
  351. % sei l = (phi_1,...phi_n), wobei alle phi_j praenexe formeln %
  352. % sind, %
  353. % ls aus and,or , %
  354. % a aus ex,all . %
  355. % dann ist dqe_interchange7(l,ls,a) ein paar (phi,qb) mit folgenden %
  356. % eigenschaften: %
  357. % 1. phi ist wieder praenex und aequivalent zu %
  358. % (phi_1 ls ... ls phi_n). %
  359. % ferner ist fs(phi)=a, falls fs(phi_j)=a fuer ein j, d.h. %
  360. % phi beginnt mit einem block von a-quantoren, falls moeglich. %
  361. % 2. qb=qb(phi). %
  362. % die prozedur dqe_interchange7 hat die eigenschaft, dass eine der %
  363. % formeln dqe_interchange7(l,ls,ex), dqe_interchange7(l,ls,all) op- % %
  364. % mal bzgl. der anzahl der quantorenbloecke ist, falls dies fuer %
  365. % alle phi_j aus l schon der fall war. %
  366. % %
  367. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  368. symbolic procedure dqe_interchange7(l,ls,a);
  369. begin scalar qlist,hilf,phi,qb,qb1,weiter;
  370. qlist:=nil;weiter:=t;hilf:=nil; qb:=0;
  371. while l do << hilf:=cons(caar l,hilf); l:=cdr l >>;
  372. l:=hilf;
  373. while weiter do
  374. << weiter:=nil;hilf:=nil;qb1:=0;
  375. while l do
  376. << phi:=car l;l:=cdr l;
  377. while car phi=a do
  378. << qlist:=cons(list(car phi,cadr phi),qlist);
  379. phi:=caddr phi;qb1:=qb1+1 >>;
  380. hilf:=cons(phi,hilf) >>;
  381. l:=hilf;if qb1>0 then qb:=qb+1;
  382. if a='ex then a:='all else a:='ex;
  383. while hilf and not weiter do
  384. << if caar hilf='ex or caar hilf='all
  385. then weiter:=t;
  386. hilf:=cdr hilf >> >>;
  387. phi:=cons(ls,l);
  388. while qlist do << phi:=append(car qlist,list phi);
  389. qlist:=cdr qlist >>;
  390. return list(phi,qb)
  391. end;
  392. %%%%%%%%%%%%%%% dqe_pnfquantor %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  393. % %
  394. % soubroutine von dqe_makeprenex, die unveraendert von %
  395. % k.d. burhenne uebernommen wurde. %
  396. % dqe_pnfquantor ist eine hilfsprozedur zur realisierung des %
  397. % rekursionsschritts fuer dqe_pnf(siehe dort), %
  398. % der erforderlich wird, wenn die eingabe phi mit %
  399. % einem quantor beginnt, also etwa phi=ex(x,psi); %
  400. % pnfquantor(phi) berechnet zunaechst die menge m=pnf(psi<n/x>),% ,%
  401. % wobei n neuer identifikator ist, und berechnet daraus eine %
  402. % optimale formel, die auch im hoeheren kontext optimal ist. %
  403. % seiteneffekte:siehe unter dqe_pnf. %
  404. % %
  405. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  406. symbolic procedure dqe_pnfquantor(phi);
  407. begin scalar erg,n,m,hilf,hilf1,z,dec;
  408. dec:=car phi;
  409. dqe_counter!*:=dqe_counter!*+1;z:=mkid('newid,dqe_counter!*);
  410. erg:=dqe_pnf subst(z,cadr phi,caddr phi);
  411. if cdr erg then
  412. <<n:=cadr car erg;m:=cadr cadr erg;
  413. if n<m then << hilf:=caar erg;hilf1:=list(dec,z,hilf);
  414. if car hilf=dec then hilf1:=list(hilf1,n)
  415. else hilf1:=list(hilf1,n+1);
  416. erg:=list hilf1 >>
  417. else
  418. if n>m then << hilf:=caadr erg;hilf1:=list(dec,z,hilf);
  419. if car hilf=dec then hilf1:=list(hilf,m)
  420. else hilf1:=list(hilf,m+1);
  421. erg:=list hilf1 >>
  422. else << hilf:=erg;
  423. while hilf and caaar hilf neq dec do
  424. hilf:=cdr hilf;
  425. if hilf
  426. then << hilf:=list(list(dec,z,caar hilf),n);
  427. erg:=list hilf >>
  428. else << erg:=list(list(dec,z,caar erg),n+1);
  429. erg:=list erg >> >> >>
  430. else << if caaar erg neq dec then m:=cadar erg+1
  431. else m:=cadar erg;
  432. erg:=list list(list(dec,z,caar erg),m) >>;
  433. return erg
  434. end;
  435. %%%%%%%%%% dqe_pnfjunktor %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  436. % %
  437. % soubroutine von dqe_makeprenex, die unveraendert von %
  438. % k.d. burhenne uebernommen wurde. %
  439. % dqe_pnfjunktor ist eine hilfsprozedur zur realisierung des %
  440. % rekursionsschritts fuer dqe_pnf (siehe dort), %
  441. % der erforderlich wird, wenn fuer die eingabe phi gilt: %
  442. % fs(phi) aus and,or, also etwa phi = phi_1 ls ... ls phi_n. %
  443. % pnfjunktor(phi) berechnet zunaechst die mengen m_j=pnf(psi_j) % %
  444. % und daraus das gewuenschte ergebnis. %
  445. % seiteneffekte:siehe unter dqe_pnf. %
  446. % %
  447. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  448. symbolic procedure dqe_pnfjunktor(phi);
  449. begin scalar erg,dec,hilf,hilf1,hilf2,psi,pair1,pair2,poss1,poss2,
  450. l1,l2,m,m1;
  451. dec:=car phi;m:=-1;poss1:=t;poss2:=t;hilf1:=nil;hilf2:=nil;
  452. hilf:=cdr phi;l1:=nil;l2:=nil;
  453. while hilf do << psi:=dqe_pnf car hilf;hilf:=cdr hilf;
  454. hilf1:=cons(car psi,hilf1);
  455. if cdr psi then hilf2:=cons(cadr psi,hilf2)
  456. else hilf2:=cons(car psi,hilf2);
  457. m1:=cadar psi;if m1>m then m:=m1 >>;
  458. if m>0 then
  459. << while hilf1 do
  460. << pair1:=car hilf1;pair2:=car hilf2;
  461. hilf1:=cdr hilf1;hilf2:=cdr hilf2;
  462. l1:=cons(pair1,l1);l2:=cons(pair2,l2);
  463. if cadr pair1=m and caar pair1 neq 'ex then poss1:=nil;
  464. if cadr pair2=m and caar pair2 neq 'all then poss2:=nil >>;
  465. if poss1 and not poss2
  466. then erg:=list dqe_interchange7(l1,dec,'ex)
  467. else if poss2 and not poss1
  468. then erg:=list dqe_interchange7(l2,dec,'all)
  469. else erg:=list(dqe_interchange7(l1,dec,'ex),
  470. dqe_interchange7(l2,dec,'all)) >>
  471. else erg:=list list(phi,0); return erg
  472. end;
  473. %%%%%%%%%%%%%%% dqe_pnf %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  474. % %
  475. % soubroutine von dqe_makeprenex, die unveraendert von %
  476. % k.d. burhenne uebernommen wurde. %
  477. % pnf(phi) berechnet eine ein-oder zweielementige menge m von %
  478. % praenexen formeln phi' derart,dass jede formel phi' in m aequi-%
  479. % valent zu phi und optimal bzgl. der anzahl der quantorenbloecke%
  480. % ist.in jedem fall ist eine der formeln aus m auch "im hoeheren %
  481. % kontext" optimal. %
  482. % falls #m=2, so beginnt eine formel mit einem existenzquantor %
  483. % und eine mit einem allquantor. in der m darstellenden liste l %
  484. % ist dann car l die formel, die mit einem existenzquantor %
  485. % beginnt. die formeln werden so verwaltet, dass zusaetzlich die %
  486. % anzahl der quantorenbloecke mitberechnet wird, d.h. %
  487. % pnf(phi) ist entweder von der form %
  488. % ( (phi_ex, qbex), (phi_all,qball)), %
  489. % wobei phi_ex,phi_all die optimalen formeln sind, %
  490. % qbex=qb(phi_ex) , qball=qb(phi_all), %
  491. % oder von der form ((phi',qb)), wobei qb=qb(phi'). %
  492. % verfahren : rekursion ueber den aufbau von phi. %
  493. % falls phi atomar ist, wird ((phi,0)) ausgegeben. %
  494. % ansonsten wird eine der prozeduren qnaquantor %
  495. % oder qnajunktor aufgerufen, die die entsprechenden %
  496. % rekursionsschritte(--> zunaechst rekursiver auf- %
  497. % ruf von dqe_pnf) unter beibehaltung der %
  498. % optimalitaet realisieren. %
  499. % fuer die umbenennung von variablen greift dqe_pnf ueber qna- %
  500. % quantor auf eine relativ globale variable counter zu. daraus %
  501. % ergibt sich ein seiteneffekt an dieser variable. %
  502. % dieser effekt ist jedoch unproblematisch, da pnf nur hilfs- %
  503. % prozedur fuer die prozedur dqe_makeprenex ist, in der die %
  504. % variable counter deklariert ist. letztere prozedur (nur diese %
  505. % wird fuer weitere berechnungen verwendet) arbeitet ohne sei- %
  506. % teneffekte. %
  507. % %
  508. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  509. symbolic procedure dqe_pnf(phi);
  510. begin scalar dec,erg;
  511. dec:=car phi;
  512. if dec='ex or dec='all then erg:=dqe_pnfquantor phi
  513. else
  514. if dec='or or dec='and then erg:=dqe_pnfjunktor phi
  515. else erg:=list list(phi,0);
  516. return erg;
  517. end;
  518. %%%%%%%%%%%%%% dqe_makeprenex %%%%%%%%%%%%%%%%%%%%%%%%%%%%
  519. % %
  520. % dqe_makeprenex berechnet zu einer gegebenen positiven formel %
  521. % eine aequivalente praenexe formel, die optimal ist bzgl. der %
  522. % anzahl der quantorenbloecke. %
  523. % diese prozedur wurde unveraendert von k.d. burhenne ueber- %
  524. % nommen. (siehe auch kapitel 3) %
  525. % %
  526. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  527. symbolic procedure dqe_makeprenex(phi);
  528. begin scalar erg;
  529. dqe_counter!*:=0;erg:=dqe_pnf phi;
  530. if cdr erg then << if cadr car erg<= cadr cadr erg
  531. then erg:=caar erg
  532. else erg:=caadr erg >>
  533. else erg:=caar erg;
  534. return erg
  535. end;
  536. %%%%%%%%%%%%%%% dqe_pnfquantormod %%%%%%%%%%%%%%%%%%%%%%%%%%%
  537. % %
  538. % pnfquantormod ist eine subroutine fuer pnfmod. sie arbeitet % %
  539. % wie dqe_pnfquantor (siehe kapitel 3 abschnitt 3.2). %
  540. % %
  541. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  542. symbolic procedure dqe_pnfquantormod(phi,liste);
  543. begin scalar erg,n,m,hilf,hilf1,z,dec;
  544. dec:=car phi;
  545. dqe_counter!*:=dqe_counter!*+1;z:=mkid('newid,dqe_counter!*);
  546. liste := cons(cadr phi,cons(z,liste));
  547. erg:= dqe_pnfmod(subst(z,cadr phi,caddr phi),liste);
  548. liste := cadr erg;
  549. erg := car erg;
  550. if cdr erg then
  551. <<n:=cadr car erg;m:=cadr cadr erg;
  552. if n<m then << hilf:=caar erg;hilf1:=list(dec,z,hilf);
  553. if car hilf=dec then hilf1:=list(hilf1,n)
  554. else hilf1:=list(hilf1,n+1);
  555. erg:=list hilf1 >>
  556. else
  557. if n>m then << hilf:=caadr erg;hilf1:=list(dec,z,hilf);
  558. if car hilf=dec then hilf1:=list(hilf,m)
  559. else hilf1:=list(hilf,m+1);
  560. erg:=list hilf1 >>
  561. else << hilf:=erg;
  562. while hilf and caaar hilf neq dec do
  563. hilf:=cdr hilf;
  564. if hilf
  565. then << hilf:=list(list(dec,z,caar hilf),n);
  566. erg:=list hilf >>
  567. else << erg:=list(list(dec,z,caar erg),n+1);
  568. erg:=list erg >> >> >>
  569. else << if caaar erg neq dec then m:=cadar erg+1
  570. else m:=cadar erg;
  571. erg:=list list(list(dec,z,caar erg),m) >>;
  572. return list(erg,liste);
  573. end;
  574. %%%%%%%%%% dqe_pnfjunktormod %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  575. % %
  576. %pnfjunktormod ist eine subroutine fuer dqe_pnfmod. sie arbeitet% %
  577. % wie dqe_pnfjunktor (siehe kapitel 3 abschnitt 3.2). %
  578. % %
  579. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  580. symbolic procedure dqe_pnfjunktormod(phi,liste);
  581. begin scalar erg,dec,hilf,hilf1,hilf2,psi,pair1,pair2,poss1,poss2,
  582. l1,l2,m,m1;
  583. dec:=car phi;m:=-1;poss1:=t;poss2:=t;hilf1:=nil;hilf2:=nil;
  584. hilf:=cdr phi;l1:=nil;l2:=nil;
  585. while hilf do << psi:=dqe_pnfmod(car hilf,liste);
  586. liste := cadr psi;
  587. psi := car psi;
  588. hilf:=cdr hilf;
  589. hilf1:=cons(car psi,hilf1);
  590. if cdr psi then hilf2:=cons(cadr psi,hilf2)
  591. else hilf2:=cons(car psi,hilf2);
  592. m1:=cadar psi;if m1>m then m:=m1 >>;
  593. if m>0 then
  594. << while hilf1 do
  595. << pair1:=car hilf1;pair2:=car hilf2;
  596. hilf1:=cdr hilf1;hilf2:=cdr hilf2;
  597. l1:=cons(pair1,l1);l2:=cons(pair2,l2);
  598. if cadr pair1=m and caar pair1 neq 'ex then poss1:=nil;
  599. if cadr pair2=m and caar pair2 neq 'all then poss2:=nil >>;
  600. if poss1 and not poss2
  601. then erg:=list(list dqe_interchange7(l1,dec,'ex),liste)
  602. else if poss2 and not poss1
  603. then erg:=list(list(dqe_interchange7(l2,dec,'all)),liste)
  604. else erg:=list(list(dqe_interchange7(l1,dec,'ex),
  605. dqe_interchange7(l2,dec,'all)),liste) >>
  606. else erg:=list(list(list(phi,0)),liste); return erg
  607. end;
  608. %%%%%%%%%%%%%%% dqe_pnfmod %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  609. % %
  610. %pnfmod ist eine subroutine fuer makeprenexmod. sie arbeitet % %
  611. % wie dqe_pnf (siehe kapitel 3 abschnitt 3.2). %
  612. % %
  613. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  614. symbolic procedure dqe_pnfmod(phi,liste);
  615. begin scalar dec,erg;
  616. dec:=car phi;
  617. if dec='ex or dec='all then erg:=dqe_pnfquantormod(phi,liste)
  618. else
  619. if dec='or or dec='and then erg:=dqe_pnfjunktormod(phi,liste)
  620. else erg:=list(list(list(phi,0)),liste);
  621. return erg;
  622. end;
  623. %%%%%%%%%% dqe_makeprenexmod %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  624. % %
  625. % makeprenexopt arbeitet genau wie makeprenex. sie berechnet zu % u %
  626. % einer gegebnen positeven formel die selbe aequivalente prae- %
  627. % nexe formel wie bei dqe_makeprenex. %
  628. % sie berechnetet noch dazu die up-dating der liste diffequa- %
  629. % liste (siehe auch kapitel 3 abschnitt 3.2). %
  630. % %
  631. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  632. symbolic procedure dqe_makeprenexmod(phi,diffequaliste);
  633. begin scalar erg,hilfliste,liste,ausg;
  634. scalar var,newvar,hilf;
  635. ausg := nil;
  636. dqe_counter!*:=0;
  637. liste := nil;
  638. hilfliste := diffequaliste;
  639. erg:=dqe_pnfmod(phi,liste);
  640. liste := cadr erg;
  641. erg := car erg;
  642. if cdr erg then << if cadr car erg<= cadr cadr erg
  643. then erg:=caar erg
  644. else erg:=caadr erg >>
  645. else erg:=caar erg;
  646. while liste do
  647. << var := car liste;
  648. newvar := cadr liste;
  649. liste := cddr liste;
  650. hilfliste := subst(newvar,var,hilfliste) >>;
  651. while hilfliste do
  652. << var := car hilfliste;
  653. hilf := cadr hilfliste;
  654. hilfliste := cddr hilfliste;
  655. if not(var member diffequaliste)
  656. then diffequaliste := cons(var,
  657. cons(hilf,diffequaliste)) >>;
  658. ausg := list(erg,diffequaliste);
  659. return ausg;
  660. end;
  661. %%%%%%%%%%%%%%% dqe_disjnf %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  662. % %
  663. % dqe_dnfjnf berechnet eine disjunktive normalform einer positi-%
  664. % ven quantorenfreien formel. %
  665. % (siehe kapitel 3 abschnitt 3.3) %
  666. % vorgehen: %
  667. % 1.: formel = t oder nil --> stop %
  668. % 2.: formel = (and ...) --> aufruf dqe_distributiv formel %
  669. % 3.: formel = (or ...) --> fuer alle teilformeln %
  670. % aufruf dqe_disjnf %
  671. % %
  672. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  673. symbolic procedure dqe_disjnf(formel);
  674. begin scalar erg,hilf;
  675. erg := nil;
  676. if (formel = t) or (not formel)
  677. or dqe_isatomarp(formel)
  678. then erg := formel
  679. else
  680. if car formel ='and
  681. then erg := dqe_distributiv(formel)
  682. else
  683. if car formel ='or
  684. then
  685. << formel := cdr formel;
  686. while formel do
  687. << hilf := car formel; formel := cdr formel;
  688. hilf := dqe_disjnf(hilf);
  689. if (hilf = t) or (not hilf)
  690. or
  691. dqe_isatomarp(hilf) or (car hilf = 'and)
  692. then
  693. << if not erg then erg := list(hilf)
  694. else
  695. if not cdr(erg)
  696. then
  697. << if not(hilf = car erg)
  698. then erg := list('or,
  699. car erg,hilf) >>
  700. else erg := dqe_modcons(hilf,erg) >>
  701. else
  702. << if length erg = 1
  703. then erg := car erg;
  704. erg := dqe_andorvaleur
  705. list('or,erg,hilf) >> >>;
  706. if length erg = 1 then erg := car erg>>
  707. else erg := formel;
  708. if !*dqeoptsimp then erg := dqe_dknfsimplify(erg);
  709. return erg;
  710. end;
  711. %%%%%%%%%%%%%%% dqe_konjnf %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  712. % %
  713. % dqe_konjnf berechnet eine konjunktive normalform einer positi-%
  714. % ven quantorenfreien formel. %
  715. % (siehe auch kapitel 3 abschnitt 3.3) %
  716. % vorgehen: %
  717. % 1.: formel = t oder nil --> stop %
  718. % 2.: formel = (or ...) --> aufruf dqe_distributiv formel %
  719. % 3.: formel = (and ...) --> fuer alle teilformeln %
  720. % aufruf dqe_konjnf %
  721. % %
  722. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  723. symbolic procedure dqe_konjnf(formel);
  724. begin scalar erg,hilf;
  725. erg := nil;
  726. if (formel = t) or (not formel)
  727. or dqe_isatomarp(formel)
  728. then erg := formel
  729. else
  730. if car formel ='or
  731. then erg := dqe_distributiv(formel)
  732. else
  733. if car formel ='and
  734. then
  735. << formel := cdr formel;
  736. while formel do
  737. << hilf := car formel; formel := cdr formel;
  738. hilf := dqe_konjnf(hilf);
  739. if (hilf = t) or (not hilf)
  740. or
  741. dqe_isatomarp(hilf) or (car hilf = 'or)
  742. then
  743. << if not erg then erg := list(hilf)
  744. else
  745. if not cdr(erg)
  746. then
  747. << if not(hilf = car erg)
  748. then erg := list('and,
  749. car erg,hilf) >>
  750. else erg := dqe_modcons(hilf,erg) >>
  751. else
  752. << if length erg = 1
  753. then erg := car erg;
  754. erg := dqe_andorvaleur
  755. list('and,erg,hilf) >> >>;
  756. if length erg = 1 then erg := car erg>>
  757. else erg := formel;
  758. if !*dqeoptsimp
  759. then erg := dqe_dknfsimplify(erg);
  760. return erg;
  761. end;
  762. %%%%%%%%%%%%%%% dqe_distributiv %%%%%%%%%%%%%%%%%%%%%%%%%%%
  763. % %
  764. % sub-routine von dqe_disjnf und dqe_konjnf zur anwendung der % %
  765. % distributivgesetze. %
  766. % (siehe auch kapitel 3 abschnitt 3.3) %
  767. % vorgehen: %
  768. % 1.fall: eingabe: (or ...) %
  769. % ausgabe: (and phi_1 phi_2 ...) , %
  770. % wobei phi_1, phi_2, ... keine and's enthalten.%
  771. % 2.fall: eingabe: (and ...) %
  772. % ausgabe: (or phi_1 phi_2 ...) , %
  773. % wobei phi_1, phi_2, ... keine or's enthalten.%
  774. % %
  775. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  776. symbolic procedure dqe_distributiv(formel);
  777. begin scalar symb1,symb2,ausg,hilf1,hilf2,hilf,hilf3,hilff;
  778. symb1 := car formel; ausg := nil;
  779. if symb1='or
  780. then symb2 := 'and
  781. else symb2 := 'or;
  782. formel := cdr formel;
  783. while formel do
  784. << hilf := car formel; formel := cdr formel;
  785. if (hilf = t) or not(hilf)
  786. or dqe_isatomarp(hilf)
  787. then
  788. << if not ausg
  789. then ausg := cons(hilf,ausg)
  790. else
  791. if not cdr ausg
  792. then
  793. << hilf1 := car ausg;
  794. if not( hilf = hilf1)
  795. then ausg := list(symb1,hilf1,hilf) >>
  796. else
  797. if car ausg = symb1
  798. then ausg := dqe_modcons(hilf,ausg)
  799. else
  800. << hilf1 := cdr ausg; ausg := nil;
  801. while hilf1 do
  802. << hilf2 := car hilf1;
  803. hilf1 := cdr hilf1;
  804. if (hilf2 = t) or not hilf2
  805. or dqe_isatomarp(hilf2)
  806. then
  807. <<if not( hilf2 = hilf1)
  808. then hilf2 := list(symb1,hilf2,hilf) >>
  809. else hilf2 := dqe_modcons(hilf,hilf2);
  810. ausg := dqe_modcons(hilf2,ausg) >>;
  811. if cdr ausg
  812. then ausg := cons(symb2,ausg) >> >>
  813. else
  814. if car hilf = symb1
  815. then
  816. << hilf := dqe_distributiv(hilf);
  817. if (hilf = t) or not(hilf)
  818. or dqe_isatomarp(hilf)
  819. then
  820. <<if not ausg
  821. then ausg := cons(hilf,ausg)
  822. else
  823. if not cdr ausg
  824. then
  825. <<hilf1 := car ausg;
  826. if not( hilf = hilf1)
  827. then ausg := list(symb1,hilf1,hilf) >>
  828. else
  829. if car ausg = symb1
  830. then ausg := dqe_modcons(hilf,ausg)
  831. else
  832. <<hilf1 := cdr ausg; ausg := nil;
  833. while hilf1 do
  834. <<hilf2 := car hilf1;
  835. hilf1 := cdr hilf1;
  836. if (hilf2 = t) or not hilf2
  837. or dqe_isatomarp(hilf2)
  838. then
  839. <<if not( hilf2 = hilf1)
  840. then hilf2 :=
  841. list(symb1,hilf2,hilf) >>
  842. else hilf2 :=
  843. dqe_modcons(hilf,hilf2);
  844. ausg := dqe_modcons(hilf2,ausg) >>;
  845. if cdr ausg
  846. then ausg := cons(symb2,ausg)>> >>
  847. else
  848. if car hilf = symb1
  849. then
  850. << if not ausg
  851. then ausg := hilf
  852. else
  853. if not cdr ausg
  854. then ausg := cons(symb1,dqe_consm(car ausg,cdr hilf))
  855. else
  856. if car ausg = symb1
  857. then ausg := dqe_andorvaleur
  858. list(symb1,ausg,hilf)
  859. else
  860. << hilf1 := cdr ausg; ausg := nil;
  861. while hilf1 do
  862. << hilf2 := car hilf1; hilf1 := cdr hilf1;
  863. if (hilf2 = t) or (not hilf2)
  864. or dqe_isatomarp(hilf2)
  865. then hilf2 := list(symb1,
  866. dqe_consm(hilf2,cdr hilf))
  867. else hilf2 := dqe_andorvaleur
  868. list(symb1,hilf2,hilf);
  869. ausg := dqe_modcons(hilf2,ausg) >>;
  870. if cdr ausg
  871. then ausg := cons(symb2,ausg) >> >>
  872. else
  873. << if not ausg
  874. then ausg := hilf
  875. else
  876. if not cdr ausg
  877. then
  878. << hilf1 := car ausg; ausg := nil;
  879. hilf := cdr hilf;
  880. while hilf do
  881. << hilf2 := car hilf; hilf := cdr hilf;
  882. if (hilf2 = t) or (not hilf2)
  883. or dqe_isatomarp hilf2
  884. then
  885. <<if not(hilf1 = hilf2)
  886. then hilf2 := list(symb1,hilf1,hilf2)>>
  887. else
  888. hilf2 := cons(symb1,dqe_consm(hilf1,cdr hilf2));
  889. ausg := dqe_modcons(hilf2,ausg) >>;
  890. if cdr ausg
  891. then ausg := cons(symb2,ausg)>>
  892. else
  893. if car ausg = symb2
  894. then
  895. << hilf1 := cdr ausg; ausg := nil;
  896. while hilf1 do
  897. << hilf2 := car hilf1; hilf1 := cdr hilf1;
  898. hilff := cdr hilf;
  899. while hilff do
  900. << hilf3 := car hilff; hilff := cdr hilff;
  901. if (hilf2 = t) or (not hilf2)
  902. or dqe_isatomarp hilf2
  903. then
  904. <<if (hilf3 = t) or (not hilf3)
  905. or dqe_isatomarp hilf3
  906. then
  907. << if not(hilf3 = hilf2)
  908. then hilf3 := list(symb1,
  909. hilf2,hilf3) >>
  910. else
  911. << hilf3 := dqe_consm(hilf2,cdr hilf3);
  912. hilf3 := cons(symb1,hilf3) >> >>
  913. else
  914. <<if (hilf3 = t) or (not hilf3)
  915. or dqe_isatomarp hilf3
  916. then
  917. hilf3 := dqe_modcons(hilf3,hilf2)
  918. else hilf3 := dqe_andorvaleur
  919. list(symb1,hilf2,hilf3) >>;
  920. ausg := dqe_modcons(hilf3,ausg) >> >>;
  921. if cdr ausg
  922. then ausg := cons(symb2,ausg) >>
  923. else
  924. << hilf := cdr hilf;
  925. hilf1 := ausg; ausg := nil;
  926. while hilf do
  927. << hilf2 := car hilf; hilf := cdr hilf;
  928. if (hilf2 = t) or (not hilf2)
  929. or dqe_isatomarp hilf2
  930. then
  931. hilf2 := dqe_modcons(hilf2,hilf1)
  932. else hilf2 := dqe_andorvaleur
  933. list(symb1,hilf1,hilf2);
  934. ausg := dqe_modcons(hilf2,ausg) >>;
  935. if cdr ausg
  936. then ausg := cons(symb2,ausg) >> >> >>
  937. else
  938. << if symb2 = 'or
  939. then hilf := dqe_disjnf(hilf)
  940. else hilf := dqe_konjnf(hilf);
  941. if (hilf = t) or not(hilf)
  942. or dqe_isatomarp(hilf)
  943. then
  944. <<if not ausg
  945. then ausg := cons(hilf,ausg)
  946. else
  947. if not cdr ausg
  948. then
  949. <<hilf1 := car ausg;
  950. if not( hilf = hilf1)
  951. then ausg := list(symb1,hilf1,hilf) >>
  952. else
  953. if car ausg = symb1
  954. then ausg := dqe_modcons(hilf,ausg)
  955. else
  956. <<hilf1 := cdr ausg; ausg := nil;
  957. while hilf1 do
  958. <<hilf2 := car hilf1;
  959. hilf1 := cdr hilf1;
  960. if (hilf2 = t) or not hilf2
  961. or dqe_isatomarp(hilf2)
  962. then
  963. <<if not( hilf2 = hilf1)
  964. then hilf2 :=
  965. list(symb1,hilf2,hilf) >>
  966. else hilf2 :=
  967. dqe_modcons(hilf,hilf2);
  968. ausg := dqe_modcons(hilf2,ausg) >>;
  969. if cdr ausg
  970. then ausg := cons(symb2,ausg)>> >>
  971. else
  972. if car hilf = symb2
  973. then
  974. << if not ausg
  975. then ausg := hilf
  976. else
  977. if not cdr ausg
  978. then
  979. << hilf1 := car ausg; ausg := nil;
  980. hilf := cdr hilf;
  981. while hilf do
  982. << hilf2 := car hilf; hilf := cdr hilf;
  983. if (hilf2 = t) or (not hilf2)
  984. or dqe_isatomarp(hilf2)
  985. then
  986. << if not(hilf2 = hilf1)
  987. then hilf2 := list(symb1,
  988. hilf1,hilf2)>>
  989. else hilf2 := cons(symb1,
  990. dqe_consm(hilf1,cdr hilf2));
  991. ausg := dqe_modcons(hilf2,ausg) >>;
  992. if cdr ausg
  993. then ausg := cons(symb2,ausg) >>
  994. else
  995. if car ausg = symb2
  996. then
  997. << hilf1 := cdr ausg; ausg := nil;
  998. while hilf1 do
  999. << hilf2 := car hilf1; hilf1 := cdr hilf1;
  1000. hilff := cdr hilf;
  1001. while hilff do
  1002. << hilf3 := car hilff; hilff := cdr hilff;
  1003. if (hilf2 = t) or (not hilf2)
  1004. or dqe_isatomarp hilf2
  1005. then
  1006. <<if (hilf3 = t) or (not hilf3)
  1007. or dqe_isatomarp hilf3
  1008. then
  1009. << if not(hilf2 = hilf3)
  1010. then hilf3 := list(symb1,
  1011. hilf2,hilf3) >>
  1012. else
  1013. << hilf3 :=dqe_consm(hilf2,cdr hilf3);
  1014. hilf3 := cons(symb1,hilf3) >> >>
  1015. else
  1016. <<if (hilf3 = t) or (not hilf3)
  1017. or dqe_isatomarp hilf3
  1018. then
  1019. hilf3 := dqe_modcons(hilf3,hilf2)
  1020. else hilf3 := dqe_andorvaleur
  1021. list(symb1,hilf2,hilf3) >>;
  1022. ausg := dqe_modcons(hilf3,ausg) >> >>;
  1023. if cdr ausg
  1024. then ausg := cons(symb2, ausg) >>
  1025. else
  1026. << hilf1 := ausg; ausg := nil;
  1027. hilf := cdr hilf;
  1028. while hilf do
  1029. << hilf2 := car hilf; hilf := cdr hilf;
  1030. if (hilf2 = t) or (not hilf2)
  1031. or dqe_isatomarp(hilf2)
  1032. then hilf2 := dqe_modcons(hilf2,hilf1)
  1033. else hilf2 := dqe_andorvaleur
  1034. list(symb1,hilf1,hilf2);
  1035. ausg := dqe_modcons(hilf2,ausg) >>;
  1036. if cdr ausg
  1037. then ausg := cons(symb2,ausg) >> >>
  1038. else %car hilf = symb1%
  1039. <<if not ausg
  1040. then ausg := hilf
  1041. else
  1042. if not cdr ausg
  1043. then ausg := cons(symb1,dqe_consm(car ausg,cdr hilf))
  1044. else
  1045. if car ausg = symb1
  1046. then ausg := dqe_andorvaleur
  1047. list(symb1,ausg,hilf)
  1048. else
  1049. << hilf1 := cdr ausg; ausg := nil;
  1050. while hilf1 do
  1051. << hilf2 := car hilf1; hilf1 := cdr hilf1;
  1052. if (hilf2 = t) or (not hilf2)
  1053. or dqe_isatomarp(hilf2)
  1054. then hilf2 := cons(symb1,
  1055. dqe_consm(hilf2,cdr hilf))
  1056. else hilf2 :=
  1057. dqe_andorvaleur list(symb1,hilf2,hilf);
  1058. ausg := dqe_modcons(hilf2,ausg) >>;
  1059. if cdr ausg
  1060. then ausg := cons(symb2,ausg) >> >>
  1061. >> >>;
  1062. if length ausg = 1
  1063. then ausg := car ausg;
  1064. return ausg;
  1065. end;
  1066. %%%%%%%%%%%%%%% dqe_simplifyat %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1067. % %
  1068. % diese prozedur wurde von k.d. burhenne uebernommen und ent- %
  1069. % sprechend den hier auftretenden atomaren formeln angepasst. %
  1070. % dqe_simplifyat versucht eine atomare formel aussagenlogisch zu%
  1071. % vereinfachen, d.h. es wird versucht die atomare formel, falls %
  1072. % moeglich zu true oder false auszuwerten. (siehe abschnitt 3.4)%
  1073. % %
  1074. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1075. symbolic procedure dqe_simplifyat(phi);
  1076. begin scalar diff,erg,hilf,liste;
  1077. if (atom phi) or (not phi)
  1078. then erg:=phi
  1079. else
  1080. << diff:= cadr phi;
  1081. if dqe_isconstant diff
  1082. then erg:= eval list(car phi,diff,0)
  1083. else
  1084. if listp diff
  1085. then
  1086. << if car diff ='minus or car diff = 'expt
  1087. then
  1088. << diff := cadr diff;
  1089. erg := dqe_simplifyat(list(car phi,diff,0))>>
  1090. else
  1091. if car diff ='times
  1092. then
  1093. << diff := cdr diff;
  1094. while diff do
  1095. << hilf := car diff;
  1096. if not(dqe_isconstant hilf)
  1097. then liste := dqe_consm(hilf,liste);
  1098. diff := cdr diff >>;
  1099. if not liste
  1100. then erg := eval list(car phi,1,0)
  1101. else
  1102. if not cdr liste
  1103. then erg := list(car phi,car liste,0)
  1104. else
  1105. << while liste do
  1106. << hilf := car liste; liste := cdr liste;
  1107. hilf :=dqe_simplifyat(list(car phi,hilf,0));;
  1108. erg := dqe_modcons(hilf,erg) >>;
  1109. if not cdr erg then erg := car erg
  1110. else
  1111. if car phi = 'neq
  1112. then erg := cons('and,erg)
  1113. else erg := cons('or,erg) >> >>
  1114. else
  1115. if car diff = 'plus
  1116. then
  1117. << hilf := qe92_lin_normcontent diff;
  1118. if not( hilf = 1)
  1119. then diff := reval list('quotient,diff, hilf);
  1120. if minusf numr simp diff
  1121. then diff := reval list('minus,diff);
  1122. erg := list(car phi,diff,0) >>
  1123. else erg := list(car phi,diff,0) >>
  1124. else erg := phi>>;
  1125. return erg;
  1126. end;
  1127. %%%%%%%%%%%%%%% dqe_simplify %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1128. % %
  1129. % dqe_simplify vereinfacht eine positive quantorenfreie formel %
  1130. % mit abstuetzung auf dqe_simplifyat durch rekursion ueber den %
  1131. % aufbau der formel. %
  1132. % diese prozedur wurde von k.d. burhenne uebernommen und %
  1133. % entsprechend geaendert. (siehe kapitel 3 abschnitt 3.4) %
  1134. % %
  1135. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1136. symbolic procedure dqe_simplify(phi);
  1137. begin scalar erg,hilf,erghilf,weiter;
  1138. if (phi = t) or (not phi)
  1139. then erg := phi
  1140. else
  1141. if car phi ='and
  1142. then
  1143. << weiter:=t;hilf:=cdr phi;erg:=nil;
  1144. while weiter and hilf do
  1145. << erghilf:=dqe_simplify car hilf;hilf:=cdr hilf;
  1146. if erghilf=nil
  1147. then weiter:=nil
  1148. else
  1149. if erghilf neq t
  1150. then erg:= dqe_modcons(erghilf,erg) >>;
  1151. if weiter=nil then erg:= nil
  1152. else
  1153. if not erg then erg:= t
  1154. else
  1155. if cdr erg
  1156. then erg:=cons('and, erg)
  1157. else erg:=car erg >>
  1158. else
  1159. if car phi ='or
  1160. then
  1161. << weiter:=t;hilf:=cdr phi;erg:=nil;
  1162. while weiter and hilf do
  1163. << erghilf:=dqe_simplify car hilf;hilf:=cdr hilf;
  1164. if erghilf=t
  1165. then weiter:=nil
  1166. else
  1167. if erghilf neq nil
  1168. then erg:=dqe_modcons(erghilf,erg) >>;
  1169. if weiter=nil then erg:= t
  1170. else
  1171. if not erg then erg:= nil
  1172. else
  1173. if cdr erg then erg:=cons('or, erg)
  1174. else erg:=car erg >>
  1175. else erg:=dqe_simplifyat phi ;
  1176. if !*dqeoptsimp
  1177. then erg := dqe_helpsimplify(erg);
  1178. return erg ;
  1179. end;
  1180. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1181. % %
  1182. % die folgenden prozeduren wurden unveraendert aus der arbeit %
  1183. % qe92 von t. sturm uebernommen. %
  1184. % die procedur qe92_lin_normconten berechnet den zahligen ggt.%
  1185. % aller monomen eines gegebenen polynomes. %
  1186. % %
  1187. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1188. symbolic procedure qe92_lin_normcontent u;
  1189. prepf qe92_lin_normcontent1(numr simp u,nil);
  1190. symbolic procedure qe92_lin_normcontent1(u,g);
  1191. % g is the gcd collected so far.
  1192. if g = 1 then g
  1193. else if domainp u then gcdf(absf u,g)
  1194. else qe92_lin_normcontent1(red u,qe92_lin_normcontent1(lc u,g));
  1195. % part 4
  1196. %%%%%%%%%%%%%%%% dqe_helpremainder %%%%%%%%%%%%%%%%%%%%%%%%%%%
  1197. % %
  1198. % dqe_helpremainder ist eine hilfsprozedur fuer dqe_restfkt.sie%
  1199. % ist eine umbennenung fuer die reduce-funktion remainder, die %
  1200. % nur im algebraischen modus verwendet werden kann. %
  1201. % %
  1202. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1203. algebraic procedure dqe_helpremainder(phi,psi,var);
  1204. begin scalar erg;
  1205. korder var;
  1206. erg := remainder(phi,psi);
  1207. return erg;
  1208. end;
  1209. %%%%%%%%%%%%%%%%% dqe_ helpcoeff %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1210. % %
  1211. % dqe_helpcoeff ist eine hilfsprozedur fuer dqe_koeff. sie ist %
  1212. % eine umbennenung der reduce-funktion coeff, die nur im alge- %
  1213. % braischen modus verwendet werden kann. %
  1214. % %
  1215. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1216. algebraic procedure dqe_helpcoeff(phi,var);
  1217. begin scalar erg;
  1218. erg := coeff(phi,var);
  1219. return erg;
  1220. end;
  1221. %%%%%%%%%%%%%%%%%%%% dqe_koeff %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1222. % %
  1223. %dqe_koeff ist eine hilfsprozedur fuer dqe_termcoefkt.sie bestimmt%
  1224. % die liste der koeffizienten eines differentialpolynoms phi %
  1225. % bzgl. der variable var.sie verwendet die hilfsprozedur dqe_help-%
  1226. % coeff. (siehe kapitel 4 abschnitt 4.5) %
  1227. % %
  1228. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1229. symbolic procedure dqe_koeff(phi,var);
  1230. begin scalar erg;
  1231. erg := cdr reval dqe_helpcoeff(phi,var);
  1232. return erg;
  1233. end;
  1234. %%%%%%%%%%%%%%%%%%%% dqe_restfkt %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1235. % %
  1236. %dqe_restfkt ist eine hilfsprozedur fuer dqe_termcoefkt.sie bestimmt%
  1237. % den rest der divition eines differentialpolynoms phi durch %
  1238. % ein differentialpolynom psi bzgl. der variable var. sie verwendet %
  1239. % die hilfsprozedur dqe_helpremainder. %
  1240. % (siehe kapitel 4 abschnitt 4.5) %
  1241. % %
  1242. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1243. symbolic procedure dqe_restfkt(phi,psi,var);
  1244. begin scalar erg;
  1245. erg := dqe_pform dqe_helpremainder(phi,psi,var);
  1246. if not erg then erg := 0;
  1247. return erg;
  1248. end;
  1249. %%%%%%%%%%%%%%%%% dqe_pseudf %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1250. % %
  1251. %dqe_pseudf ist eine hilfsprozedur fuer dqe_partialdf.sie bestimmt%
  1252. % die normale partialableitung eines differentialpolynoms phi %
  1253. % bzgl. der variable var.sie verwendet die hilfsprozedur dqe_help-%
  1254. % df. (siehe kapitel 4 abschnitt 4.2) %
  1255. % %
  1256. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1257. symbolic procedure dqe_pseudf(phi,var);
  1258. reval {'df,phi,var};
  1259. %%%%%%%%%%%%%%%%%% dqe_varmengefkt %%%%%%%%%%%%%%%%%%%%%%%%
  1260. % %
  1261. % varmengefkt berechnet die menge aller im differentialpolynom %
  1262. % vorkommenden variablen. (siehe kapitel 4 abschnitt 4.2) %
  1263. % %
  1264. % eingabe : ein differentialpolynom phi. %
  1265. % %
  1266. % ausgabe : eine liste der allen variablen, die in phi %
  1267. % vorkommen . %
  1268. % %
  1269. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1270. symbolic procedure dqe_varmengefkt(phi);
  1271. begin scalar varmenge,hilf,elem,hilfmenge;
  1272. hilf := phi;
  1273. varmenge := nil;
  1274. if atom hilf
  1275. then << if not dqe_isconstant hilf
  1276. then varmenge := list(hilf)>>
  1277. else
  1278. if car hilf = 'd
  1279. then varmenge := list(hilf)
  1280. else
  1281. <<while hilf do
  1282. << elem := car hilf;
  1283. hilf := cdr hilf;
  1284. if atom elem
  1285. then
  1286. << if not(elem ='plus or elem ='times or elem ='expt
  1287. or elem ='minus or dqe_isconstant elem )
  1288. then varmenge := dqe_modcons(elem,varmenge)>>
  1289. else
  1290. << hilfmenge := dqe_varmengefkt(elem);
  1291. while hilfmenge do
  1292. << varmenge := dqe_modcons(car hilfmenge,varmenge);
  1293. hilfmenge := cdr hilfmenge >> >> >> >>;
  1294. return varmenge;
  1295. end;
  1296. %%%%%%%%%%%%%%%%%%%% dqe_partieldf %%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1297. % %
  1298. % die prozedur dqe_partieldf berechnet die partielle ableitung %
  1299. % von phi bezueglich der variable var . %
  1300. % die liste diffequaliste ist leer oder sie besteht aus einer %
  1301. % liste von der form list(var_1,var_1',var_2,var_2',...) wobei %
  1302. % die ableitung von var_k gleich var_k' ist. %
  1303. % (siehe kapitel 4 abschnitt 4.2) %
  1304. % %
  1305. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1306. symbolic procedure dqe_partieldf(phi,var,diffequaliste);
  1307. begin scalar hilf,liste,ausg;
  1308. ausg := 0;
  1309. hilf := dqe_pseudf(phi,var);
  1310. if not(var member diffequaliste)
  1311. then
  1312. << if atom var
  1313. then ausg := reval list('times,hilf,list('d,var,1))
  1314. else ausg := reval list('times,hilf,list('d,cadr var,
  1315. eval list('plus,caddr var,1))) >>
  1316. else
  1317. << liste := diffequaliste;
  1318. while not(var = car liste) do << liste := cddr liste >>;
  1319. if cadr liste = 0
  1320. then ausg := 0
  1321. else ausg := reval list('times,hilf,cadr liste) >>;
  1322. return ausg;
  1323. end;
  1324. %%%%%%%%%%%%%%%% dqe_diffkt %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1325. % %
  1326. %dqe_diffkt berechnet die erste ableitung des differentialpoly-%
  1327. % nomes phi. sie ist eine sub-routine von dqe_diff. %
  1328. % (siehe kapitel 4 abschnitt 4.2) %
  1329. % %
  1330. % eingabe : phi und diffequaliste. %
  1331. % ausgabe : die ableitung von phi . %
  1332. % %
  1333. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1334. symbolic procedure dqe_diffkt(phi,diffequaliste);
  1335. begin scalar var,varmenge,hilf,erg;
  1336. erg := nil;
  1337. varmenge := dqe_varmengefkt(phi);
  1338. while varmenge do
  1339. << var := car varmenge;
  1340. varmenge := cdr varmenge;
  1341. hilf := dqe_partieldf(phi,var,diffequaliste);
  1342. if not(hilf = 0)
  1343. then erg := cons(hilf,erg) >>;
  1344. if not erg
  1345. then erg := 0
  1346. else
  1347. if not cdr erg
  1348. then erg := car erg
  1349. else erg := reval cons('plus,erg);
  1350. return erg ;
  1351. end;
  1352. %%%%%%%%%%%%%%%%%% dqe_diff %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1353. % %
  1354. % die prozedur dqe_diff berechnet die n_te ableitung des diffe-%
  1355. % rentialpolynoms phi. (siehe kapitel 4 abschnitt 4.2) %
  1356. % %
  1357. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1358. symbolic procedure dqe_diff(phi,const,diffequaliste);
  1359. begin scalar hilf, erg;
  1360. erg := phi;
  1361. hilf := 1;
  1362. while const >= hilf do
  1363. << erg := dqe_diffkt(erg,diffequaliste);
  1364. hilf := hilf +1 >>;
  1365. return erg;
  1366. end;
  1367. %%%%%%%%%%%%%%%% dqe_termcoefkt %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1368. % %
  1369. % dqe_termcoefkt bestimmt die liste von koeffizienten der terme %
  1370. % eines differentialpolynoms bzgl. der variable var. %
  1371. % (siehe kapitel 4 abschnitt 4.5) %
  1372. % %
  1373. % eingabe : ein differentialpolynom phi und eine variable var . %
  1374. % %
  1375. % ausgabe : list(c1,c2,...,cn) wobei phi =c1*t1+c2*t2+...+cn*tn %
  1376. % und die ti's die terme von phi sind. %
  1377. % %
  1378. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1379. symbolic procedure dqe_termcoefkt(phi,var);
  1380. begin scalar hilf,ordc,rest,const,erg,ausg;
  1381. ausg := nil;
  1382. ordc := dqe_ord(phi,var);
  1383. rest := dqe_restfkt(phi,var,var);
  1384. const := 1;
  1385. if not(ordc = 0) and not(rest = 0)
  1386. then
  1387. while const <= ordc do
  1388. << rest :=dqe_restfkt(rest,list('d,var,const),list('d,var,const));
  1389. if rest = 0
  1390. then const := ordc + 1
  1391. else const := const + 1 >> ;
  1392. hilf := reval list('difference,phi,rest);
  1393. hilf := dqe_koeff(hilf,var);
  1394. const := 1;
  1395. while const <= ordc do
  1396. << while hilf do
  1397. << if not(car hilf = 0)
  1398. then << erg := dqe_koeff(car hilf,list('d,var,const));
  1399. ausg := append(ausg,erg) >>;
  1400. hilf := cdr hilf >>;
  1401. hilf := ausg;
  1402. ausg := nil;
  1403. const := const + 1>>;
  1404. while hilf do
  1405. << if not(car hilf = 0)
  1406. then ausg := dqe_modcons(car hilf,ausg);
  1407. hilf := cdr hilf >>;
  1408. ausg := cons(rest,ausg);
  1409. return ausg;
  1410. end;
  1411. %%%%%%%%%%%%%%%%% dqe_helpord %%%%%%%%%%%%%%%%%%%%%%%%%%%
  1412. % %
  1413. % dqe_helpord ist eine hilfsprozedur fuer dqe_ord.sie berechnet%
  1414. % die ordnung eines monomes phi bzgl. der variable var. %
  1415. % (siehe kapitel 4 abschnitt 4.3) %
  1416. % %
  1417. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1418. symbolic procedure dqe_helpord(phi,var);
  1419. begin scalar erg, hilf;
  1420. erg := 0;
  1421. if atom phi
  1422. then erg := 0
  1423. else
  1424. if car phi = 'd
  1425. then
  1426. << if cadr phi = var
  1427. then erg := caddr phi
  1428. else erg := 0 >>
  1429. else
  1430. if car phi = 'expt
  1431. then erg := dqe_helpord(cadr phi,var)
  1432. else
  1433. if car phi ='minus
  1434. then erg := dqe_helpord(cadr phi,var)
  1435. else
  1436. if car phi = 'times
  1437. then
  1438. << phi := cdr phi; erg := 0;
  1439. while phi do
  1440. << hilf := car phi;
  1441. phi := cdr phi;
  1442. hilf := dqe_helpord(hilf,var);
  1443. erg := erg + hilf>> >>
  1444. else erg := 0;
  1445. return erg;
  1446. end;
  1447. %%%%%%%%%%%%%%%%%%%% dqe_ord %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1448. % %
  1449. %dqe_ord bestimmt die ordnung eines diffedifferentialpolynoms%
  1450. % phi bezueglich der variable var. %
  1451. % (siehe kapitel 4 abschnitt 4.3) %
  1452. % %
  1453. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1454. symbolic procedure dqe_ord(phi,var);
  1455. begin scalar ausg,hilf;
  1456. ausg := 0;
  1457. if atom phi
  1458. then ausg := 0
  1459. else
  1460. if not(car phi = 'plus )
  1461. then ausg := dqe_helpord(phi,var)
  1462. else
  1463. << phi := cdr phi;
  1464. while phi do
  1465. << hilf := car phi;
  1466. phi := cdr phi;
  1467. hilf := dqe_helpord(hilf,var);
  1468. if ausg < hilf
  1469. then ausg := hilf >> >>;
  1470. return ausg;
  1471. end;
  1472. %%%%%%%%%%%%%%%%%%% dqe_grad %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1473. % %
  1474. % die prozedur dqe_grad berechnet den grad des differential-%
  1475. % polynoms phi bezueglich der variable var . %
  1476. % (siehe kapitel 4 abschnitt 4.3) %
  1477. % %
  1478. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1479. symbolic procedure dqe_grad(phi,var);
  1480. begin scalar erg,hilf,ordc;
  1481. ordc := dqe_ord(phi,var);
  1482. if ordc = 0 then hilf := var
  1483. else hilf := list('d,var,ordc);
  1484. erg := deg(phi,hilf);
  1485. if null erg then erg := 0;
  1486. return erg;
  1487. end;
  1488. %%%%%%%%%%%%%%%%% dqe_initial %%%%%%%%%%%%%%%%%%%%%%%%%
  1489. % %
  1490. % die prozedur dqe_initial berechnet die initiale des diffe-%
  1491. % rentialpolynomes bezueglich der variable var . %
  1492. % (siehe kapitel 4 abschnitt 4.4) %
  1493. % %
  1494. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1495. symbolic procedure dqe_initial(phi,var);
  1496. begin scalar ordc,hilfvar,ausg;
  1497. ordc := dqe_ord(phi,var);
  1498. if ordc = 0 then hilfvar := var
  1499. else hilfvar := list('d,var,ordc);
  1500. ausg := reval lcof(phi,hilfvar);
  1501. return ausg;
  1502. end;
  1503. %%%%%%%%%%%%%%%%% dqe_reduktum %%%%%%%%%%%%%%%%%%%%%%%%%%%
  1504. % %
  1505. % die prozedur dqe_reduktum berechnet das reduktum des diffe-%
  1506. % rentialpolynomes bezueglich der variable var . %
  1507. % (siehe kapitel 4 abschnitt 4.4) %
  1508. % %
  1509. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1510. symbolic procedure dqe_reduktum(phi,var);
  1511. begin scalar ordc,gradc,hilf,hilfvar,ausg;
  1512. ordc := dqe_ord(phi,var);
  1513. gradc := dqe_grad(phi,var);
  1514. if ordc = 0 then hilfvar := var
  1515. else hilfvar := list('d,var,ordc);
  1516. hilf := list('expt,hilfvar,gradc);
  1517. hilf := reval list('times,dqe_initial(phi,var),hilf);
  1518. ausg := reval list('difference,phi,hilf);
  1519. return ausg;
  1520. end;
  1521. %%%%%%%%%%%%%%%%% dqe_separante %%%%%%%%%%%%%%%%%%%%%%%%%%%
  1522. % %
  1523. % die prozedur dqe_separante berechnet die separante eines %
  1524. % differentialpolynomes phi bezueglich der variable var . %
  1525. % (siehe kapitel 1 definition 1.1.7) %
  1526. % %
  1527. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1528. symbolic procedure dqe_separante(phi,var);
  1529. begin scalar ordc,hilfvar,ausg;
  1530. ordc := dqe_ord(phi,var);
  1531. if ordc = 0 then hilfvar := var
  1532. else hilfvar := list('d,var,ordc);
  1533. ausg := dqe_pseudf(phi,hilfvar);
  1534. return ausg;
  1535. end;
  1536. %%%%%%%%%%%%%%%%% dqe_pseudrest %%%%%%%%%%%%%%%%%%%%%%%%%%
  1537. % %
  1538. %die prozedur dqe_pseudrest berechnet den rest einer pseudo-%
  1539. % divition von phi durch psi bezueglich der variable var . %
  1540. % (siehe kapitel 4 abschnitt 4.1) %
  1541. % %
  1542. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1543. symbolic procedure dqe_pseudrest(phi,psi,var);
  1544. begin scalar rest, q, k, l, hilf;
  1545. rest := phi;
  1546. hilf := deg(rest,var);
  1547. if not hilf then hilf := 0;
  1548. q := 0;
  1549. k := 0;
  1550. l := deg(psi,var);
  1551. if not l then l := 0;
  1552. while not(hilf = 0) and not(l = 0) and hilf >= l do
  1553. << k := list('times,reval lcof(rest,var),
  1554. list('expt,var,reval list('difference,hilf,l)));
  1555. q := list('plus,list('times,reval lcof(psi,var),q),k);
  1556. rest :=reval list('difference,reval list('times,lcof(psi,var),rest),
  1557. list('times,k,psi));
  1558. hilf := deg(rest,var);
  1559. if not hilf then hilf := 0 >>;
  1560. if not rest then rest := 0
  1561. else rest := reval rest;
  1562. return rest;
  1563. end;
  1564. %%%%%%%%%%%%%%%%% dqe_listenord %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1565. % %
  1566. %dqe_listenord ordnet eine liste von differentialpolynomen bzgl.%
  1567. % der lexikographischen ordnung der paare, die aus der ordnung %
  1568. % und dem grad jedes polynoms bzgl. der variable var bestehen. %
  1569. % (siehe kapitel 4 abschnitt 4.7) %
  1570. % %
  1571. % eingabe : phi von der form list(f1,f2,f3,..,fn) und var. %
  1572. % %
  1573. % ausgabe : list(f'1,f'2,f'3,...,f'n) wobei %
  1574. %(ord f'1,grad f'1)<=(ord f'2,grad f'2)<=...<=(ord f'n,grad f'n)%
  1575. % %
  1576. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1577. symbolic procedure dqe_listenord(phi,var);
  1578. begin scalar geordliste,hilflist,hilf,hilf1,erg,testvar;
  1579. geordliste := nil;
  1580. erg := nil;
  1581. testvar := t;
  1582. if cdr phi
  1583. then
  1584. << hilflist := list(car phi);
  1585. phi := cdr phi;
  1586. while phi do
  1587. << hilf := car phi;
  1588. phi := cdr phi;
  1589. while hilflist and testvar do
  1590. << hilf1 := car hilflist;
  1591. if dqe_ord(hilf,var) > dqe_ord(hilf1,var)
  1592. then
  1593. << erg := dqe_consm(hilf,hilflist);
  1594. geordliste := append(geordliste,erg);
  1595. testvar := nil >>
  1596. else
  1597. if dqe_ord(hilf,var) = dqe_ord(hilf1,var) and
  1598. dqe_grad(hilf,var) >= dqe_grad(hilf1,var)
  1599. then
  1600. << erg := dqe_consm(hilf,hilflist);
  1601. geordliste := append(geordliste,erg);
  1602. testvar := nil >>
  1603. else
  1604. << geordliste := reverse geordliste;
  1605. geordliste := reverse dqe_consm(hilf1,geordliste);
  1606. hilflist := cdr hilflist >>;
  1607. if not(hilflist) and testvar
  1608. then geordliste := dqe_modcons(hilf,geordliste)>>;
  1609. if phi
  1610. then << hilflist := geordliste;
  1611. geordliste := nil;
  1612. testvar := t >>
  1613. else geordliste := reverse geordliste >> >>
  1614. else geordliste := phi ;
  1615. return geordliste;
  1616. end;
  1617. %%%%%%%%%%%%%%%% dqe_neqnullfkt %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1618. % %
  1619. % dqe_neqnullfkt ist hilfsprozedur fuer dqe_elim. %
  1620. % (siehe kapitel 4 abschnitt 4.9) %
  1621. % %
  1622. % eingabe : eine liste phi der form list(elem1,....,elemn). %
  1623. % %
  1624. % ausgabe : list('or,list('neq,elem1,0),...,list('neq,elmn,0)). %
  1625. % %
  1626. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1627. procedure dqe_neqnullfkt(phi);
  1628. begin scalar r;
  1629. if not phi then
  1630. return nil;
  1631. r := for each elem in phi collect
  1632. {'neq,reval elem,0};
  1633. if not cdr r then
  1634. return car r;
  1635. return 'or . r
  1636. end;
  1637. %%%%%%%%%%%%%%%%%% dqe_equalnullfkt %%%%%%%%%%%%%%%%%%%%%%%%%%
  1638. % %
  1639. % dqe_equalnullfkt ist hilfsprozedur fuer dqe_elim. %
  1640. % (siehe kapitel 4 abschnitt 4.9) %
  1641. % %
  1642. % eingabe : eine liste phi der form list(elem1,....,elemn). %
  1643. % %
  1644. % ausgabe : list(list('equal,elem1,0),..., %
  1645. % list('equal,elmn,0)). %
  1646. % %
  1647. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1648. procedure dqe_equalnullfkt(phi);
  1649. for each elem in phi collect
  1650. {'equal,reval elem,0};
  1651. %%%%%%%%%%%%%%%% dqe_elimsimplify %%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1652. % %
  1653. % dqe_elimsimplify ist hilfsprozedur fuer dqe_elim. %
  1654. % (siehe kapitel 4 abschnitt 4.9) %
  1655. % %
  1656. % eingabe : phi von der form list(f1,f2,...,fn), zwerg und var. %
  1657. % %
  1658. % ausgabe : ausg, die aus nzwerg und erg besteht. %
  1659. % nzwerg ist die neue zwichenergliste, die aus zwerg %
  1660. % und der liste der konstanten polynome bzgl. var %
  1661. % gleichgesetzt mit 0. %
  1662. % erg ist die liste der differentialpolynome,die nicht%
  1663. % konstant bzgl. der variable var sind. %
  1664. % %
  1665. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1666. symbolic procedure dqe_elimsimplify(phi,zwerg,var);
  1667. begin scalar hilfg,hilf,erg1,erg2,ausg;
  1668. ausg := nil;
  1669. erg1 := nil;
  1670. erg2 := nil;
  1671. while phi do
  1672. << hilf := car phi;
  1673. hilfg := dqe_grad(hilf,var);
  1674. if hilfg = 0
  1675. then erg1 := dqe_modcons(reval hilf,erg1)
  1676. else erg2 := dqe_consm(hilf,erg2) ;
  1677. phi := cdr phi >>;
  1678. erg1 := dqe_equalnullfkt(erg1);
  1679. if erg1
  1680. then
  1681. << if not cdr erg1 then erg1 := car erg1
  1682. else erg1 := cons('and,erg1)>>;
  1683. if zwerg and not cdr zwerg then zwerg := car zwerg;
  1684. erg1 := dqe_andorvaleur(list('and,zwerg,erg1));
  1685. ausg := list(erg1,erg2);
  1686. return ausg;
  1687. end;
  1688. % part 5
  1689. %%%%%%%%%%%%%%%% dqe_start1 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1690. % %
  1691. % diese prozedur fuehrt die quantorenelimination durch. %
  1692. % eingegeben wird nur die eingabeformel. %
  1693. % %
  1694. % eingabe : eine beliebige formel phi %
  1695. % %
  1696. % ausgabe : eine positive quantorenfreie formel, die aequi- %
  1697. % valent zu phi ist. %
  1698. % %
  1699. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1700. symbolic procedure dqe_start1(phi);
  1701. begin scalar ausg,diffequaliste;
  1702. diffequaliste := nil;
  1703. if !*dqeverbose
  1704. then <<
  1705. prin2t "+++++++++++++++++++++++++++++++++++++++++++++++++++++++";
  1706. if !*dqeoptsimp then <<
  1707. prin2t "+++ dqeoptsimp ist on d.h. die ergebnisse von simplify+";
  1708. prin2t "+++ bzw. disjnf bzw. konjnf werden vereinfacht +++">>
  1709. else
  1710. prin2t "+++ deqoptsimp ist off +++";
  1711. if not !*dqegradord then
  1712. prin2t "+++ dqegradord ist off +++">>;
  1713. if !*dqeoptqelim
  1714. then
  1715. <<
  1716. if !*dqeverbose
  1717. then <<
  1718. prin2t "+++ das qe_verfahren wird mit aussagenlogischen +++";
  1719. prin2t "+++ vereinfachungen ausgefuehrt. +++";
  1720. prin2t "+++++++++++++++++++++++++++++++++++++++++++++++++++++++">>;
  1721. ausg := dqe_quantelimopt(phi,diffequaliste)
  1722. >>
  1723. else
  1724. <<
  1725. if !*dqeverbose
  1726. then <<
  1727. prin2t "+++ das qe_verfahren wird ohne aussagenlogischen +++";
  1728. prin2t "+++ vereinfachungen ausgefuehrt. +++";
  1729. prin2t "+++++++++++++++++++++++++++++++++++++++++++++++++++++++">>;
  1730. ausg := dqe_quantelim(phi,diffequaliste)
  1731. >>;
  1732. return ausg;
  1733. end;
  1734. %%%%%%%%%%%%%%%% dqe_start2 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1735. % %
  1736. % diese prozedur fuehrt auch wie dqe_start1 die quantoreneli- %
  1737. % mination. %
  1738. % %
  1739. % eingabe : eine beliebige formel phi und %
  1740. % eine liste diffequaliste %
  1741. % %
  1742. % ausgabe : eine positive quantorenfreie formel, die aequi- %
  1743. % valent zu phi ist. %
  1744. % %
  1745. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1746. symbolic procedure dqe_start2(phi,diffequaliste);
  1747. begin scalar ausg;
  1748. if !*dqeverbose
  1749. then <<
  1750. prin2t "+++++++++++++++++++++++++++++++++++++++++++++++++++++++";
  1751. if !*dqeoptsimp then <<
  1752. prin2t "+++ dqeoptsimp ist on d.h. die ergebnisse von simplify+";
  1753. prin2t "+++ bzw. disjnf bzw. konjnf werden vereinfacht +++">>
  1754. else
  1755. prin2t "+++ deqoptsimp ist off +++";
  1756. if not !*dqegradord then
  1757. prin2t "+++ dqegradord ist off +++"
  1758. >>;
  1759. if !*dqeoptqelim
  1760. then
  1761. <<
  1762. if !*dqeverbose
  1763. then <<
  1764. prin2t "+++ das qe_verfahren wird mit aussagenlogischen +++";
  1765. prin2t "+++ vereinfachungen ausgefuehrt. +++";
  1766. prin2t "+++++++++++++++++++++++++++++++++++++++++++++++++++++++" >>;
  1767. ausg := dqe_quantelimopt(phi,diffequaliste)
  1768. >>
  1769. else
  1770. <<
  1771. if !*dqeverbose
  1772. then <<
  1773. prin2t "+++ das qe_verfahren wird ohne aussagenlogischen +++";
  1774. prin2t "+++ vereinfachungen ausgefuehrt. +++";
  1775. prin2t "+++++++++++++++++++++++++++++++++++++++++++++++++++++++">>;
  1776. ausg := dqe_quantelim(phi,diffequaliste);
  1777. >>;
  1778. return ausg;
  1779. end;
  1780. %%%%%%%%%%%%%%%% dqe_elim %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1781. % %
  1782. % elim ist eine subroutine fuer die prozeduren exqelim und %
  1783. % allqelim (siehe abschnitt 5.1 in kapitel 5). %
  1784. % %
  1785. % eingabe : eine positive quantorenfreie teilformel phi , %
  1786. % eine gebundene variable var und diffequaliste . %
  1787. % %
  1788. % ausgabe : eine positive quantorenfreie formel phi', die %
  1789. % aequivalen zu ex var phi ist . %
  1790. % %
  1791. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1792. symbolic procedure dqe_elim(phi,diffequaliste,var);
  1793. begin scalar hilf,ordhilf,erg1,erg2,ausg,zwerg,phi1,hilfvar,phi2,rest,
  1794. hilff,hilfg,ghilf,gradf,gradg,ordf,ordg,redf,initf,const,
  1795. erg21,erg22,erg,phi21,phi22,redhilf,sepf,gghilf,liste,helplist;
  1796. if !*dqegradord and !*dqeverbose then
  1797. prin2t "++++";
  1798. zwerg := nil;
  1799. phi := dqe_helpelim(phi);
  1800. if phi = t or (not phi)
  1801. then ausg := phi
  1802. else
  1803. if not cdr phi
  1804. then
  1805. <<hilf := car phi;
  1806. if !*dqegradord and !*dqeverbose then
  1807. << ordg := dqe_ord(hilf,var);
  1808. gradg := dqe_grad(hilf,var);
  1809. prin2t "()";
  1810. prin2t list(ordg,gradg)
  1811. >>;
  1812. ausg := dqe_neqnullfkt(dqe_termcoefkt(hilf,var)) >>
  1813. else
  1814. if car phi = 1 and not cddr phi
  1815. then
  1816. <<hilf := cadr phi;
  1817. if !*dqegradord and !*dqeverbose then
  1818. << ordf := dqe_ord(hilf,var);
  1819. gradf := dqe_grad(hilf,var);
  1820. prin2t list(ordf,gradf);
  1821. prin2t "()"
  1822. >>;
  1823. erg := dqe_termcoefkt( hilf,var);
  1824. hilf := list('equal,reval car erg,0);
  1825. erg := dqe_neqnullfkt(cdr erg);
  1826. ausg := dqe_andorvaleur(list('or,hilf,erg)) >>
  1827. else
  1828. <<
  1829. hilfg := car phi;
  1830. if (dqe_isconstant hilfg) and not(hilfg = 0)
  1831. then hilfg := 1;
  1832. phi := cdr phi;
  1833. ordg := dqe_ord(hilfg,var);
  1834. gradg := dqe_grad(hilfg,var);
  1835. if not cdr phi
  1836. then
  1837. << hilff := car phi;
  1838. ordf := dqe_ord(hilff,var);
  1839. gradf := dqe_grad(hilff,var);
  1840. if !*dqegradord and !*dqeverbose then
  1841. <<
  1842. prin2t list(ordf,gradf);
  1843. prin2t list(ordg,gradg)
  1844. >>;
  1845. if gradf = 0
  1846. then << erg1 := list('equal,reval hilff,0);
  1847. erg2 := dqe_neqnullfkt(
  1848. dqe_termcoefkt( hilfg,var));
  1849. ausg := dqe_andorvaleur(list('and,erg1,erg2)) >>
  1850. else
  1851. <<redf := dqe_reduktum(hilff,var);
  1852. initf := dqe_initial(hilff,var);
  1853. if redf = 0
  1854. then phi1 := list('and,list('neq,hilfg,0),
  1855. list('equal,initf,0))
  1856. else
  1857. << phi1 := dqe_equalnullfkt(
  1858. dqe_consm(initf,list(redf)));
  1859. phi1 :=cons('and,cons(list('neq,hilfg,0),phi1))>>;
  1860. if ordf > ordg
  1861. then << erg21 := dqe_neqnullfkt(
  1862. dqe_termcoefkt(hilfg,var));
  1863. erg22 := dqe_neqnullfkt(
  1864. dqe_termcoefkt(initf,var));
  1865. erg2 :=
  1866. dqe_andorvaleur(list('and,erg21,erg22))>>
  1867. else
  1868. if ordf = ordg
  1869. then
  1870. << if ordf = 0 then hilfvar := var
  1871. else hilfvar := list('d,var,ordf);
  1872. ghilf :=dqe_pseudrest(list('expt,hilfg,gradf),hilff,
  1873. hilfvar);
  1874. erg21 := dqe_neqnullfkt(dqe_termcoefkt(ghilf,var));
  1875. erg22 := dqe_neqnullfkt(dqe_termcoefkt(initf,var));
  1876. erg2 := dqe_andorvaleur(list('and,erg21,erg22)) >>
  1877. else
  1878. << const := reval list('difference,ordg,ordf);
  1879. hilf := dqe_diff(hilff,const,diffequaliste);
  1880. hilfvar := list('d,var,ordg);
  1881. ghilf := dqe_pseudrest(hilfg,hilf,hilfvar);
  1882. if not(dqe_isconstant initf)
  1883. then ghilf := reval list('times,initf,ghilf);
  1884. phi21 := list('and,list('neq,ghilf,0),
  1885. list('equal,hilff,0)) ;
  1886. erg21 := dqe_elim(phi21,diffequaliste,var) ;
  1887. if dqe_isconstant initf
  1888. then gghilf := hilfg
  1889. else gghilf :=reval list('times,initf,hilfg);
  1890. sepf := dqe_separante(hilff,var);
  1891. redhilf := dqe_reduktum(hilf,var);
  1892. phi22 := dqe_consm(list('equal,sepf,0),
  1893. dqe_consm(list('equal,redhilf,0),
  1894. list(list('equal,hilff,0)) ) );
  1895. phi22 := cons('and,cons(list('neq,gghilf,0),
  1896. phi22));
  1897. erg22 := dqe_elim(phi22,diffequaliste,var) ;
  1898. erg2 := dqe_andorvaleur(list('or,erg21,erg22))>>;
  1899. erg1 := dqe_elim(phi1,diffequaliste,var);
  1900. ausg := dqe_andorvaleur(list('or,erg1,erg2)) >> >>
  1901. else
  1902. << phi := dqe_elimsimplify(phi,zwerg,var);
  1903. zwerg := car phi;
  1904. phi := cadr phi;
  1905. if not phi
  1906. then
  1907. << if !*dqegradord and !*dqeverbose then
  1908. << prin2t "()";
  1909. prin2t list(ordg,gradg) >>;
  1910. erg := dqe_neqnullfkt(dqe_termcoefkt( hilfg,var));
  1911. if zwerg and not cdr zwerg
  1912. then ausg :=
  1913. dqe_andorvaleur(list('and,erg,car zwerg))
  1914. else ausg :=
  1915. dqe_andorvaleur(list('and,erg,zwerg)) >>
  1916. else
  1917. if not cdr phi
  1918. then << phi := list('and,list('neq,hilfg,0),
  1919. list('equal,car phi,0));
  1920. erg := dqe_elim(phi,diffequaliste,var);
  1921. if zwerg and not cdr zwerg
  1922. then ausg :=
  1923. dqe_andorvaleur(list('and,erg,car zwerg))
  1924. else
  1925. ausg :=dqe_andorvaleur(list('and,erg,zwerg)) >>
  1926. else
  1927. <<phi := dqe_listenord(phi,var);
  1928. if !*dqegradord and !*dqeverbose then
  1929. << liste := phi; helplist := nil;
  1930. while liste do
  1931. << hilf := car liste; liste := cdr liste;
  1932. helplist := cons( list(dqe_ord(hilf,var),
  1933. dqe_grad(hilf,var)),helplist) >>;
  1934. prin2t helplist;
  1935. prin2t list(ordg,gradg);
  1936. >>;
  1937. hilff := car phi;
  1938. initf := dqe_initial(hilff,var);
  1939. redf := dqe_reduktum(hilff,var);
  1940. ordf := dqe_ord(hilff,var);
  1941. if redf = 0
  1942. then
  1943. << phi1 := dqe_equalnullfkt(
  1944. dqe_consm(initf,cdr phi));
  1945. phi1 := cons('and,cons(list('neq,hilfg,0),phi1))>>
  1946. else
  1947. <<phi1 := dqe_equalnullfkt(
  1948. dqe_consm(initf,dqe_consm(redf,cdr phi)));
  1949. phi1 := cons('and,cons(list('neq,hilfg,0),phi1))>>;
  1950. if dqe_isconstant initf
  1951. then ghilf := hilfg
  1952. else ghilf := reval list('times,initf,hilfg);
  1953. hilf := cadr phi;
  1954. ordhilf := dqe_ord(hilf,var);
  1955. if ordhilf = 0
  1956. then hilfvar := var
  1957. else hilfvar := list('d,var,ordhilf);
  1958. if ordhilf = ordf
  1959. then rest := dqe_pseudrest(hilf,hilff,hilfvar)
  1960. else
  1961. << const := reval list('difference,ordhilf,ordf);
  1962. rest := dqe_pseudrest(hilf,dqe_diff(hilff,const,
  1963. diffequaliste),hilfvar) >>;
  1964. if rest = 0
  1965. then phi2 := dqe_equalnullfkt(
  1966. dqe_consm(hilff,cddr phi))
  1967. else
  1968. phi2 := dqe_equalnullfkt(dqe_consm(rest,
  1969. dqe_consm(hilff,cddr phi)));
  1970. phi2 := cons('and,cons(list('neq,ghilf,0),phi2));
  1971. erg1 := dqe_elim(phi1,diffequaliste,var);
  1972. erg2 := dqe_elim(phi2,diffequaliste,var);
  1973. erg := dqe_andorvaleur(list('or,erg1,erg2));
  1974. if zwerg and not cdr zwerg
  1975. then ausg := dqe_andorvaleur(list('and,erg,car zwerg))
  1976. else ausg :=dqe_andorvaleur(list('and,erg,zwerg)) >> >>
  1977. >>;
  1978. return ausg;
  1979. end;
  1980. %%%%%%%%%%%%%%%% dqe_exqelim %%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1981. % %
  1982. % exqelim ist eine subroutine fuer die prozedur quantelim %
  1983. % (siehe abschnitt 5.2 in kapitel 5). %
  1984. % %
  1985. % eingabe : eine positive quantorenfreie formel phi, eine ge- %
  1986. % bundene variable var und diffequaliste . %
  1987. % %
  1988. % ausgabe : eine positive quantorenfreie formel phi', die %
  1989. % aequivalent zu ex var phi ist . %
  1990. % %
  1991. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  1992. symbolic procedure dqe_exqelim(phi,diffequaliste,var);
  1993. begin scalar hilf,ausg,k,n,timevar,gctimevar,erg;
  1994. ausg := nil;n:= 0; k := 0;
  1995. if !*dqeverbose then
  1996. <<
  1997. prin2t "++nun wird ein existenzquantor eliminiert, also muss zuerst";
  1998. prin2t "++die formel in disjunktive normalform transformiert werden.";
  1999. prin2t "++die disjunktive normalform von ";
  2000. mathprint phi;prin2t "++ist :";
  2001. >>;
  2002. timevar := time();
  2003. gctimevar := gctime();
  2004. phi := dqe_disjnf(phi);
  2005. if !*dqeverbose then
  2006. <<
  2007. timevar := time() - timevar;
  2008. gctimevar := gctime() - gctimevar;
  2009. mathprint phi;
  2010. prin2 timevar;prin2" ms plus ";prin2 gctimevar;prin2t " ms."
  2011. >>;
  2012. if (phi = t) or (not phi) then ausg := phi
  2013. else
  2014. if car phi = 'or
  2015. then
  2016. << phi := cdr phi;
  2017. if !*dqeverbose then
  2018. <<
  2019. n := length(phi);
  2020. prin2 "++ die anzahl der konjunktionen ist "; prin2t n;
  2021. erg := dqe_elimberechnung(phi);
  2022. prin2 "++die gesamte anzahl der atomaren formeln ist ";
  2023. prin2t car erg;
  2024. prin2 "++der ";prin2 cadr erg;
  2025. prin2t "_te disjunktionsglied hat die hoechste";
  2026. prin2 "++ anzahl von atomaren formeln und zwar ";
  2027. prin2t caddr erg;
  2028. >>;
  2029. while phi do
  2030. << hilf := car phi; k := k + 1;
  2031. if !*dqeverbose then
  2032. <<
  2033. prin2 "++elimination des quantors ex ";
  2034. prin2 var; prin2 " vor dem ";
  2035. prin2 k;prin2t "-ten konjunktionsglied ";
  2036. mathprint hilf;
  2037. >>;
  2038. timevar := time();
  2039. gctimevar := gctime();
  2040. hilf := dqe_elim(hilf,diffequaliste,var);
  2041. if !*dqeverbose then
  2042. <<
  2043. timevar := time() - timevar;
  2044. gctimevar := gctime() -gctimevar;
  2045. prin2 "++die aequivalaente zum ";
  2046. prin2 k;prin2t "-ten konjunktionsglied ist : ";
  2047. mathprint hilf;
  2048. prin2 timevar;prin2" ms plus ";
  2049. prin2 gctimevar;prin2t " ms."
  2050. >>;
  2051. ausg := dqe_modcons(hilf,ausg);
  2052. phi := cdr phi >>;
  2053. if length(ausg) = 1 then ausg := car ausg
  2054. else
  2055. if cdr ausg
  2056. then ausg := cons('or,ausg) >>
  2057. else ausg := dqe_elim(phi,diffequaliste,var);
  2058. return ausg;
  2059. end;
  2060. %%%%%%%%%%%%% dqe_allqelim %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2061. % %
  2062. % allqelim ist eine subroutine fuer die prozedur quantelim %
  2063. % (siehe abschnitt 5.3 in kapitel 5). %
  2064. % %
  2065. % eingabe : eine positive quantorenfreie formel phi, eine ge- %
  2066. % bundene variable var und diffequaliste . %
  2067. % %
  2068. % ausgabe : eine positive quantorenfreie formel phi',die %
  2069. % aequivalent zu all var phi ist . %
  2070. % %
  2071. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2072. symbolic procedure dqe_allqelim(phi,diffequaliste,var);
  2073. begin scalar hilf,ausgb,k,n,timevar,gctimevar,erg;
  2074. ausgb := nil;n := 0; k := 0;
  2075. if !*dqeverbose
  2076. then
  2077. <<
  2078. prin2t "++nun wird ein allquantor eliminiert, also muss zuerst ";
  2079. prin2t "++die formel in konjunktive normalform transformiert werden. ";
  2080. prin2t "++die konjunktive normalform von ";
  2081. mathprint phi;prin2t "ist :";
  2082. >>;
  2083. timevar := time();
  2084. gctimevar := gctime();
  2085. phi := dqe_konjnf(phi);
  2086. if !*dqeverbose
  2087. then
  2088. <<
  2089. timevar := time() - timevar;
  2090. gctimevar := gctime() - gctimevar;
  2091. mathprint phi;
  2092. prin2 timevar;prin2" ms plus ";prin2 gctimevar;prin2t " ms."
  2093. >>;
  2094. if (phi = t) or (not phi)
  2095. then ausgb := phi
  2096. else
  2097. if car phi = 'and
  2098. then
  2099. <<phi := cdr phi;
  2100. n := length(phi);
  2101. if !*dqeverbose then
  2102. <<
  2103. prin2 "++die anzahl der disjunktionen ist "; prin2t n;
  2104. erg := dqe_elimberechnung(phi);
  2105. prin2 "++die gesamte anzahl der atomaren formeln ist ";
  2106. prin2t car erg;
  2107. prin2 "++der ";prin2 cadr erg;
  2108. prin2t "_te disjunktionsglied hat die hoechste";
  2109. prin2 " anzahl von atomaren formeln und zwar ";prin2t caddr erg;
  2110. >>;
  2111. while phi do
  2112. <<hilf := car phi;k := k + 1;
  2113. if !*dqeverbose then
  2114. <<
  2115. prin2 "++elimination des quantors all ";
  2116. prin2 var; prin2 " vor dem ";
  2117. prin2 k;prin2t "-ten disjunktionsglied ";
  2118. mathprint hilf;
  2119. >>;
  2120. timevar := time();
  2121. gctimevar := gctime();
  2122. hilf := dqe_makepositive list('nott,hilf);
  2123. hilf := dqe_elim(hilf,diffequaliste,var);
  2124. hilf := dqe_makepositive list('nott,hilf);
  2125. if !*dqeverbose then
  2126. <<
  2127. timevar := time() - timevar;
  2128. gctimevar := gctime() - gctimevar;
  2129. prin2 "++die aequivalaente zum ";
  2130. prin2 k;prin2t "-ten disjunktionsglied ist : ";
  2131. mathprint hilf;
  2132. prin2 timevar;prin2" ms plus ";
  2133. prin2 gctimevar;prin2t " ms."
  2134. >>;
  2135. ausgb := dqe_modcons(hilf,ausgb);
  2136. phi := cdr phi >>;
  2137. if length(ausgb) = 1
  2138. then ausgb := car ausgb
  2139. else
  2140. if cdr ausgb
  2141. then ausgb := cons('and,ausgb) >>
  2142. else
  2143. << phi := dqe_makepositive list('nott,phi);
  2144. ausgb := dqe_elim(phi,diffequaliste,var) ;
  2145. ausgb := dqe_makepositive list('nott,ausgb) >>;
  2146. return ausgb;
  2147. end;
  2148. %%%%%%%%%%%%%%%%%% dqe_quantelim %%%%%%%%%%%%%%%%%%%%%%%%%%%
  2149. % %
  2150. % quantelim ist die hauptprozedur fuer quantorenelimination %
  2151. % (siehe abschnitt 5.4 des kapitels 5). %
  2152. % %
  2153. % eingabe : eine beliebige formel phi . %
  2154. % ausgabe : eine positive quantorenfreie formel phi', die %
  2155. % aequivalent zu phi ist. %
  2156. % %
  2157. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2158. symbolic procedure dqe_quantelim(phi,diffequaliste);
  2159. begin scalar hilf,liste,var,erg,quant,n,k,timevar,gctimevar;
  2160. liste := nil;
  2161. erg := nil;
  2162. n := 0;
  2163. timevar := time();
  2164. gctimevar := gctime();
  2165. phi := dqe_makepositive phi;
  2166. if not dqe_isprenexp phi
  2167. then
  2168. << if not diffequaliste
  2169. then phi := dqe_makeprenex phi
  2170. else << hilf := dqe_makeprenexmod(phi,diffequaliste);
  2171. phi := car hilf;
  2172. diffequaliste := cadr hilf >> >>;
  2173. if !*dqeverbose then
  2174. <<
  2175. timevar := time() - timevar;
  2176. gctimevar := gctime() - gctimevar;
  2177. prin2t "+++die praenexe form der eingabeformel ist";
  2178. mathprint phi;
  2179. prin2 timevar;prin2" ms plus ";prin2 gctimevar;prin2t " ms.";
  2180. >>;
  2181. while car phi = 'ex or car phi = 'all do
  2182. << hilf := list(car phi,cadr phi);
  2183. liste := cons(hilf,liste);
  2184. n := n + 1;
  2185. phi := caddr phi >>;
  2186. if !*dqeverbose then
  2187. <<
  2188. prin2t "+++die matrix der eingabeformel ist";
  2189. mathprint phi;
  2190. >>;
  2191. erg := phi;
  2192. if !*dqeverbose then
  2193. <<
  2194. prin2 "+++die anzahl der quantoren ist ";mathprint n;
  2195. >>;
  2196. if n = 0 then
  2197. <<
  2198. if !*dqeverbose then
  2199. prin2t "+++die eingabeformel ist quantorenfrei" >>
  2200. else
  2201. if n = 1
  2202. then
  2203. << hilf := car liste;
  2204. liste := cdr liste;
  2205. quant := car hilf;
  2206. var := cadr hilf;
  2207. if !*dqeverbose then
  2208. <<
  2209. prin2 "+++es gibt nur den quantor ";
  2210. prin2 quant;prin2 ",";prin2 var;
  2211. prin2t " zu eliminieren.";
  2212. >>;
  2213. if quant = 'ex
  2214. then erg := dqe_exqelim(erg,diffequaliste,var)
  2215. else erg := dqe_allqelim(erg,diffequaliste,var)
  2216. >>
  2217. else
  2218. << k := 0;
  2219. if !*dqeverbose then
  2220. <<
  2221. prin2 "es gibt ";prin2 n;
  2222. prin2t " quantoren zu eliminieren.";
  2223. >>;
  2224. while liste do
  2225. << hilf := car liste;
  2226. liste := cdr liste;
  2227. quant := car hilf;
  2228. var := cadr hilf;
  2229. k := k + 1;
  2230. if !*dqeverbose then
  2231. <<
  2232. prin2 " elimination des "; prin2 k;prin2 "-ten quantors ";
  2233. prin2 quant; prin2t var
  2234. >>;
  2235. timevar := time();
  2236. gctimevar := gctime();
  2237. if quant = 'ex
  2238. then erg := dqe_exqelim(erg,diffequaliste,var)
  2239. else erg := dqe_allqelim(erg,diffequaliste,var);
  2240. if !*dqeverbose then
  2241. <<
  2242. timevar := time() - timevar;
  2243. gctimevar := gctime() - gctimevar;
  2244. prin2 "nach der elimination des ";
  2245. prin2 k;prin2t "-ten quantors";
  2246. prin2t "sieht die quantorenfreie formel, wie folgt, aus: ";
  2247. mathprint erg;
  2248. prin2 timevar;prin2" ms plus ";
  2249. prin2 gctimevar;prin2t " ms.";
  2250. >>;
  2251. >> >>;
  2252. if !*dqeverbose then
  2253. prin2t "+++die aequivalaente quantorenfreie formel ist+++: ";
  2254. return erg;
  2255. end;
  2256. %%%%%%%%%%%%%%%%%% dqe_elimopt %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2257. % %
  2258. % elimopt ist eine subroutine der prozeduren exqelimopt und %
  2259. % allqelimopt. sie arbeitet wie elim aber sie verwendet die %
  2260. % hilfsprozedur simplify (siehe abschnitt 5.5 des kapitels 5).%
  2261. % %
  2262. % eingabe : eine positive quantorenfreie teilformel phi , %
  2263. % eine gebundene variable var und diffequaliste . %
  2264. % %
  2265. % ausgabe : eine vereinfachte positive quantorenfreie formel %
  2266. % phi', die aequivalen zu ex var phi ist . %
  2267. % %
  2268. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2269. symbolic procedure dqe_elimopt(phi,diffequaliste,var);
  2270. begin scalar nf;
  2271. if !*dqegradord and !*dqeverbose then
  2272. prin2t "++++";
  2273. nf := dqe_helpelim phi;
  2274. if (nf = t) or (not nf) then
  2275. return nf;
  2276. if not cdr nf then
  2277. return dqe_elimopt!-neq(nf,diffequaliste,var);
  2278. if car nf = 1 and not cddr nf then
  2279. return dqe_elimopt!-oneeq(nf,diffequaliste,var);
  2280. return dqe_elimopt!-regular(nf,diffequaliste,var)
  2281. end;
  2282. procedure dqe_elimopt!-neq(phi,diffequaliste,var);
  2283. begin scalar res,prod,ordg,gradg;
  2284. prod := car phi;
  2285. if !*dqegradord and !*dqeverbose then <<
  2286. ordg := dqe_ord(prod,var);
  2287. gradg := dqe_grad(prod,var);
  2288. prin2t "()";
  2289. prin2t {ordg,gradg};
  2290. >>;
  2291. res := dqe_neqnullfkt dqe_termcoefkt(prod,var);
  2292. res := dqe_simplify res
  2293. return res
  2294. end;
  2295. procedure dqe_elimopt!-oneeq(phi,diffequaliste,var);
  2296. begin scalar equ,ordf,gradf,erg,res;
  2297. equ := cadr phi;
  2298. if !*dqegradord and !*dqeverbose then <<
  2299. ordf := dqe_ord(equ,var);
  2300. gradf := dqe_grad(equ,var);
  2301. prin2t list(ordf,gradf);
  2302. prin2t "()";
  2303. >>;
  2304. erg := dqe_termcoefkt( equ,var);
  2305. equ := dqe_simplify {'equal,reval car erg,0}; % Warning: Must return eq
  2306. if equ = T then
  2307. return T;
  2308. erg := cdr erg;
  2309. erg := dqe_neqnullfkt erg ;
  2310. res := dqe_andorvaleur {'or,equ,erg};
  2311. res := dqe_simplify res;
  2312. return res
  2313. end;
  2314. procedure dqe_elimopt!-regular(phi,diffequaliste,var);
  2315. begin scalar g,eqs;
  2316. g := car phi;
  2317. eqs := cdr phi;
  2318. if (dqe_isconstant g) and not(g = 0) then
  2319. g := 1;
  2320. if not cdr eqs then
  2321. return dqe_elimopt!-regular!-oneeq(g,eqs,diffequaliste,var);
  2322. return dqe_elimopt!-regular1(g,eqs,diffequaliste,var);
  2323. end;
  2324. procedure dqe_elimopt!-regular1(g,eqs,diffequaliste,var);
  2325. begin scalar eqs,hilf,ordhilf,erg1,erg2,ausg,zwerg,phi1,hilfvar,phi2,rest;
  2326. scalar hilff,g,ghilf,gradg,ordf,ordg,redf,initf,const;
  2327. scalar erg,weiter;
  2328. scalar liste, helplist,phi;
  2329. ordg := dqe_ord(g,var);
  2330. gradg := dqe_grad(g,var);
  2331. phi := dqe_elimsimplify(eqs,zwerg,var);
  2332. zwerg := car phi; phi := cadr phi;
  2333. if not zwerg then
  2334. weiter := t
  2335. else <<
  2336. if not cdr zwerg then
  2337. zwerg := dqe_simplify car zwerg
  2338. else
  2339. zwerg := dqe_simplify zwerg;
  2340. if zwerg = nil then
  2341. weiter := nil
  2342. else weiter := t
  2343. >>;
  2344. if weiter = nil then
  2345. ausg := nil
  2346. else <<
  2347. if not phi then <<
  2348. if !*dqegradord and !*dqeverbose then <<
  2349. prin2t "()";
  2350. prin2t list(ordg,gradg)
  2351. >>;
  2352. erg := dqe_neqnullfkt(dqe_termcoefkt( g,var));
  2353. if zwerg = t then
  2354. ausg := erg
  2355. else ausg := dqe_andorvaleur(
  2356. list('and,erg,zwerg));
  2357. ausg := dqe_simplify ausg
  2358. >> else if not cdr phi then <<
  2359. phi := list('and,list('neq,g,0),
  2360. list('equal,car phi,0));
  2361. erg := dqe_elimopt(phi,diffequaliste,var);
  2362. if zwerg = t then
  2363. ausg := erg
  2364. else if erg = t then <<
  2365. if not zwerg then
  2366. ausg := t
  2367. else
  2368. ausg := zwerg
  2369. >> else
  2370. ausg := dqe_andorvaleur(
  2371. list('and,erg,zwerg));
  2372. ausg := dqe_simplify ausg
  2373. >> else <<
  2374. phi := dqe_listenord(phi,var);
  2375. if !*dqegradord and !*dqeverbose then <<
  2376. liste := phi; helplist := nil;
  2377. while liste do <<
  2378. hilf := car liste; liste := cdr liste;
  2379. helplist := cons( list(dqe_ord(hilf,var),
  2380. dqe_grad(hilf,var)),
  2381. helplist)
  2382. >>;
  2383. prin2t helplist;
  2384. prin2t list(ordg,gradg);
  2385. >>;
  2386. hilff := car phi;
  2387. initf := dqe_initial(hilff,var);
  2388. redf := dqe_reduktum(hilff,var);
  2389. ordf := dqe_ord(hilff,var);
  2390. if redf = 0 then
  2391. phi1 := dqe_equalnullfkt(dqe_consm(initf,cdr phi))
  2392. else
  2393. phi1 := dqe_equalnullfkt(dqe_consm(initf,
  2394. dqe_consm(redf,cdr phi)));
  2395. phi1 := cons('and,cons(list('neq,g,0),phi1));
  2396. if dqe_isconstant initf then
  2397. ghilf := g
  2398. else
  2399. ghilf := reval list('times,initf,g);
  2400. hilf := cadr phi;
  2401. ordhilf := dqe_ord(hilf,var);
  2402. if ordhilf = 0 then
  2403. hilfvar := var
  2404. else
  2405. hilfvar := list('d,var,ordhilf);
  2406. if ordhilf = ordf then
  2407. rest := dqe_pseudrest(hilf,hilff,hilfvar)
  2408. else <<
  2409. const := reval list('difference,ordhilf,ordf);
  2410. rest :=dqe_pseudrest(hilf,dqe_diff(hilff,const,
  2411. diffequaliste),hilfvar)
  2412. >>;
  2413. if rest = 0 then
  2414. phi2 := dqe_equalnullfkt(
  2415. dqe_consm(hilff,cddr phi))
  2416. else
  2417. phi2 := dqe_equalnullfkt(dqe_consm(rest,
  2418. dqe_consm(hilff,cddr phi)));
  2419. phi2 := cons('and,cons(list('neq,ghilf,0),phi2));
  2420. erg2 := dqe_elimopt(phi2,diffequaliste,var);
  2421. if erg2 = t then
  2422. erg := t
  2423. else <<
  2424. erg1 := dqe_elimopt(phi1,diffequaliste,var);
  2425. if erg1 = t then
  2426. erg := t
  2427. else
  2428. erg := dqe_andorvaleur(list('or,erg1,erg2))
  2429. >>;
  2430. if zwerg = t then
  2431. ausg := erg
  2432. else if erg = t then <<
  2433. if not zwerg then
  2434. ausg := t
  2435. else
  2436. ausg := zwerg
  2437. >> else
  2438. ausg :=dqe_andorvaleur(list('and,erg,zwerg)) ;
  2439. ausg := dqe_simplify ausg
  2440. >>
  2441. >>;
  2442. return ausg;
  2443. end;
  2444. procedure dqe_elimopt!-regular!-oneeq(g,eqs,diffequaliste,var);
  2445. begin scalar eqs,hilf,erg1,erg2,ausg,phi1,hilfvar;
  2446. scalar hilff,g,ghilf,gradf,gradg,ordf,ordg,redf,initf,const;
  2447. scalar erg21,erg22,phi21,phi22,redhilf,sepf,gghilf;
  2448. ordg := dqe_ord(g,var);
  2449. gradg := dqe_grad(g,var);
  2450. hilff := car eqs;
  2451. gradf := dqe_grad(hilff,var);
  2452. ordf := dqe_ord(hilff,var);
  2453. if !*dqegradord and !*dqeverbose then <<
  2454. prin2t {ordf,gradf};
  2455. prin2t {ordg,gradg};
  2456. >>;
  2457. if gradf = 0 then <<
  2458. erg1 := dqe_simplify list('equal,reval hilff,0);
  2459. if erg1 = nil then
  2460. ausg := nil
  2461. else <<
  2462. erg2 := dqe_neqnullfkt(dqe_termcoefkt( g,var));
  2463. if erg1 = t then
  2464. ausg := erg2
  2465. else
  2466. ausg := dqe_andorvaleur(list('and,erg1,erg2)) ;
  2467. ausg := dqe_simplify ausg
  2468. >>
  2469. >> else <<
  2470. redf := dqe_reduktum(hilff,var);
  2471. initf := dqe_initial(hilff,var);
  2472. if redf = 0 then
  2473. phi1 := list('and,list('neq,g,0)
  2474. , list('equal,initf,0))
  2475. else <<
  2476. phi1 :=dqe_equalnullfkt(dqe_consm(initf,list(redf)));
  2477. phi1 := cons('and,cons(list('neq,g,0),phi1))
  2478. >>;
  2479. if ordf > ordg then <<
  2480. erg21 := dqe_neqnullfkt(
  2481. dqe_termcoefkt(g,var));
  2482. erg22 := dqe_neqnullfkt(
  2483. dqe_termcoefkt(initf,var));
  2484. erg2 := dqe_simplify
  2485. dqe_andorvaleur(list('and,erg21,erg22))
  2486. >> else if ordf = ordg then <<
  2487. if ordf = 0 then
  2488. hilfvar := var
  2489. else
  2490. hilfvar := list('d,var,ordf);
  2491. ghilf :=dqe_pseudrest(list('expt,g,gradf),hilff,
  2492. hilfvar);
  2493. erg21 := dqe_neqnullfkt(dqe_termcoefkt(ghilf,var));
  2494. erg22 := dqe_neqnullfkt(dqe_termcoefkt(initf,var));
  2495. erg2 := dqe_simplify
  2496. dqe_andorvaleur(list('and,erg21,erg22))
  2497. >> else <<
  2498. const := reval list('difference,ordg,ordf);
  2499. hilf := dqe_diff(hilff,const,diffequaliste);
  2500. hilfvar := list('d,var,ordg);
  2501. ghilf := dqe_pseudrest(g,hilf,hilfvar);
  2502. if not(dqe_isconstant initf) then
  2503. ghilf := reval list('times,initf,ghilf);
  2504. phi21 := list('and,list('neq,ghilf,0),
  2505. list('equal,hilff,0));
  2506. erg21 := dqe_elimopt(phi21,diffequaliste,var) ;
  2507. if erg21 = t then
  2508. erg2 := erg21
  2509. else << if dqe_isconstant initf then
  2510. gghilf := g
  2511. else gghilf :=
  2512. reval list('times,initf,g);
  2513. sepf := dqe_separante(hilff,var);
  2514. redhilf := dqe_reduktum(hilf,var);
  2515. phi22 := dqe_consm(list('equal,sepf,0),
  2516. dqe_consm(list('equal,redhilf,0),
  2517. list(list('equal,hilff,0)) ) );
  2518. phi22 := cons('and,cons(list('neq,gghilf,0),
  2519. phi22));
  2520. erg22 := dqe_elimopt(phi22,diffequaliste,var) ;
  2521. erg2 := dqe_andorvaleur(list('or,erg21,erg22))
  2522. >>
  2523. >>;
  2524. if erg2 = t then
  2525. ausg := t
  2526. else <<
  2527. erg1 := dqe_elimopt(phi1,diffequaliste,var);
  2528. if erg1 = t then
  2529. ausg := t
  2530. else
  2531. ausg := dqe_andorvaleur(list('or,erg1,erg2));
  2532. ausg := dqe_simplify ausg >>
  2533. >>;
  2534. return ausg;
  2535. end;
  2536. %%%%%%%%%%%%%%%%% dqe_exqelimopt %%%%%%%%%%%%%%%%%%%%%%%%%%
  2537. % %
  2538. % exqelimopt ist eine subroutine fuer quantelimopt. sie ar- %
  2539. % beitet wie exqelim (siehe abschnitt 5.5). %
  2540. % %
  2541. % eingabe : eine positive quantorenfreie formel phi, eine ge- %
  2542. % junktiver nomalform , eine gebundene variable var %
  2543. % bundene variable var und diffequaliste . %
  2544. % %
  2545. % ausgabe : eine vereinfachte positive quantorenfreie formel %
  2546. % phi', die aequivalent zu ex var phi ist . %
  2547. % %
  2548. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2549. symbolic procedure dqe_exqelimopt(phi,diffequaliste,var);
  2550. begin scalar hilf,erg,testvar,k,n,timevar,gctimevar,ausg;
  2551. erg := nil; testvar := t; n := 0; k := 0;
  2552. if !*dqeverbose
  2553. then
  2554. <<
  2555. prin2t "++nun wird ein existenzquantor eliminiert, also muss zuerst ";
  2556. prin2t "++die formel in disjunktive normalform transformiert werden. ";
  2557. prin2t "++die disjunktive normalform von ";
  2558. mathprint phi; prin2t " ist";
  2559. >>;
  2560. timevar := time();
  2561. gctimevar := gctime();
  2562. phi := dqe_disjnf(phi);
  2563. if !*dqeverbose
  2564. then
  2565. <<
  2566. timevar := time() - timevar;
  2567. gctimevar := gctime() - gctimevar;
  2568. mathprint phi;
  2569. prin2 timevar; prin2 " ms plus ";prin2 gctimevar;prin2t " ms."
  2570. >>;
  2571. if (phi = t) or not(phi) then erg := phi
  2572. else
  2573. if car phi = 'or
  2574. then
  2575. << phi := cdr phi; testvar := t;
  2576. if !*dqeverbose then
  2577. <<
  2578. n := length(phi);
  2579. prin2 "++die anzahl der konjunktionen ist "; prin2t n;
  2580. ausg := dqe_elimberechnung(phi);
  2581. prin2 "++die gesamte anzahl der atomaren formeln ist ";
  2582. prin2t car ausg;
  2583. prin2 "++der ";prin2 cadr ausg;
  2584. prin2t "_te disjunktionsglied hat die
  2585. hoechste";
  2586. prin2 " ++anzahl von atomaren formeln und zwar ";
  2587. prin2t caddr ausg;
  2588. >>;
  2589. while phi and testvar do
  2590. << hilf := car phi; k := k + 1;
  2591. if !*dqeverbose then
  2592. <<
  2593. prin2 "++elimination des quantors ex";prin2 ",";
  2594. prin2 var; prin2 " vor dem ";
  2595. prin2 k; prin2t "-ten konjunktionsglied ";
  2596. mathprint hilf;
  2597. >>;
  2598. timevar := time();
  2599. gctimevar := gctime();
  2600. hilf := dqe_elimopt(hilf,diffequaliste,var);
  2601. if !*dqeverbose then
  2602. <<
  2603. timevar := time() - timevar;
  2604. gctimevar := gctime() - gctimevar;
  2605. prin2 "++ die aequivalaente zum ";
  2606. prin2 k; prin2t "-ten konjunktionsglied ist :";
  2607. mathprint hilf;
  2608. prin2 timevar;prin2 " ms plus ";
  2609. prin2 gctimevar;prin2t " ms."
  2610. >>;
  2611. if hilf = t
  2612. then testvar := nil
  2613. else erg := dqe_consm(hilf,erg);
  2614. phi := cdr phi >>;
  2615. if not(testvar) then erg := t
  2616. else
  2617. if length(erg) = 1 then erg := dqe_simplify car erg
  2618. else
  2619. if cdr erg
  2620. then erg := dqe_simplify
  2621. cons('or,reverse erg) >>
  2622. else erg := dqe_elimopt(phi,diffequaliste,var);
  2623. return erg;
  2624. end;
  2625. %%%%%%%%%%%%%%%%% dqe_allqelimopt %%%%%%%%%%%%%%%%%%%%%%%%%%%
  2626. % %
  2627. % allqelimopt ist eine subroutine fuer quantelimopt. sie ar- %
  2628. % beitet wie allqelim (siehe abschnitt 5.5). %
  2629. % %
  2630. % eingabe : eine positive quantorenfreie formel phi, eine ge- %
  2631. % junktiver nomalform , eine gebundene variable var %
  2632. % bundene variable var und diffequaliste . %
  2633. % %
  2634. % ausgabe : eine vereinfachte positive quantorenfreie formel %
  2635. % phi', die aequivalent zu all var phi ist . %
  2636. % %
  2637. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2638. symbolic procedure dqe_allqelimopt(phi,diffequaliste,var);
  2639. begin scalar hilf,erg,testvar,k,n,timevar,gctimevar,ausg;
  2640. erg := nil; testvar := t; k := 0;
  2641. if !*dqeverbose
  2642. then
  2643. <<
  2644. prin2t "++nun wird ein allquantor eliminiert, also muss zuerst ";
  2645. prin2t "++die formel in konjunktive normalform transformiert werden. ";
  2646. prin2t "++die konjunktive normalform von ";
  2647. mathprint phi;prin2t "ist:"
  2648. >>;
  2649. timevar := time();
  2650. gctimevar := gctime();
  2651. phi := dqe_konjnf(phi);
  2652. if !*dqeverbose
  2653. then
  2654. <<
  2655. timevar := time() - timevar;
  2656. gctimevar := gctime() - gctimevar;
  2657. mathprint phi;
  2658. prin2 timevar; prin2 " ms plus ";prin2 gctimevar;prin2t " ms."
  2659. >>;
  2660. if (phi = t) or not(phi) then erg := phi
  2661. else
  2662. if car phi = 'and
  2663. then
  2664. << phi := cdr phi; k := 0;
  2665. n := length(phi);
  2666. if !*dqeverbose
  2667. then
  2668. <<
  2669. prin2 "++ die anzahl der disjunktionen ist "; prin2t n;
  2670. ausg := dqe_elimberechnung(phi);
  2671. prin2 "++die gesamte anzahl der atomaren formeln ist ";
  2672. prin2t car ausg;
  2673. prin2 "++der ";prin2 cadr ausg;
  2674. prin2t "_te disjunktionsglied hat die hoechste";
  2675. prin2 " anzahl von atomaren formeln und zwar ";
  2676. prin2t caddr ausg;
  2677. >>;
  2678. while phi and testvar do
  2679. <<hilf := car phi; k := k + 1;
  2680. if !*dqeverbose then
  2681. <<
  2682. prin2 "elimination des quantors all ";prin2 ",";
  2683. prin2 var; prin2 " vor dem ";
  2684. prin2 k; prin2t "-ten disjunktionsglied ";
  2685. mathprint hilf;
  2686. >>;
  2687. timevar := time();
  2688. gctimevar := gctime();
  2689. hilf := dqe_makepositive list('nott,car phi);
  2690. hilf := dqe_elimopt(hilf,diffequaliste,var);
  2691. hilf := dqe_makepositive list('nott,hilf);
  2692. if !*dqeverbose then
  2693. <<
  2694. timevar := time() - timevar;
  2695. gctimevar := gctime() - gctimevar;
  2696. prin2 "++ die aequivalaente zum ";
  2697. prin2 k; prin2t "-ten disjunktionsglied ist :";
  2698. mathprint hilf;
  2699. prin2 timevar;prin2 " ms plus ";
  2700. prin2 gctimevar;prin2t " ms."
  2701. >>;
  2702. if hilf = nil
  2703. then testvar := nil
  2704. else erg := dqe_consm(hilf,erg);
  2705. phi := cdr phi >>;
  2706. if not(testvar) then erg := nil
  2707. else
  2708. if length(erg) = 1 then erg := dqe_simplify car erg
  2709. else
  2710. if cdr erg
  2711. then erg := dqe_simplify
  2712. cons('and,reverse erg) >>
  2713. else
  2714. << phi := dqe_makepositive list('nott,phi);
  2715. erg := dqe_elimopt(phi,diffequaliste,var) ;
  2716. erg := dqe_makepositive list('nott,erg) >>;
  2717. return erg;
  2718. end;
  2719. %%%%%%%%%%%%%%%%%%%% dqe_quantelimopt %%%%%%%%%%%%%%%%%%%%%%%%%
  2720. % %
  2721. % quantelimopt ist wie quantelim eine hauptprozedur fuer quant-%
  2722. % orenelimination mit aussagenlogischen vereinfachungen (siehe %
  2723. % abschnitt 5.5 des kapitels 5). %
  2724. % %
  2725. % eingabe : eine beliebige formel phi . %
  2726. % ausgabe : eine vereinfachte positive quantorenfreie formel %
  2727. % phi', die aequivalent zu phi ist. %
  2728. % %
  2729. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2730. symbolic procedure dqe_quantelimopt(phi,diffequaliste);
  2731. begin scalar hilf,liste,var,ausg,quant,weiter,k,n,timevar,gctimevar;
  2732. weiter := t;
  2733. n := 0;
  2734. liste := nil;
  2735. ausg := nil;
  2736. timevar := time();
  2737. gctimevar := gctime();
  2738. phi := dqe_makepositive phi;
  2739. if not dqe_isprenexp phi
  2740. then
  2741. << if not diffequaliste
  2742. then phi := dqe_makeprenex phi
  2743. else << hilf := dqe_makeprenexmod(phi,diffequaliste);
  2744. phi := car hilf;
  2745. diffequaliste := cadr hilf >> >>;
  2746. if !*dqeverbose then
  2747. <<
  2748. timevar := time() - timevar;
  2749. gctimevar := gctime() - gctimevar;
  2750. prin2t "+++die praenexe form der eingabeformel ist";
  2751. mathprint phi;
  2752. prin2 timevar;prin2" ms plus ";
  2753. prin2 gctimevar;prin2t " ms.";
  2754. >>;
  2755. while car phi = 'ex or car phi = 'all do
  2756. << hilf := list(car phi,cadr phi);
  2757. liste := cons(hilf,liste);
  2758. n := n + 1;
  2759. phi := caddr phi >>;
  2760. if !*dqeverbose then
  2761. <<
  2762. prin2t "+++die matrix der eingabeformel ist";
  2763. mathprint phi;
  2764. >>;
  2765. ausg := phi;
  2766. if !*dqeverbose then
  2767. << prin2 "+++die anzahl der quantoren ist ";mathprint n >>;
  2768. if n = 0 then
  2769. <<
  2770. if !*dqeverbose then
  2771. prin2t "+++die eingabeformel ist quantorenfrei" >>
  2772. else
  2773. if n = 1 then
  2774. << hilf := car liste;
  2775. liste := cdr liste;
  2776. quant := car hilf;
  2777. var := cadr hilf;
  2778. if !*dqeverbose then
  2779. <<
  2780. prin2 "+++es gibt nur den quantor ";
  2781. prin2 quant;prin2",";prin2 var;
  2782. prin2t " zu eliminieren.";
  2783. >>;
  2784. if quant = 'ex
  2785. then ausg := dqe_exqelimopt(ausg,diffequaliste,var)
  2786. else ausg := dqe_allqelimopt(ausg,diffequaliste,var) ;
  2787. >>
  2788. else
  2789. << k := 0;
  2790. if !*dqeverbose then
  2791. <<
  2792. prin2 "+++es gibt ";prin2 n;
  2793. prin2t " quantoren zu eliminieren.";
  2794. >>;
  2795. while liste and weiter do
  2796. << hilf := car liste;
  2797. liste := cdr liste;
  2798. quant := car hilf;
  2799. var := cadr hilf;
  2800. k := k + 1;
  2801. if !*dqeverbose
  2802. then
  2803. <<
  2804. prin2 " elimination des ";
  2805. prin2 k;prin2 "-ten quantors ";
  2806. prin2 quant; prin2t var ;
  2807. >>;
  2808. timevar := time();
  2809. gctimevar := gctime();
  2810. if quant = 'ex
  2811. then ausg := dqe_exqelimopt(ausg,diffequaliste,var)
  2812. else ausg := dqe_allqelimopt(ausg,diffequaliste,var);
  2813. if !*dqeverbose then
  2814. <<
  2815. timevar := time() - timevar;
  2816. gctimevar := gctime() - gctimevar;
  2817. prin2 "+++nach der elimination des ";
  2818. prin2 k;prin2t "-ten quantors";
  2819. prin2t "sieht die quantorenfreie formel, wie folgt, aus: ";
  2820. mathprint ausg;
  2821. prin2 timevar;prin2" ms plus ";
  2822. prin2 gctimevar;prin2t " ms.";
  2823. >>;
  2824. if (ausg = t) or not(ausg)
  2825. then weiter := nil >> >>;
  2826. if !*dqeverbose then
  2827. prin2t "+++die aequivalaente vereinfachte quantorenfreie formel ist: ";
  2828. return ausg;
  2829. end;
  2830. % part 6
  2831. %%%%%%%%%%%%%%% dqe_elimberechnung %%%%%%%%%%%%%%%%%%%%%%%%%%%
  2832. % %
  2833. % diese prozedur berechnet die anzahl der atomaren formeln in %
  2834. % einer positiven quantorenfreien formel, die in disjunktiver %
  2835. % bzw. konjunktiver normalform ist. ausserdem bestimmt sie %
  2836. % den laengesten konjunktions- bzw. disjunktionsglied. %
  2837. % %
  2838. % eingabe: eine positive quantorenfreie formel phi, die in dis- %
  2839. % junktiver bzw. konjunktiver normalform ist. %
  2840. % %
  2841. % ausgabe: eine liste,die aus erg1, erg2 und erg3 besteht. %
  2842. % erg1 ist anzahl der atomaren formeln in phi. %
  2843. % erg2 ist der index des in phi vorkommenden laengen %
  2844. % gliedes und erg3 ist die anzahl der atomaren formeln %
  2845. % dieses gliedes. %
  2846. % sie wird von ex- bzw. allqelim und ex- bzw. allqelimopt %
  2847. % aufgerufen. %
  2848. % %
  2849. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2850. symbolic procedure dqe_elimberechnung(phi);
  2851. begin scalar erg,erg1,erg2,erg3,hilf,k;
  2852. if phi = t or not phi
  2853. or dqe_isatomarp(phi)
  2854. then
  2855. << erg1 := 1; erg2 := 1; erg3 := 1>>
  2856. else
  2857. << erg1 := 0; erg2 := 0; erg3 := 0; k := 0;
  2858. phi := cdr phi;
  2859. while phi do
  2860. << k := k + 1;
  2861. hilf := car phi; phi := cdr phi;
  2862. hilf := dqe_elimberechnung(hilf);
  2863. erg1 := erg1 + car hilf;
  2864. if car hilf > erg3
  2865. then
  2866. << erg2 := k; erg3 := car hilf>> >> >>;
  2867. erg := list(erg1,erg2,erg3);
  2868. return erg;
  2869. end;
  2870. %%%%%%%%%%%%% dqe_helpsimplify %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2871. % %
  2872. % dqe_helpsimplify ist eine hilfsprozedur fuer dqe_simplify. %
  2873. % sie transformiert jede positive quantorenfreie formel zuerst %
  2874. % in disjuntive normalform. dann fuehrt sie die folgende ver- %
  2875. % einfachungen durch : %
  2876. % 1 fall : die formel von der form (a = 0 and ... and a neq 0) %
  2877. % wird zu false vereinfacht. %
  2878. % %
  2879. % 2 fall : die formel von der form (a = 0 or ... or a neq 0) %
  2880. % wird zu true vereinfacht. %
  2881. % %
  2882. % 3 fall : die formel von der form (phi and a = 0) or ... or psi%
  2883. % or (phi and a neq 0) wird mit hilfe der prozedur %
  2884. % dqe_logsimp zu phi or ... or psi vereinfacht. %
  2885. % 4 fall : die formel von der form (phi and a = 0) or ... or psi%
  2886. % or a = 0 wird zu a = 0 or ...or psi (analog fuer %
  2887. % a neq 0) vereinfacht. %
  2888. % sie wird von simplify aufgerufen. %
  2889. % %
  2890. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2891. symbolic procedure dqe_helpsimplify(phi);
  2892. begin scalar ausg,hilf,hilfphi,liste1,liste2,weiter;
  2893. scalar aliste,kliste;
  2894. ausg := nil;
  2895. if phi = t or not phi or dqe_isatomarp(phi)
  2896. then ausg := phi
  2897. else
  2898. << phi := dqe_disjnf(phi);
  2899. if car phi = 'and
  2900. then
  2901. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2902. % hier wird a = 0 and ... and a neq 0 zu fasle vereinfacht%
  2903. % phi wird in zwei listen aufgeteilt. liste2 enthaelt die %
  2904. % atomare formeln mit gleichung und liste1 enthaelt die %
  2905. % atom. formeln mit ungl. . falls ein element der liste1 %
  2906. % aus der liste2 ist, dann ist die ausgabe nil. sonst phi.%
  2907. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2908. << hilfphi := cdr phi; liste1 := nil; liste2 := nil;
  2909. while hilfphi do
  2910. << hilf := car hilfphi; hilfphi := cdr hilfphi;
  2911. if car hilf = 'neq
  2912. then liste1 := dqe_consm(hilf,liste1)
  2913. else liste2 := dqe_consm(hilf,liste2) >>;
  2914. weiter := t;
  2915. while liste1 and weiter do
  2916. << hilf := car liste1; liste1 := cdr liste1;
  2917. hilf := dqe_makepositive list('nott,hilf);
  2918. if hilf member liste2
  2919. then weiter := nil >>;
  2920. if not weiter
  2921. then ausg := nil
  2922. else ausg := phi >>
  2923. else
  2924. << hilfphi := cdr phi; weiter := t; aliste := nil;
  2925. kliste := nil;
  2926. while hilfphi and weiter do
  2927. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2928. % hier wird phi in zwei listen aufgeteilt. %
  2929. % aliste enthaelt nur die atomaren formeln. %
  2930. % kliste enthaelt die konjunktionen. %
  2931. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2932. << hilf := car hilfphi; hilfphi := cdr hilfphi;
  2933. hilf := dqe_helpsimplify(hilf);
  2934. if hilf = t then weiter := nil
  2935. else
  2936. if dqe_isatomarp hilf
  2937. then aliste := dqe_modcons(hilf,aliste)
  2938. else
  2939. if hilf
  2940. then kliste := dqe_modcons(hilf,kliste)>>;
  2941. if kliste
  2942. then
  2943. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2944. % hier wird a = 0 or psi and a = 0 zu psi vereinfacht. %
  2945. % falls ein element der aliste in einem element der kliste%
  2946. % vorkommt,dann wird dieses element aus der aliste enfernt%
  2947. % statt a = 0 and psi nur psi kommt in kliste. %
  2948. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2949. <<liste1 := aliste;
  2950. while liste1 do
  2951. <<liste2 := kliste;
  2952. hilf := car liste1;liste1 := cdr liste1;
  2953. while liste2 do
  2954. << if hilf member car liste2
  2955. then kliste := dqe_sanselem(car liste2,
  2956. kliste);
  2957. liste2 := cdr liste2 >> >> >>;
  2958. if not weiter then ausg := t
  2959. else
  2960. << hilfphi := aliste;
  2961. if length(aliste) = 1
  2962. then aliste := car aliste
  2963. else
  2964. if aliste
  2965. then aliste := cons('or,aliste);
  2966. liste1 := nil; liste2 := nil;
  2967. while hilfphi do
  2968. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2969. % hier wird a = 0 or ... or a neq 0 zu true vereinfacht.%
  2970. % hilfphi wird in zwei listen aufgeteilt. liste2 enthaelt %
  2971. % atomare formeln mit gleichung und liste1 enthaelt die %
  2972. % atom. formeln mit ungl. . falls ein element der liste1 %
  2973. % aus der liste2 ist,dann ist die ausgabe t. sonst hilfphi%
  2974. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2975. <<hilf := car hilfphi; hilfphi := cdr hilfphi;
  2976. if car hilf = 'neq
  2977. then liste1 := dqe_consm(hilf,liste1)
  2978. else liste2 := dqe_consm(hilf,liste2) >>;
  2979. weiter := t;
  2980. while liste1 and weiter do
  2981. <<hilf := car liste1; liste1 := cdr liste1;
  2982. hilf := dqe_makepositive list('nott,hilf);
  2983. if hilf member liste2
  2984. then weiter := nil >>;
  2985. if not weiter then ausg := t
  2986. else
  2987. if not kliste
  2988. then ausg := aliste
  2989. else
  2990. if not cdr kliste
  2991. then ausg := dqe_andorvaleur list('or,
  2992. aliste,car kliste)
  2993. else
  2994. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2995. % mit hilfe deq_logsimp wird a = 0 and psi or a neq 0 and %
  2996. % psi zu psi vereinfacht. %
  2997. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  2998. << hilfphi := dqe_logsimp(kliste);
  2999. if not hilfphi
  3000. then ausg := aliste
  3001. else
  3002. if dqe_isatomarp hilfphi
  3003. then
  3004. << if not aliste
  3005. then ausg := hilfphi
  3006. else
  3007. <<if dqe_isatomarp aliste
  3008. then ausg := list('or,
  3009. aliste,hilfphi)
  3010. else ausg := dqe_modcons
  3011. (hilfphi,aliste);
  3012. ausg := dqe_helpsimplify(phi) >>>>
  3013. else
  3014. if car hilfphi ='and
  3015. then ausg := dqe_andorvaleur list('or,
  3016. aliste,hilfphi)
  3017. else
  3018. <<ausg := dqe_andorvaleur list('or,
  3019. aliste,hilfphi);
  3020. if not(cdr hilfphi = kliste)
  3021. then ausg := dqe_helpsimplify(ausg)
  3022. >>
  3023. >> >> >> >>;
  3024. return ausg;
  3025. end;
  3026. %%%%%%%%%%%%%%% dqe_logsimp %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3027. % %
  3028. % dqe_logsimp ist eine hilfsprozedur von dqe_helpsimplify. mit %
  3029. % hilfe dieser prozedur wird jede positive quantorenfreie formel%
  3030. % von der form (phi and a = 0) or... or psi or (phi and a neq 0)%
  3031. % zu phi or ... or psi vereinfacht. %
  3032. % %
  3033. % eingabe : eine liste von konjunktionen. %
  3034. % %
  3035. % ausgabe : eine liste von konjunktionen mit oben beschriebenen %
  3036. % vereinfachung. %
  3037. % %
  3038. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3039. symbolic procedure dqe_logsimp(phi);
  3040. begin scalar konjlist,erg,hilf,aliste,liste,weiter,hilfphi;
  3041. scalar constant,hilff;
  3042. erg := nil; liste := nil;
  3043. hilfphi := phi;
  3044. while hilfphi do
  3045. << konjlist := cdar hilfphi;constant := car hilfphi;
  3046. hilfphi := cdr hilfphi;
  3047. liste := hilfphi;
  3048. aliste := nil;
  3049. while konjlist do
  3050. << hilf := car konjlist; konjlist := cdr konjlist;
  3051. hilff := dqe_makepositive list('nott,hilf);
  3052. weiter := t;
  3053. while liste and weiter do
  3054. << if hilff member car liste
  3055. and
  3056. dqe_listequal( dqe_sanselem(car liste,hilff),
  3057. dqe_sanselem(constant,hilf) )
  3058. then weiter := nil
  3059. else liste := cdr liste >>;
  3060. if weiter
  3061. then
  3062. aliste := dqe_consm(hilf,aliste)
  3063. else
  3064. hilfphi := dqe_sanselem(hilfphi,car liste) ;
  3065. liste := hilfphi >>;
  3066. if length aliste = 1
  3067. then erg := dqe_consm(car aliste,erg)
  3068. else
  3069. if aliste
  3070. then erg := dqe_consm(cons('and,reverse aliste),erg) >>;
  3071. if length erg = 1 then erg := car erg
  3072. else
  3073. if erg then erg := cons('or,reverse erg);
  3074. return erg;
  3075. end;
  3076. %%%%%%%%%%%%%%% dqe_listequal %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3077. % %
  3078. % dqe_listequal testet ob zwei listen die selben elemente haben.%
  3079. % %
  3080. % eingabe : zwei listen. %
  3081. % %
  3082. % ausgabe : true falls diese listen dieselbe menge darstellen %
  3083. % false sonst %
  3084. % %
  3085. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3086. symbolic procedure dqe_listequal(phi,psi);
  3087. begin scalar ausg,weiter;
  3088. ausg := nil; weiter := t;
  3089. if not(length phi = length psi)
  3090. then ausg := nil
  3091. else
  3092. << while phi and weiter do
  3093. << if car phi member psi
  3094. then phi := cdr phi
  3095. else weiter := nil >>;
  3096. if weiter then ausg := t
  3097. else ausg := nil >>;
  3098. return ausg;
  3099. end;
  3100. %%%%%%%%%%%%%%% dqe_vorkommen %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3101. % %
  3102. % dqe_vorkommen berechnet,wie oft die atomare formel der form %
  3103. % (elem = 0) oder not(elem = 0) in einer positiven quantoren- %
  3104. % quantorenfreien formel phi vorkommt. %
  3105. % (siehe abschnitt 6.1 des kapitels 6) %
  3106. % %
  3107. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3108. symbolic procedure dqe_vorkommen(elem,phi);
  3109. begin scalar erg,hilf;
  3110. if phi = t or not phi then erg := 0
  3111. else
  3112. if car phi = 'neq or car phi = 'equal
  3113. then
  3114. << if cadr phi = elem then erg := 1
  3115. else erg := 0>>
  3116. else
  3117. << phi := cdr phi;
  3118. while phi do
  3119. << hilf := dqe_vorkommen(elem,car phi);
  3120. erg := erg + hilf;
  3121. phi := cdr phi >> >>;
  3122. return erg;
  3123. end;
  3124. %%%%%%%%%%%%% dqe_laengefkt %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3125. % %
  3126. % dqe_laengefkt bestimmt die anzahl der atomaren formeln einer %
  3127. % positiven quantorenfreien formel phi. %
  3128. % (siehe abschnitt 6.1 des kapitels 6) %
  3129. % %
  3130. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3131. symbolic procedure dqe_laengefkt(phi);
  3132. begin scalar erg,hilf;
  3133. erg := 0;
  3134. if phi = t or not phi then erg := 0
  3135. else
  3136. if car phi = 'equal or car phi = 'neq
  3137. then erg := 1
  3138. else
  3139. << phi := cdr phi;
  3140. while phi do
  3141. << hilf := dqe_laengefkt(car phi);
  3142. erg := erg + hilf;
  3143. phi := cdr phi >> >>;
  3144. return erg;
  3145. end;
  3146. %%%%%%%%%%%%%%% dqe_specneq %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3147. % %
  3148. % dqe_specneq ist eine hilfsprozedur von dqe_tableau. %
  3149. % (siehe abschnitt 6.1 des kapitels 6) %
  3150. % %
  3151. % eingabe : eine positive quantorenfreie formel phi und elem. %
  3152. % ausgabe : phi', wobei phi' aus phi entsteht, indem ueberall %
  3153. % elem = 0 durch false ersetzt wird und %
  3154. % not(elem = 0) durch true ersetzt wird und %
  3155. % durch simplify vereinfacht wird. %
  3156. % %
  3157. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3158. symbolic procedure dqe_specneq(phi,elem);
  3159. begin scalar erg;
  3160. erg := dqe_simplify subst(t,list('neq,elem,0),
  3161. subst(nil,list('equal,elem,0),phi));
  3162. return erg;
  3163. end;
  3164. %%%%%%%%%%%%% dqe_specequal %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3165. % %
  3166. % dqe_specequal ist eine hilfsprozedur von dqe_tableau. %
  3167. % (siehe abschnitt 6.1 des kapitels 6) %
  3168. % %
  3169. % eingabe : eine positive quantorenfreie formel phi und elem. %
  3170. % ausgabe : phi', wobei phi' aus phi entsteht, indem ueberall %
  3171. % elem = 0 durch true ersetzt wird und %
  3172. % not(elem = 0) durch false ersetzt wird und mit hilfe%
  3173. % simplify vereinfacht wird. %
  3174. % %
  3175. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3176. symbolic procedure dqe_specequal(phi,elem);
  3177. begin scalar erg;
  3178. erg := dqe_simplify subst(t,list('equal,elem,0),
  3179. subst(nil,list('neq,elem,0),phi));
  3180. return erg;
  3181. end;
  3182. %%%%%%%%%%%%%%% dqe_tableau %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3183. % %
  3184. % dqe_tableau berechnet die tableau-methode fuer elem in der po-%
  3185. % tiven quantorenfreien formel phi. diese methode wurde in %
  3186. % abschnitt 6.1 des kapitels 6 dargestellt. %
  3187. % %
  3188. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3189. symbolic procedure dqe_tableau(phi,elem);
  3190. begin scalar erg;
  3191. erg := dqe_simplify(list('or,
  3192. list('and,list('equal,elem,0),dqe_specequal(phi,elem)),
  3193. list('and,list('neq,elem,0),dqe_specneq(phi,elem)) ));
  3194. if erg = list('or,list('equal,elem,0),list('neq,elem,0))
  3195. then erg := t;
  3196. return erg;
  3197. end;
  3198. %%%%%%%%%%% dqe_ltableau %%%%%%%%%%%%%%%%%%%%%%%%%%%
  3199. % %
  3200. % dqe_ltableau berechnet mehrere tableau-schritte. sie wurde in %
  3201. % abschnitt 6.1 spezifiziert. sie verwendet die obige prozedur %
  3202. % dqe_tableau. %
  3203. % %
  3204. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3205. symbolic procedure dqe_ltableau(phi,varliste);
  3206. begin scalar erg,elem;
  3207. erg := phi;
  3208. while varliste do
  3209. << elem := car varliste;
  3210. varliste := cdr varliste;
  3211. erg := dqe_tableau(erg,elem)>>;
  3212. return erg;
  3213. end;
  3214. %%%%%%%%%%%%%%% dqe_dknfsimplify %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3215. % %
  3216. % dqe_dknfsimplify vereinfacht eine positive quantorenfreie formel, %
  3217. % die in disjunktiver bzw. konjunktiver normal form ist . %
  3218. % dqe_dknfsimplify verwendet die hilfsprozedur dqe_permutationfkt. %
  3219. % (siehe abschnitt 6.2 des kapitels 6) %
  3220. % %
  3221. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3222. symbolic procedure dqe_dknfsimplify(phi);
  3223. begin scalar erg,hilf,hilff,liste,weiter,symb;
  3224. erg := nil;
  3225. if (phi = t) or (not phi)
  3226. or dqe_isatomarp(phi)
  3227. then erg := phi
  3228. else
  3229. << symb := car phi;
  3230. phi := cdr phi;
  3231. while phi do
  3232. << hilf := car phi ; phi := cdr phi;
  3233. if (hilf = t) or (not hilf)
  3234. or dqe_isatomarp(hilf)
  3235. then erg := dqe_modcons(hilf,erg)
  3236. else
  3237. << liste := list(cadr hilf);
  3238. hilff := cddr hilf;
  3239. while hilff do
  3240. << liste := dqe_consm(car hilff,liste);
  3241. hilff := cdr hilff >>;
  3242. if length(liste) = 1
  3243. then erg := dqe_modcons(car liste,erg)
  3244. else
  3245. <<hilf := cons(car hilf,reverse liste);
  3246. if not erg then erg := list(hilf)
  3247. else
  3248. if not(hilf member erg)
  3249. then
  3250. << liste := erg; weiter := t;
  3251. while liste and weiter do
  3252. << if dqe_listequal(hilf,car liste)
  3253. then weiter := nil
  3254. else liste := cdr liste >>;
  3255. if weiter
  3256. then erg := dqe_modcons(hilf,erg) >>
  3257. >> >> >>;
  3258. if length(erg) = 1
  3259. then erg := car erg
  3260. else
  3261. if cdr erg
  3262. then erg:= cons(symb,erg) >>;
  3263. return erg;
  3264. end;
  3265. %%%%%%%%%%%%%%% dqe_permutationfkt %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3266. % %
  3267. % dqe_permutationfkt ist eine hilfsprozedur fuer dqe_dknfsimplify.%
  3268. % sie berechnet alle permutation einer liste. %
  3269. % (siehe abschnitt 6.2 des kapitels 6) %
  3270. % %
  3271. % eingabe: eine liste phi von der form list(a_1,a_2,...,a_n), %
  3272. % wobei a_i paarweise verschieden sind und sie nur %
  3273. % atomare formeln oder true oder false seien duerfen. %
  3274. % %
  3275. % ausgabe: ergliste ist eine liste,die aus der menge der permu- %
  3276. % tation von der liste phi, falls phi mehr als ein ele- %
  3277. % enthaelt. %
  3278. % sonst ist ergliste leer. %
  3279. % %
  3280. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3281. symbolic procedure dqe_permutationfkt(phi);
  3282. begin scalar ergliste,liste,hilf,hilfliste,erghilf;
  3283. ergliste :=nil;
  3284. if not(phi) or (length(phi) = 1)
  3285. then ergliste := nil
  3286. else
  3287. if length(phi) = 2
  3288. then ergliste := list(phi,reverse phi)
  3289. else
  3290. <<liste := phi;
  3291. while liste do
  3292. << hilf := car liste;
  3293. liste := cdr liste;
  3294. hilfliste := dqe_sanselem(phi,hilf);
  3295. hilfliste := dqe_permutationfkt(hilfliste);
  3296. while hilfliste do
  3297. << erghilf := cons(hilf,car hilfliste);
  3298. ergliste := cons(erghilf,ergliste);
  3299. hilfliste := cdr hilfliste >> >>;
  3300. ergliste := reverse ergliste >>;
  3301. return ergliste;
  3302. end;
  3303. %%%%%%%%%%%%%%% dqe_sanselem %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3304. % %
  3305. % dqe_sanselem ist eine hilfsprozedur fuer dqe_permutationfkt . %
  3306. % (siehe abschnitt 6.2 des kapitels 6) %
  3307. % %
  3308. % eingabe: eine liste phi von der form list(a_1,a_2,...,a_n), %
  3309. % und eine element a. %
  3310. % %
  3311. % ausgabe: ergliste ist die liste phi ohne das element a. %
  3312. % %
  3313. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  3314. symbolic procedure dqe_sanselem(phi,elem);
  3315. begin scalar hilf,erg;
  3316. erg := nil;
  3317. while phi do
  3318. << hilf := car phi;
  3319. phi := cdr phi;
  3320. if not(elem = hilf)
  3321. then erg := cons(hilf,erg) >>;
  3322. return reverse erg;
  3323. end;
  3324. % part 7
  3325. symbolic procedure dqe_pform f;
  3326. if listp f and car f eq '!*sq then prepsq cadr f else f$
  3327. endmodule; % [dcfsfkacem]
  3328. end; % of file