share/contrib/wrstcse.mac

   1 /* %wc_tols lists all tol[n] contained in the list, nested list
   2 or equation it gets as its argument. */
   3
   4 %wc_tols(wc_x):=block([vars,retval:[]],
   5     /* A list of all variables contained in wc_x */
   6     vars:listofvars(wc_x),
   7     for i in vars do
   8         if not(freeof('tol,i)) then
   9             push(i,retval),
  10     return(retval)
  11 );
  12
  13 /* %wc_tolrenumber renumbers all tol[n] contained in wc_x to start
  14 with n=startnum */
  15
  16 %wc_tolrenumber(wc_x,startnum):=block(
  17     [
  18         oldtols:%wc_tols(wc_x)
  19     ],
  20     startnum:startnum-1,
  21     psubst(
  22         makelist(
  23             i=tol[startnum:startnum+1],
  24             i,
  25             oldtols
  26         ),
  27         wc_x
  28     )
  29
  30 );
  31
  32 /* wc_tolappend appends a list of element values to another renumbering all tol[] found in both lists
  33 so they won't conflict. */
  34
  35 wc_tolappend([wc_args]):=block([wc_retval:[],wc_numberoftols:1],
  36     for wc_i in wc_args do
  37     (
  38         wc_retval:append(wc_retval,%wc_tolrenumber(wc_i,wc_numberoftols)),
  39         wc_numberoftols:wc_numberoftols+length(%wc_tols(wc_i))
  40     ),
  41     wc_retval
  42 );
  43
  44 /* wc_systematic returns a list of the results of all combinations one can get by assigning every tol[n] wc_valuespertol
  45 values between -1 and 1. */
  46
  47 wc_systematic(wc_x,[wc_valuespertol]):=block(
  48     [
  49         %wc_tols:%wc_tols(wc_x),
  50         /* The index x of the tol[x] being currently assigned a value to */
  51         wc_tolnum,
  52         wc_numoftols
  53     ],
  54     wc_numoftols:length(%wc_tols),
  55
  56     /* Default the number of values per tolerance parameter to 3 */
  57     if wc_valuespertol=[] then wc_valuespertol:3 else wc_valuespertol:first(wc_valuespertol),
  58     makelist(
  59         (
  60             subst(
  61                 (
  62                     wc_tolnum:-1,
  63                     makelist(
  64                         (
  65                             wc_tolnum:wc_tolnum+1,
  66                             wc_tol=((floor(mod(wc_num/(wc_valuespertol^wc_tolnum),wc_valuespertol)))/
  67                                 (wc_valuespertol-1)*2-1)
  68                         ),
  69                         wc_tol,%wc_tols
  70                     )
  71                 ),
  72                 wc_x
  73             )
  74         ),
  75         wc_num,0,wc_valuespertol^wc_numoftols-1
  76     )
  77
  78 );
  79
  80 wc_montecarlo(wc_x,wc_samples):=block(
  81     [
  82         %wc_tols:%wc_tols(wc_x),
  83         wc_numoftols
  84     ],
  85     wc_numoftols:length(%wc_tols),
  86
  87     makelist(
  88         (
  89             subst(
  90                 makelist(
  91                     (
  92                         wc_tol=random(2.0)-1
  93                     ),
  94                     wc_tol,%wc_tols
  95                 ),
  96                 wc_x
  97             )
  98         ),
  99         wc_num,1,wc_samples
 100     )
 101
 102 );
 103
 104 /* Calculates the typical values of wc_x */
 105
 106 wc_typicalvalues(wc_x):=
 107     subst(
 108         makelist(i=0,i,%wc_tols(wc_x)),
 109         wc_x
 110     );
 111
 112 /* Convenience function: Get the minimum, the typical and the maximal value */
 113
 114 wc_mintypmax(wc_x,[wc_params]):=block([wc_allvalues,wc_param1,min,wc_typ,max],
 115     if length(wc_params) < 1 then
 116         wc_param1:3
 117     else
 118         wc_param1:inpart(wc_params,1),
 119
 120     if wc_param1 > 0 then
 121         wc_allvalues:wc_systematic(wc_x,wc_param1)
 122     else
 123     (
 124         wc_allvalues:wc_montecarlo(wc_x,-wc_param1)
 125     ),
 126     min:apply('min,wc_allvalues),
 127     wc_typ:wc_typicalvalues(wc_x),
 128     max:apply('max,wc_allvalues),
 129         ['min=min,'typ=wc_typ,'max=max]
 130 );
 131 /* Make this function map over equations */
 132  ?putprop('mintypmax, ?cdr([?mlist,?mequal]), '?distribute_over)$
 133
 134 /* A function that pretty-prints the value ranges the input values are in */
 135 wc_inputvalueranges(wc_x):=apply('matrix,
 136     makelist(
 137         append([lhs(wc_i)],wc_mintypmax(rhs(wc_i))),
 138         wc_i,wc_x
 139     )
 140 );
 141
 142 /* A function that generates an equation out of the min, typ and maximum value for an element */
 143
 144 wc_mintypmax2tol(wc_tol,wc_min,wc_typ,wc_max):=
 145     ((-2*wc_typ+wc_min+wc_max)*wc_tol^2)/2-((wc_min-wc_max)*wc_tol)/2+wc_typ;