(FILECREATED " 2-Mar-86 16:16:47" {DSK}<LISPFILES>DENSITYTRACE.;1
 4863   

      previous date: " 5-Feb-86 18:11:43" 
{MITFS1-E40:SLOAN% SCHOOL:MASSINSTTECH}<DINDE>ARCHIVES>DAT% NGUYEN>DENSITYTRACE.;1)


(* Copyright (c) 1986 by Massachusetts Institute of Technology. All rights reserved.)

(PRETTYCOMPRINT DENSITYTRACECOMS)

(RPAQQ DENSITYTRACECOMS
 ((FNS BoxcarWeightFunction ComputeLocalDensity CosineWeightFunction UFABS)
			 (MACROS UFABS)))
(DEFINEQ

(BoxcarWeightFunction

  [LAMBDA (X)                                                (* DDN "31-Jan-86 14:36")


          (* * W (X) = { 1.0 if (ABS X) < .5; -

	  0.0 otherwise})



    (if
 (
LESSP
 (
ABS
 X)
	       .5)
	then
 1.0
      else
 0.0])

(ComputeLocalDensity

  [LAMBDA (X Interval ChoiceOfWeight Density)                (* SCP " 2-Mar-86 16:10")


          (* * BASED ON SECTION 2.9 OF CHAMBER'S BOOK, -

	  "GRAPHICAL METHODS FOR DATA ANALYSIS.")




          (* * THERE ARE TWO CHOICES OF WEIGHT FUNCTIONS: -

	  CosineWeightFunction and the DEFAULT -

	  BoxcarWeightFunction.)



    (LET ((N (
ARRAYTOTALSIZE
 X)))

          (* * ERROR CHECKING)



      (if
 (
NULL
 Density)
	  then
 (
SETQ
 Density (
MAKEARRAY
 N (
QUOTE
 ELEMENTTYPE)
					(
QUOTE
 FLONUM)))
	else
 (if
 (
NOT
 (
EQP
 (
ARRAYTOTALSIZE
 Density)
			   N))
		 then
 (
ERROR
 "Density must have same length as X.")))
      (if
 (
NOT
 (
EQP
 ChoiceOfWeight (
QUOTE
 CosineWeightFunction)))
	  then
 (
SETQ
 ChoiceOfWeight (
QUOTE
 BoxcarWeightFunction)))

          (* * BEGIN)



      (
UFQuickSort
 X)
      (bind
 (Begin ← 0)
	    (End ← 0)
	    (IntervalInverse ←(
QUOTIENT
 1.0 Interval))
	    (HalfInterval ←(
QUOTIENT
 Interval 2.0))
	    (NInverse ←(
QUOTIENT
 1.0 N)) declare
 (TYPE FLOATP IntervalInverse HalfInterval NInverse)
	 for
 I from
 0 to
 (
SUB1
 N)
	 do
 

          (* * COMPUTE BEGINNING OF DATA RANGE)



	    (bind
 (XI ←(\FLOATAREF X I)) declare
 (TYPE FLOATP HalfInterval XI)
	       while
 (
AND
 (
LESSP
 Begin I)
			  (
UFGREATERP
 (UFABS
 (
DIFFERENCE
 XI (\FLOATAREF X Begin)))
				      HalfInterval))
	       do
 (
SETQ
 Begin (
ADD1
 Begin)))

          (* * COMPUTE END OF DATA RANGE)



	    (bind
 (XI ←(\FLOATAREF X I))
		  (NM1 ←(
SUB1
 N)) declare
 (TYPE FLOATP HalfInterval XI)
	       while
 (
AND
 (
LESSP
 End NM1)
			  (
UFLEQ
 [UFABS
 (
DIFFERENCE
 XI (\FLOATAREF X (
ADD1
 End]
				 HalfInterval))
	       do
 (
SETQ
 End (
ADD1
 End)))

          (* * COMPUTE SumWeight)



	    (bind
 (SumWeight ← 0.0)
		  (XI ←(\FLOATAREF X I))
		  Temp Weight declare
 (TYPE FLOATP SumWeight XI Temp Weight IntervalInverse NInverse 
					    HalfInterval)
	       for
 J from
 Begin to
 End do
 (
SELECTQ
 ChoiceOfWeight
						   (BoxcarWeightFunction
 (
SETQ
 SumWeight
									   (
PLUS
 SumWeight 1.0))

          (* (SETQ SumWeight (PLUS SumWeight (if (UFLESSP (UFABS (DIFFERENCE XI (\FLOATAREF X J))) HalfInterval) then 1.0 else

	  0.0))))


                                                             (* W (X) = { 1.0 if (ABS X) < .5;

							     0.0 otherwise})

									 )
						   (CosineWeightFunction

						     [
SETQ
 Temp (UFABS
 (
DIFFERENCE
 XI
										   (\FLOATAREF X J]
						     (
SETQ
 Weight (if
 (
UFLESSP
 (UFABS
 Temp)
									       .5)
								      then
 (
SETQ
 Temp
									     (
TIMES
 360.0 Temp))
									   (
SETQ
 Temp (
COS
 Temp))
									   (
PLUS
 1.0 Temp)
								    else
 0.0))
                                                             (* W (X) = { 1 + COS 2PIX if 

							     (ABS X) < .5; 0.0 otherwise})

						     (
SETQ
 SumWeight (
PLUS
 SumWeight Weight)))
						   (
SHOULDNT
 "Unanticipated Weight Function:" 
							     ChoiceOfWeight))
	       finally
 (\FLOATASET (
TIMES
 IntervalInverse NInverse SumWeight)
				   Density I)))

          (* * RETURN THE Density CMLARRAY)



      Density])

(CosineWeightFunction

  [LAMBDA (X)                                                (* DDN "31-Jan-86 14:38")


          (* * W (X) = { 1 + COS 2PIX if (ABS X) < .5; -

	  0.0 otherwise})



    (if
 (
LESSP
 (
ABS
 X)
	       .5)
	then
 (
FPLUS
 1.0 (
COS
 (
FTIMES
 360.0 X)))
      else
 0.0])

(UFABS

  [LAMBDA (X)                                                (* SCP " 1-Mar-86 22:29")


          (* * comment)



    (
FABS
 X])
)
(DECLARE: EVAL@COMPILE 

(PUTPROPS UFABS DMACRO
 [(X)
			(\FLOATBOX ((OPCODES UBFLOAT1 2)
				    (\FLOATUNBOX X])
)
(PUTPROPS DENSITYTRACE COPYRIGHT ("Massachusetts Institute of Technology" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL (456 4640 (BoxcarWeightFunction 466 . 742) (ComputeLocalDensity 744 . 4156) (
CosineWeightFunction 4158 . 4486) (UFABS 4488 . 4638)))))
STOP