%5:% %line 72 "integrator.web" symbolic$ write"Integrator package for REDUCE 3.4, $Revision: 0.92 $"$terpri()$ %9:% %line 213 "integrator.web" %line 214 "integrator.web" put( 'initialize_equations, 'psopfn, 'initialize_equations1)$ %:9%%13:% %line 294 "integrator.web" global '(current_equation_set!*)$ current_equation_set!*:= 'equ$ %:13%%18:% %line 382 "integrator.web" fluid '(!*coefficient_check)$ !*coefficient_check:=t$ flag( '(coefficient_check), 'switch)$ %:18%%30:% %line 597 "integrator.web" %line 598 "integrator.web" fluid '(!*polynomial_check)$ !*polynomial_check:=nil$ flag( '(polynomial_check), 'switch)$ %:30%%50:% %line 955 "integrator.web" %line 956 "integrator.web" fluid '(!*allow_differentiation)$ !*allow_differentiation:=nil$ flag( '(allow_differentiation), 'switch)$ %:50%%61:% %line 1185 "integrator.web" %line 1186 "integrator.web" fluid '(listpri_depth!*)$ listpri_depth!*:=40$ %:61% %line 75 "integrator.web" algebraic$ %:5%%10:% %line 217 "integrator.web" %line 218 "integrator.web" lisp procedure initialize_equations1 specification_list; begin scalar operator_name,total_used,variable_list, specification,even_used,odd_used, constant_operator,bracketname,function_name,function_list; if length specification_list<5 then rederr("INITIALIZE_EQUATIONS: wrong number of parameters"); if not idp(operator_name:=car specification_list)then rederr("INITIALIZE_EQUATIONS: equations operator must be identifier"); if not fixp(total_used:= reval car(specification_list:=cdr specification_list)) or total_used<0 then rederr("INITIALIZE_EQUATIONS: total number of equations must be positive"); put(operator_name, 'total_used,total_used); variable_list:=reval car( specification_list:=cdr specification_list); if atom variable_list or car variable_list neq 'list then rederr("INITIALIZE_EQUATIONS: variable list must be algebraic list"); put(operator_name, 'variable_list,cdr variable_list); %11:% %line 265 "integrator.web" specification_list:=cdr specification_list; specification:=car specification_list; if atom specification or length specification neq 4 or car specification neq 'list or not idp(constant_operator:=cadr specification)or not fixp(even_used:=reval caddr specification)or not fixp(odd_used:=reval cadddr specification) or even_used<0 or odd_used<0 then msgpri("INITIALIZE_EQUATIONS: invalid declaration of", specification,nil,nil,t); put(operator_name, 'constant_operator,constant_operator); if get(constant_operator, 'rtype)= 'algebra_generator then put(operator_name, 'bracketname, bracketname:=get(constant_operator, 'bracketname)); if get(constant_operator, 'rtype)= 'algebra_generator then define_used(bracketname,list( 'list,even_used,odd_used)) else begin put(constant_operator, 'even_used,even_used); put(constant_operator, 'odd_used,odd_used); end %:11% %line 236 "integrator.web" ; %12:% %line 276 "integrator.web" %line 277 "integrator.web" for each function_specification in cdr specification_list do begin if atom function_specification or length function_specification neq 4 or car function_specification neq 'list or not idp(function_name:=cadr function_specification)or not fixp(even_used:=reval caddr function_specification)or not fixp(odd_used:=reval cadddr function_specification) or even_used<0 or odd_used<0 then msgpri("INITIALIZE_EQUATIONS: invalid declaration of", function_specification,nil,nil,t); if get(function_name, 'rtype)= 'algebra_generator then define_used(bracketname,list( 'list,even_used,odd_used)) else begin put(function_name, 'even_used,even_used); put(function_name, 'odd_used,odd_used); end; function_list:=function_name . function_list; end; put(operator_name, 'function_list,function_list) %:12% %line 237 "integrator.web" ; end$ %:10%%14:% %line 298 "integrator.web" %line 299 "integrator.web" lisp operator use_equations; lisp procedure use_equations operator_name; begin if idp operator_name then current_equation_set!*:=operator_name else rederr("USE_EQUATIONS: argument must be identifier"); end$ %:14%%15:% %line 315 "integrator.web" %line 316 "integrator.web" lisp operator integrate_equation; lisp procedure integrate_equation n; begin scalar listpri_depth!*,total_used,equation,denominator, solvable_kernel,solvable_kernels,df_list,df_kernel, function_list,present_functions_list,variable_list,absent_variables, polynomial_variables,equations_list,linear_functions_list,constants_list, bracketname,df_terms,df_functions, linear_functions,functions_and_constants_list,commutator_functions, present_variables, inhomogeneous_term,nr_of_variables,integration_variables, forbidden_functions,differentiations_list,polynomial_order; listpri_depth!*:=200; terpri!* t; %16:% %line 348 "integrator.web" if null(total_used:=get(current_equation_set!*, 'total_used))or n>total_used then msgpri("INTEGRATE_EQUATIONS: properly initialize", current_equation_set!*,nil,nil,t); if null(equation:=cadr assoc(list(current_equation_set!*,n), get(current_equation_set!*, 'kvalue)))then msgpri("INTEGRATE_EQUATION:",list(current_equation_set!*,n), "is non-existent",nil,t); denominator:=denr(equation:=simp!* equation); equation:=numr equation; if null equation then <> %:16% %line 329 "integrator.web" ; %19:% %line 398 "integrator.web" df_list:=split_form(equation, '(df)); if null car df_list and (cdr df_list)and length(cdr df_list)=1 then if(solvable_kernel:=find_solvable_kernel( solvable_kernels:=list(car car cdr df_list), cdr df_list,denominator))then <> >> else <> %:19% %line 330 "integrator.web" ; %27:% %line 568 "integrator.web" %28:% %line 576 "integrator.web" %line 577 "integrator.web" function_list:=get(current_equation_set!*, 'function_list); present_functions_list:=get_recursive_kernels(equation,function_list); variable_list:=get(current_equation_set!*, 'variable_list); absent_variables:=variable_list; for each function in present_functions_list do for each variable in ((if depl_entry then cdr depl_entry)where depl_entry=assoc(function,depl!*))do absent_variables:=delete(variable,absent_variables) %:28% %line 569 "integrator.web" ; %29:% %line 591 "integrator.web" %line 592 "integrator.web" polynomial_variables:=absent_variables; if !*polynomial_check then polynomial_variables:=for each variable in polynomial_variables join if polynomialp(equation,variable)then list(variable) %:29% %line 570 "integrator.web" ; %32:% %line 614 "integrator.web" %line 615 "integrator.web" equations_list:=multi_split_form(equation,polynomial_variables); if length equations_list>1 then <> %:32% %line 571 "integrator.web" %:27% %line 331 "integrator.web" ; %34:% %line 652 "integrator.web" %line 653 "integrator.web" linear_functions_list:=split_form(car df_list, function_list); df_list:=cdr df_list; constants_list:=split_form(car linear_functions_list, list get(current_equation_set!*, 'constant_operator)); linear_functions_list:=cdr linear_functions_list; if(bracketname:=get(current_equation_set!*, 'bracketname))then %35:% %line 669 "integrator.web" %line 670 "integrator.web" if length(df_list)=0 and length(linear_functions_list)=0 then << if atom(solvable_kernel:= relation_analysis(!*ff2a(equation,denominator),bracketname)) then <> else <> ; goto solved >> %:35% %line 660 "integrator.web" %:34% %line 332 "integrator.web" ; %36:% %line 710 "integrator.web" %line 711 "integrator.web" %37:% %line 725 "integrator.web" %line 726 "integrator.web" df_terms:=for each df_term in df_list join if member(car cadr car df_term,function_list) then list car df_term; for each df_term in df_terms do if not member(cadr df_term,df_functions)then df_functions:=cadr(df_term) . df_functions; functions_and_constants_list:=append(linear_functions_list, cdr constants_list); linear_functions:=for each linear_function in functions_and_constants_list collect car linear_function; if bracketname then commutator_functions:= get_recursive_kernels(car constants_list, get(current_equation_set!*, 'function_list)); %:37% %line 712 "integrator.web" ; %38:% %line 739 "integrator.web" %line 740 "integrator.web" present_variables:=variable_list; for each variable in absent_variables do present_variables:=delete(variable,present_variables); nr_of_variables:=length present_variables %:38% %line 713 "integrator.web" ; for each kernel in linear_functions do if length ((if depl_entry then cdr depl_entry)where depl_entry=assoc(kernel,depl!*))=nr_of_variables then solvable_kernels:=kernel . solvable_kernels; for each kernel in append(df_functions,commutator_functions)do solvable_kernels:=delete(kernel,solvable_kernels); if solvable_kernels then %39:% %line 745 "integrator.web" %line 746 "integrator.web" <> >> else <> >> %:39% %line 720 "integrator.web" %:36% %line 333 "integrator.web" ; %40:% %line 772 "integrator.web" %line 773 "integrator.web" %41:% %line 784 "integrator.web" %line 785 "integrator.web" integration_variables:=present_variables; for each kernel in append(linear_functions,commutator_functions)do for each variable in ((if depl_entry then cdr depl_entry)where depl_entry=assoc(kernel,depl!*))do integration_variables:=delete(variable,integration_variables); for each df_function in df_functions do if not length ((if depl_entry then cdr depl_entry)where depl_entry=assoc(df_function,depl!*))=nr_of_variables then for each variable in ((if depl_entry then cdr depl_entry)where depl_entry=assoc(df_function,depl!*))do integration_variables:=delete(variable,integration_variables) %:41% %line 773 "integrator.web" ; %43:% %line 813 "integrator.web" %line 814 "integrator.web" %44:% %line 824 "integrator.web" %line 825 "integrator.web" for each df_term in df_terms do <> ; %:44% %line 814 "integrator.web" ; %45:% %line 834 "integrator.web" %line 835 "integrator.web" if solvable_kernels then if length(solvable_kernels)=1 then if(solvable_kernel:=find_solvable_kernel(solvable_kernels,df_list,denominator)) then if(inhomogeneous_term:=linear_solve(mk!*sq(equation ./ 1),solvable_kernel)) and(not !*polynomial_check or check_polynomial_integration(solvable_kernel,inhomogeneous_term)) then <> >> else <> else <> else <> %:45% %line 815 "integrator.web" %:43% %line 774 "integrator.web" %:40% %line 334 "integrator.web" ; %51:% %line 960 "integrator.web" %line 961 "integrator.web" %52:% %line 993 "integrator.web" present_variables:=for each variable in present_variables collect (variable . nil . 0); for each kernel in df_terms do for each variable in ((if depl_entry then cdr depl_entry)where depl_entry=assoc(cadr(kernel),depl!*))do rplacd(entry,kernel . (cddr entry+1)) where entry=assoc(variable,present_variables);; for each kernel in linear_functions do for each variable in ((if depl_entry then cdr depl_entry)where depl_entry=assoc(kernel,depl!*))do rplacd(entry,kernel . (cddr entry+1)) where entry=assoc(variable,present_variables);; if bracketname then for each kernel in commutator_functions do for each variable in ((if depl_entry then cdr depl_entry)where depl_entry=assoc( kernel,depl!*))do rplacd(entry,nil . (cddr entry+1)) where entry=assoc(variable,present_variables); %:52% %line 961 "integrator.web" ; %53:% %line 1007 "integrator.web" %line 1008 "integrator.web" differentiations_list:= for each entry in present_variables join if cadr entry and cddr entry=1 and (polynomial_order:=get_polynomial_order( linear_solve(mk!*sq(equation ./ 1),cadr entry),car entry)) then list(car entry . cadr entry . (polynomial_order+1)); if differentiations_list then if !*allow_differentiation then <> else << write"*** ",current_equation_set!*,"(",n, "): Generation of new equations by differentiation possible."; terpri!* t;write" Solvable with 'on allow_differentiation'"; terpri!* t;goto solved>> %:53% %line 962 "integrator.web" %:51% %line 335 "integrator.web" ; %55:% %line 1054 "integrator.web" %line 1055 "integrator.web" write current_equation_set!*,"(",n,") not solved";terpri!* t %:55% %line 336 "integrator.web" ; solved: end$ %:15%%20:% %line 421 "integrator.web" %line 422 "integrator.web" lisp procedure find_solvable_kernel(kernel_list,kc_list,denominator); if !*coefficient_check then first_solvable_kernel(kernel_list,kc_list,denominator) else car kernel_list$ lisp procedure first_solvable_kernel(kernel_list,kc_list,denominator); if kernel_list then (if numberp cdr kc_pair or numberp !*ff2a(cdr kc_pair,denominator) then car kc_pair else first_solvable_kernel(cdr kernel_list,kc_list,denominator)) where kc_pair=assoc(car kernel_list,kc_list)$ %:20%%21:% %line 458 "integrator.web" lisp procedure homogeneous_integration_of df_term; begin scalar df_function,function_number,dependency_list,integration_list, coefficient_name,bracketname,even_used,odd_used, integration_variable, number_of_integrations,solution,new_dependency_list; %22:% %line 483 "integrator.web" df_function:=cadr df_term; if not member(car df_function,get(current_equation_set!*, 'function_list)) or not fixp(function_number:=cadr df_function)or function_number=0 then msgpri("PERFORM_HOMOGENEOUS_INTEGRATION: integration of", df_function,"not allowed",nil,t) %:22% %line 465 "integrator.web" ; dependency_list:= ((if depl_entry then cdr depl_entry)where depl_entry=assoc(df_function,depl!*)); if length dependency_list=1 then coefficient_name:=get(current_equation_set!*, 'constant_operator) else coefficient_name:=car df_function; %23:% %line 493 "integrator.web" %line 494 "integrator.web" if get(coefficient_name, 'rtype)= 'algebra_generator then begin bracketname:=get(current_equation_set!*, 'bracketname); even_used:=get(bracketname, 'even_used); odd_used:=get(bracketname, 'odd_used); end else begin even_used:=get(coefficient_name, 'even_used); odd_used:=get(coefficient_name, 'odd_used); end %:23% %line 470 "integrator.web" ; integration_list:=cdr cdr df_term; %24:% %line 507 "integrator.web" %line 508 "integrator.web" if integration_list then integration_variable:=car integration_list else integration_variable:=nil; if integration_variable and(integration_list:=cdr integration_list) and fixp car integration_list then <> else number_of_integrations:=1 %:24% %line 472 "integrator.web" ; if bracketname then %25:% %line 521 "integrator.web" %line 522 "integrator.web" if function_number>0 then (if even_used+number_of_integrations>get(bracketname, 'even_dimension)then change_dimensions_of(bracketname,even_used+number_of_integrations, get(bracketname, 'odd_dimension))) else (if odd_used+number_of_integrations>get(bracketname, 'odd_dimension)then change_dimensions_of(bracketname,get(bracketname, 'even_dimension), odd_used+number_of_integrations)) %:25% %line 474 "integrator.web" ; %26:% %line 544 "integrator.web" solution:=nil ./ 1; while integration_variable do begin new_dependency_list:=delete(integration_variable,dependency_list); for i:=0:number_of_integrations-1 do <0 then (even_used:=even_used+1)else-(odd_used:=odd_used+1)),1))); if new_dependency_list then depl!*:=(list(coefficient_name,if function_number>0 then even_used else-odd_used) . new_dependency_list) . depl!*; >> ; %24:% %line 507 "integrator.web" %line 508 "integrator.web" if integration_list then integration_variable:=car integration_list else integration_variable:=nil; if integration_variable and(integration_list:=cdr integration_list) and fixp car integration_list then <> else number_of_integrations:=1 %:24% %line 553 "integrator.web" end; solution:=mk!*sq subs2 solution; if get(coefficient_name, 'rtype)= 'algebra_generator then define_used(bracketname,list( 'list,even_used,odd_used)) else begin put(coefficient_name, 'even_used,even_used); put(coefficient_name, 'odd_used,odd_used); end %:26% %line 475 "integrator.web" ; return solution end$ %:21%%31:% %line 604 "integrator.web" %line 605 "integrator.web" lisp procedure polynomialp(expression,kernel); if domainp expression then t else((main_variable=kernel or not depends(main_variable,kernel))and polynomialp(lc expression,kernel)and polynomialp(red expression,kernel)) where main_variable=mvar expression$ %:31%%33:% %line 636 "integrator.web" %line 637 "integrator.web" lisp procedure partial_list(printed_list,nr_of_items); 'list . broken_list(printed_list,nr_of_items)$ lisp procedure broken_list(list,n); if list then if n=0 then '(!.!.!.) else car list . broken_list(cdr list,n-1)$ %:33%%42:% %line 806 "integrator.web" %line 807 "integrator.web" lisp procedure check_differentiation_sequence(sequence,variable_list); if null sequence then t else if fixp car sequence or member(car sequence,variable_list)then check_differentiation_sequence(cdr sequence,variable_list)$ %:42%%46:% %line 863 "integrator.web" lisp procedure check_polynomial_integration(df_term,integration_term); %line 864 "integrator.web" begin scalar numerator,denominator,integration_variables,variable,ok; numerator:=numr simp integration_term; denominator:=denr simp integration_term; integration_variables:= for each argument in cdr cdr df_term join if not fixp argument then list argument; ok:=t; while ok and integration_variables do <> ; return ok; end$ %:46%%47:% %line 884 "integrator.web" %line 885 "integrator.web" lisp procedure inhomogeneous_integration_of(df_term,inhomogeneous_term); begin scalar df_sequence,integration_variables,int_sequence, variable,nr_of_integrations,integration_terms,solution, powers,coefficient,int_factor,solution_term,n,k; df_sequence:=cdr cdr df_term; %48:% %line 905 "integrator.web" %line 906 "integrator.web" while df_sequence do <> else nr_of_integrations:=1; integration_variables:=variable . integration_variables; int_sequence:=(variable . nr_of_integrations) . int_sequence >> %:48% %line 890 "integrator.web" ; integration_terms:=multi_split_form(numr simp inhomogeneous_term, integration_variables); integration_terms:=(nil . car integration_terms) . cdr integration_terms; %49:% %line 924 "integrator.web" %line 925 "integrator.web" solution:=nil ./ 1; for each term in integration_terms do <> ; solution_term:=multsq(solution_term,coefficient ./ int_factor); solution:=addsq(solution,solution_term) >> %:49% %line 896 "integrator.web" ; solution:=multsq(solution,1 ./ denr simp inhomogeneous_term); solution:=mk!*sq subs2 addsq(solution,simp homogeneous_integration_of df_term); return solution end$ %:47%%54:% %line 1041 "integrator.web" %line 1042 "integrator.web" lisp procedure get_polynomial_order(expression,variable); if not depends(denr(expression:=simp expression),variable)and (not !*polynomial_check or polynomialp(numr expression,variable))then begin scalar kord!*; setkorder list !*a2k variable; expression:=reorder numr expression; return if mvar expression=variable then ldeg expression else 0; end$ %:54%%56:% %line 1063 "integrator.web" %line 1064 "integrator.web" algebraic procedure integrate_equations(m,n); for i:=m:n do integrate_equation(i)$ lisp operator integrate_exceptional_equation; lisp procedure integrate_exceptional_equation(n); integrate_equation(n) where !*coefficient_check=nil, !*polynomial_check=nil, !*allow_differentiation=t$ %:56%%57:% %line 1085 "integrator.web" lisp operator show_equation; %line 1086 "integrator.web" lisp procedure show_equation n; begin scalar equation,total_used,function_list; if null(total_used:=get(current_equation_set!*, 'total_used))or n>total_used then msgpri("SHOW_EQUATION: properly initialize", current_equation_set!*,nil,nil,t); if(equation:=assoc(list(current_equation_set!*,n),get(current_equation_set!*, 'kvalue)))then begin equation:=setk(list(current_equation_set!*,n),aeval cadr equation); varpri(equation,list( 'setk,mkquote list(current_equation_set!*,n),mkquote equation), 'only); function_list:=get_recursive_kernels(numr simp equation, get(current_equation_set!*, 'function_list)); if function_list then <> >> else terpri!* nil end end$ algebraic procedure show_equations(m,n); for i:=m:n do show_equation i$ %:57%%58:% %line 1112 "integrator.web" %line 1113 "integrator.web" lisp operator functions_used,put_functions_used,equations_used,put_equations_used; lisp procedure functions_used function_name; list( 'list,get(function_name, 'even_used),get(function_name, 'odd_used))$ lisp procedure put_functions_used(function_name,even_used,odd_used); begin if not fixp even_used or even_used<0 or not fixp odd_used or odd_used<0 then msgpri("PUT_FUNCTIONS_USED: used functions number invalid",nil,nil,nil,t); put(function_name, 'even_used,even_used); put(function_name, 'odd_used,odd_used); end$ lisp procedure equations_used; get(current_equation_set!*, 'total_used)$ lisp procedure put_equations_used(n); if not fixp n or n<0 then msgpri("PUT_EQUATIONS_USED: used equation number invalid",nil,nil,nil,t) else put(current_equation_set!*, 'total_used,n)$ %:58%%59:% %line 1149 "integrator.web" %line 1150 "integrator.web" lisp operator df_acts_as_derivation_on; lisp procedure df_acts_as_derivation_on operator_name; begin put(operator_name, 'dfform, 'df_as_derivation); end$ %:59%%60:% %line 1161 "integrator.web" %line 1162 "integrator.web" lisp procedure df_as_derivation(kernel,variable,power); begin scalar left_part,right_part,argument,derivative; if power neq 1 then msgpri("DF_AS_DERIVATION:",kernel,"must occur linearly",nil,t); left_part:=list car kernel;right_part:=cdr kernel; derivative:=nil . 1; while right_part do <> ; return derivative; end$ %:60%%62:% %line 1191 "integrator.web" %line 1192 "integrator.web" lisp operator listlength$ lisp procedure listlength l; listpri_depth!*:=l$ %:62%%63:% %line 1200 "integrator.web" %line 1201 "integrator.web" symbolic procedure listpri l; begin scalar orig,split,u; u:=l; l:=cdr l; prin2!* get( '!*lcbkt!*, 'prtch); orig:=orig!*; orig!*:=if posn!*<18 then posn!* else orig!*+3; if null l then go to b; split:=treesizep(l,listpri_depth!*); a:maprint(negnumberchk car l,0); l:=cdr l; if null l then go to b; oprin '!*comma!*; if split then terpri!* t; go to a; b:prin2!* get( '!*rcbkt!*, 'prtch); orig!*:=orig; return u end$ %:63%%64:% %line 1224 "integrator.web" end; %line 1225 "integrator.web" %:64%