File: rncomb.mc

package info (click to toggle)
maxima 5.6-17
  • links: PTS
  • area: main
  • in suites: woody
  • size: 30,572 kB
  • ctags: 47,715
  • sloc: ansic: 154,079; lisp: 147,553; asm: 45,843; tcl: 16,744; sh: 11,057; makefile: 7,198; perl: 1,842; sed: 334; fortran: 24; awk: 5
file content (71 lines) | stat: -rw-r--r-- 1,997 bytes parent folder | download | duplicates (2)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
/* -*-Macsyma-*- */
EVAL_WHEN(BATCH,TTYOFF:TRUE)$
/*ASB;RNCOMB 2
12:32pm  Friday, 14 January 1983
  Created.
12:00pm  Saturday, 15 January 1983
  At JPG's suggestion, removed dependence on GENUT by bringing in copies of
    PREDPARTITION and RLOIEWL.
10:02am  Sunday, 16 January 1983
  LCM name changed to LCM_L to avoid name conflict with LCM in SHARE;FUNCTS >
*/

EVAL_WHEN(TRANSLATE,
	  TRANSCOMPILE:TRUE,
	  DEFINE_VARIABLE:'MODE)$

PUT('RNCOMB,2,'VERSION)$

RNCOMBINE(EXP):=BLOCK(
  [PARTSWITCH:TRUE,INFLAG:TRUE,PIECE,PFEFORMAT:TRUE],
  EXP:RLOIEWL("+",COMBINE(EXP)),
  PFEFORMAT:FALSE,
  RNCOMBINE1(EXP))$

LCM_L(LIST):=
  IF LIST=[]
  THEN 1
  ELSE BLOCK([RLIST:REST(LIST),FLIST:FIRST(LIST),FRLIST,
	      PARTSWITCH:TRUE,INFLAG:TRUE,PIECE],
	     IF RLIST=[]
             THEN FLIST
	     ELSE LCM_L(CONS(FLIST*(FRLIST:FIRST(RLIST))/GCD(FLIST,FRLIST),
			     REST(RLIST))))$

RNCOMBINE1(LIST):=BLOCK(
  [FLIST,SPLITDUM,LSPLITDUM,FLIST_DENOM],
  IF LIST=[] THEN RETURN(0),
  FLIST:FIRST(LIST),
  IF LENGTH(LIST)=1
  THEN RETURN(IF INPART(NUM(FLIST),0)="+"
	      THEN RNCOMBINE1(ARGS(NUM(FLIST)))/DENOM(FLIST)
	      ELSE FLIST),
  FLIST_DENOM:(FLIST_DENOM:DENOM(FLIST))/NUMFACTOR(FLIST_DENOM),
  FLIST:FLIST*FLIST_DENOM,
  SPLITDUM:PREDPARTITION(REST(LIST),
			 LAMBDA([DUM],NUMBERP(DENOM(DUM)/FLIST_DENOM))),
  IF (LSPLITDUM:LAST(SPLITDUM))#[]
  THEN FLIST:DENOMTHRU(CONS(FLIST,LSPLITDUM*FLIST_DENOM))/FLIST_DENOM,
  FLIST+RNCOMBINE1(FIRST(SPLITDUM)))$

DENOMTHRU(EXP):=BLOCK(
  [LCMDUM:LCM_L(MAPLIST('DENOM,EXP))],
  APPLY("+",LCMDUM*EXP)/LCMDUM)$

/* Functions from DGVAL;GENUT FASL: */

RLOIEWL(OP,EXP):=BLOCK(
  [PARTSWITCH:TRUE,INFLAG:TRUE,PIECE],
  IF INPART(EXP,0)=OP
  THEN ARGS(EXP)
  ELSE [EXP])$

PREDPARTITION(LIST,PREDICATE):=BLOCK(
  [NOLIST:[],YESLIST:[]],
  FOR IDUM IN REVERSE(LIST) DO
      IF MODE_IDENTITY(BOOLEAN,APPLY(PREDICATE,[IDUM]))
      THEN YESLIST:CONS(IDUM,YESLIST)
      ELSE NOLIST:CONS(IDUM,NOLIST),
  [NOLIST,YESLIST])$

EVAL_WHEN(BATCH,TTYOFF:FALSE)$