BAR_PLOT $RSI/bar_plot.pro
[Previous] [Next]
 NAME:
	BAR_PLOT

 PURPOSE:
	Create a bar graph, or overplot on an existing one.

 CATEGORY:
	Graphics.

 CALLING SEQUENCE:
	BAR_PLOT, Values

 INPUTS:
	Values:	A vector containing the values to be represented by the bars.
		Each element in VALUES corresponds to a single bar in the
		output.

 KEYWORD PARAMETERS:
   BASELINES:	A vector, the same size as VALUES, that contains the
		base value associated with each bar.  If not specified,
		a base value of zero is used for all bars.

      COLORS:	A vector, the same size as VALUES, containing the color index
		to be used for each bar.  If not specified, the colors are
		selected based on spacing the color indices as widely as
		possible within the available colors (specified by D.N_COLORS).

    BARNAMES:	A string array, containing one string label per bar.
		If the bars are vertical, the labels are placed beneath
		them.  If horizontal (rotated) bars are specified, the labels
		are placed to the left of the bars.

	TITLE:	A string containing the main title to for the bar plot.

	XTITLE:	A string containing the title for the X axis.

	YTITLE:	A string containing the title for the Y axis.

   BASERANGE:	A floating-point scalar in the range 0.0 to 1.0, that
		determines the fraction of the total available plotting area
		(in the direction perpendicular to the bars) to be used.
		If not specified, the full available area is used.

    BARWIDTH:	A floating-point value that specifies the width of the bars
		in units of "nominal bar width".  The nominal bar width is
		computed so that all the bars (and the space between them,
		set by default to 20% of the width of the bars) will fill the
		available space (optionally controlled with the BASERANGE
		keyword).

    BARSPACE: 	A scalar that specifies, in units of "nominal bar width",
		the spacing between bars.  For example, if BARSPACE is 1.0,
		then all bars will have one bar-width of space between them.
		If not specified, the bars are spaced apart by 20% of the bar
		width.

   BAROFFSET:	A scalar that specifies the offset to be applied to the
		first bar, in units of "nominal bar width".  This keyword
		allows, for example, different groups of bars to be overplotted
		on the same graph.  If not specified, the default offset is
		equal to BARSPACE.

     OUTLINE:	If set, this keyword specifies that an outline should be
		drawn around each bar.

    OVERPLOT:	If set, this keyword specifies that the bar plot should be
		overplotted on an existing graph.

  BACKGROUND:	A scalar that specifies the color index to be used for
		the background color.  By default, the normal IDL background
		color is used.

	ROTATE:	If set, this keyword indicates that horizontal rather than
		vertical bars should be drawn.  The bases of horizontal bars
		are on the left, "Y" axis and the bars extend to the right.

 OUTPUTS:
	A bar plot is created, or an existing one is overplotted.

 EXAMPLE:
	By using the overplotting capability, it is relatively easy to create
	stacked bar charts, or different groups of bars on the same graph.

	For example, if ARRAY is a two-dimensional array of 5 columns and 8
	rows, it is natural to make a plot with 5 bars, each of which is a
	"stacked" composite of 8 sections.  First, create a 2D COLORS array,
	equal in size to ARRAY, that has identical color index values across
	each row to ensure that the same item is represented by the same color
	in all bars.

	With ARRAYS and COLORS defined, the following code fragment
	illustrates the creation of stacked bars (note that the number of rows
	and columns is arbitrary):

	!Y.RANGE = [0,ymax] ; Scale range to accommodate the total bar lengths.
	BASE = INTARR(NROWS)
	FOR I = 0, NROWS-1 DO BEGIN
	   BAR_PLOT, ARRAY(*,I), COLORS=COLORS(*,I), BASELINES=BASE, $
	             BARWIDTH=0.75, BARSPACE=0.25, OVER=(I GT 0)
	   BASE = BASE + ARRAY(*,I)
	ENDFOR

	To plot each row of ARRAY as a clustered group of bars within the same
	graph, use the BASERANGE keyword to restrict the available plotting
	region for each set of bars.  The sample code fragment below
	illustrates this method:

	FOR I = 0, NROWS-1 DO $
	   BAR_PLOT, ARRAY(*,I), COLORS=COLORVECT, BARWIDTH=0.8,BARSPACE=0.2, $
	     BAROFFSET=I*((1.0+BARSPACE)*NCOLS), OVER=(I GT 0), BASERANGE=0.19

	where NCOLS is the number of columns in ARRAY, and COLORVECT is a
	vector containing the color indices to be used for each group of
	bars.  (In this example, each group uses the same set of colors, but
	this could easily be changed.)

 MODIFICATION HISTORY:
	August 1990, T.J. Armitage, RSI, initial programming.  Replacement
	for PLOTBAR and OPLOTBAR routines written by William Thompson.

	September 1990, Steve Richards, RSI, changed defaults to improve the
	appearance of the bar plots in the default mode. Included
	spacing the bars slightly.


BETA $RSI/beta.pro
[Previous] [Next]
 NAME:
   BETA

 PURPOSE:
   Return the Beta function of (possibly complex) Z.

 CALLING SEQUENCE:
   Result = BETA(Z)

 INPUTS:
   Z: The expression for which the beta function will be evaluated.
      If Z is double-precision, the result is double-precision,
      otherwise the result is floating-point. Z may be complex.

 KEYWORD PARAMETERS:
   DOUBLE: Set this keyword to return a double-precision result.

 MODIFICATION HISTORY:
   3 July 1995, AB, RSI.
   AB, 5/4/2001, Switch from using _EXTRA to _STRICT_EXTRA, so that
       incorrect keywords will cause issue proper messages to
       be issued instead of being silently ignored.
   CT, RSI, Dec 2001: Rewrote to use LNGAMMA, which now handles complex.


BILINEAR $RSI/bilinear.pro
[Previous] [Next]
 NAME:
	BILINEAR

 PURPOSE:
	Bilinearly interpolate a set of reference points.

 CALLING SEQUENCE:
	Result = BILINEAR(P, IX, JY)

 INPUTS:
	P:  A two-dimensional data array.

	IX and JY:  The "virtual subscripts" of P to look up values
	  for the output.

	IX can be one of two types:
	     1)	A one-dimensional, floating-point array of subscripts to look
		up in P.  The same set of subscripts is used for all rows in
		the output array.
	     2)	A two-dimensional, floating-point array that contains both
		"x-axis" and "y-axis" subscripts specified for all points in
		the output array.

	In either case, IX must satisfy the expression,
		    0 <= MIN(IX) < N0  and 0 < MAX(IX) <= N0
	where N0 is the total number of subscripts in the first dimension
	of P.

	JY can be one of two types:
	     1) A one-dimensional, floating-point array of subscripts to look
		up in P.  The same set of subscripts is used for all rows in
		the output array.
	     2) A two-dimensional, floating-point array that contains both
               "x-axis" and "y-axis" subscripts specified for all points in
               the output array.

	    In either case JY must satisfy the expression,
		    0 <= MIN(JY) < M0  and 0 < MAX(JY) <= M0
	    where M0 is the total number of subscripts in the second dimension
	    of P.

  	It is better to use two-dimensional arrays for IX and JY when calling
  	BILINEAR because the algorithm is somewhat faster.  If IX and JY are
  	one-dimensional, they are converted to two-dimensional arrays on
  	return from the function.  The new IX and JY can be re-used on
	subsequent calls to take advantage of the faster, 2D algorithm.  The
	2D array P is unchanged upon return.

 KEYWORDS:
   MISSING: The value to return for elements outside the bounds of P.
       If this keyword is not specified, interpolated positions that fall
       outside the bounds of the array P - that is, elements of the IX or JY
       arguments that are either less than zero or greater than the largest
       subscript in the corresponding dimension of P - are set equal to the
       value of the nearest element of P.

 OUTPUT:
	The two-dimensional, floating-point, interpolated array.

 RESTRICTIONS:
	None.

 EXAMPLE:
	Suppose P = FLTARR(3,3), IX = [.1, .2], and JY = [.6, 2.1] then
	the result of the command:
		Z = BILINEAR(P, IX, JY)
	Z(0,0) will be returned as though it where equal to P(.1,.6)
	interpolated from the nearest neighbors at P(0,0), P(1,0), P(1,1)
	and P(0,1).

 PROCEDURE:
	Uses bilinear interpolation algorithm to evaluate each element
	in the result  at virtual coordinates contained in IX and JY with
	the data in P.

 REVISION HISTORY:
       Nov. 1985  Written by L. Kramer (U. of Maryland/U. Res. Found.)
	Aug. 1990  TJA simple bug fix, contributed by Marion Legg of NASA Ames
	Sep. 1992  DMS, Scrapped the interpolat part and now use INTERPOLATE
   July 2003, CT: Rewrote to improve error checking and efficiency.
                  Added MISSING keyword.


BIN_DATE $RSI/bin_date.pro
[Previous] [Next]
 NAME:
	BIN_DATE

 PURPOSE:
	This function converts a standard form ascii date/time string
	to a binary string.

 CATEGORY:
	Date/time functions.

 CALLING SEQUENCE:
	Result = BIN_DATE(Asc_time)

 INPUTS:
	Asc_time: the date/time to convert in standard ascii format.
		  If omitted, use the current date/time.  
	  	  Standard form is a 24 character string:
			DOW MON DD HH:MM:SS YYYY
		  where: DOW = day of week, MON = month, DD=day of month,
			HH:MM:SS = hour/minute/second, YYYY = year.

 OUTPUTS:
	This function returns a 6 element integer array containing:
 	Element 0 = year	e.g. 1992
		1 = month	1-12
		2 = day		1-31
		3 = hour	0-23
		4 = minute	0-59
		5 = second	0-59

 SIDE EFFECTS:
	None.

 RESTRICTIONS:
	None.

 PROCEDURE:
	Straightforward.

 MODIFICATION HISTORY:
 	Written by:	DMS /RSI, Jul, 1992.
	Modified to use STR_SEP function, DMS, Dec. 1995.
       Fixed bug when passed single digit dates
			KDB, Nov, 01 1996
	Replaced use of obsolete STR_SEP with STRTOK, AB, 23 Feb 1999


BINARY_TEMPLATE $RSI/binary_template.pro
[Previous] [Next]
 NAME:
       BINARY_TEMPLATE

 PURPOSE:
       Generate a "template" structure that describes a binary file.

 CATEGORY:
       Input/Output.

 CALLING SEQUENCE:
       template = BINARY_TEMPLATE( [file] )

 INPUTS:
       FILE:  A string indicating a sample data file that will be used
              to test the validity of user input "on the fly" as the
              user interacts with Binary_Template's GUI.  The file
              should contain the kind of data for which a template
              is being defined.  As the user specifies fields via
              Binary_Template's GUI, Binary_Template attempts to
              read this file "behind the scenes" using the user's
              specifications.  If errors occur during such a test
              read, Binary_Template displays a Dialog_Message
              indicating where in the user's specifications
              a correction may be required.

              Default: if FILE is not supplied, binary_template will
              prompt the user for a file via DIALOG_PICKFILE.

 INPUT KEYWORD PARAMETERS:
       TEMPLATE: An initial template structure.

       GROUP_LEADER: The widget ID of a widget that calls Binary_Template.
              When this ID is specified, a death of the caller results in a
              death of Binary_Template.

       N_ROWS: Specifies the YSIZE of Binary_Template's WIDGET_TABLE.

 OUTPUT KEYWORD PARAMETERS:
       CANCEL: Set to 1 if the user clicked cancel, else set to 0.

 OUTPUTS:
       Function Binary_Template normally returns an anonymous structure.
       If the user cancels Binary_Template and no initial template was
       supplied the function returns zero.  If the user cancels
       Binary_Template and an initial template was supplied (via
       the TEMPLATE keyword), the initial template is returned.

 CALLS: ***
	BINARY_TEMPLATE_EVENT, BT_DELETE_ITEM_FROM_ARRAY, BT_ENTRY_IS_VALID
	BT_MODIFY_FIELD, BT_MODIFY_FIELD_EVENT, BT_PURGE_NON_DIGITS
	BT_PUT_VAL_INTO_ARRAY, BT_RAKE, BT_TYPECODE, BT_TYPESTRING
	BT_UPDATE_FIELD_DISPLAY, CW_BGROUP, CW_FIELD, RB_DIM_STR, RB_EXPRESSION_IS_VALID
	RB_IS_INTEGRAL, RB_ROUTINES, RB_TEMPLATE_IS_VALID
	RB_TEMPLATE_IS_VALID_INTERNAL, SWAP_ENDIAN_INPLACE, UNIQ, XMANAGER
 CALLED BY:
	IDLitUIBinaryTemplate, IMPORT_BINARY
 EXAMPLE:
       datafile = filepath('hurric.dat', subdir=['examples', 'data'])
       ;
       ;Use Binary_Template to interactively define a 440x340 field
       ;of type BYTE, named "img".
       ;
       template = binary_template(datafile)
       ;
       ;Use the resulting template to read a file.
       ;
       data = read_binary(datafile, template=template)
       ;
       ;Display results.
       ;
       tvscl, data.img

 MODIFICATION HISTORY
       PCS, 6/1999 - Written.


BINOMIAL $RSI/binomial.pro
[Previous] [Next]
 NAME:
       BINOMIAL

 PURPOSE:
       This function computes the probabilty (bp) such that:
                   Probability(X => v) = bp
       where X is a random variable from the cumulative binomial distribution
       (Bernouli distribution).

 CATEGORY:
       Statistics.

 CALLING SEQUENCE:
       Result = Binomial(V, N, P)

 INPUTS:
       V:    A non-negative integer specifying the minimal number of
             times an event E occurs in (N) independent performances.

       N:    A non-negative integer specifying the number of performances.

       P:    A non-negative scalar or array, in the interval [0.0, 1.0],
             of type float or double that specifies the probability of
             occurrence or success of a single independent performance.

 KEYWORDS:

    DOUBLE = Set this keyword to force the computation to be done in
             double-precision arithmetic.

    GAUSSIAN = Set this keyword to force the computation to be done using
               the Gaussian approximation.

 EXAMPLES:
       Compute the probability of obtaining at least two 6s in rolling a
       die four times. The result should be 0.131944
         result = binomial(2, 4, 1./6.)

       Compute the probability of obtaining exactly two 6s in rolling a
       die four times. The result should be 0.115741
         result = binomial(2, 4, 1./6.) - binomial(3, 4, 1./6.)

       Compute the probability of obtaining three or fewer 6s in rolling
       a die four times. The result should be 0.999228
         result = (binomial(0, 4, 1./6.) - binomial(1, 4, 1./6.)) + $
                  (binomial(1, 4, 1./6.) - binomial(2, 4, 1./6.)) + $
                  (binomial(2, 4, 1./6.) - binomial(3, 4, 1./6.)) + $
                  (binomial(3, 4, 1./6.) - binomial(4, 4, 1./6.))

 CALLS: ***
	GAUSS_PDF
 CALLED BY:
	S_TEST
 PROCEDURE:
       BINOMIAL computes the probability that an event E occurs at least
       (V) times in (N) independent performances. The event E is assumed
       to have a probability of occurance or success (P) in a single
       performance.

       If an overflow occurs during computation, then the Gaussian
       distribution is used to approximate the cumulative binomial
       distribution.

 REFERENCE:
       ADVANCED ENGINEERING MATHEMATICS (seventh edition)
       Erwin Kreyszig
       ISBN 0-471-55380-8

       Schaum's Outline of Theory and Problems of Probability and Statistics,
       M.R. Spiegel, McGraw-Hill, 1975.

 MODIFICATION HISTORY:
       Modified by:  GGS, RSI, July 1994
                     Minor changes to code. Rewrote documentation header.
       CT, RSI, June 2000: Added keywords DOUBLE, GAUSSIAN;
           changed algorithm to use LNGAMMA function;
           doesn't use Gaussian unless overflow or /GAUSSIAN;
           now allows array input for P.


BISECT_PDF $RSI/bisect_pdf.pro
[Previous] [Next]
 NAME:
       BISECT_PDF

 PURPOSE:
       This function computes the cutoff value x such that the probabilty
       of an observation from the given distribution, less than x, is a(0).
       u and l are the upper and lower limits for x, respectively.
       a(1) and a(2) are degrees of freedom, if appropriate.
       funct is a string specifying the probability density function.
       BISECT_PDF is not intended to be a user-callable function.
 CALLED BY:
	CHISQR_CVF, F_CVF, GAUSS_CVF, T_CVF


BLK_CON $RSI/blk_con.pro
[Previous] [Next]
 NAME:
       BLK_CON

 PURPOSE:
       This function computes a "fast convolution" of a digital signal
       and an impulse-response sequence.

 CATEGORY:
       Digital Signal Processing

 CALLING SEQUENCE:
       Result = BLK_CON(Filter, Signal, B_length = B_length)

 INPUTS:
       Filter = A P-element floating-point vector containing the impulse-
                response sequence of the digital filter.
       Signal = An N-element floating-point vector containing the discrete
                signal samples.

 KEYWORD PARAMETERS:
       B_length = (Block Length) An integer specifying the length of
                  the subdivided signal segments. If this paramter is
                  not specified, a near-optimal value is chosen by the
                  algorithm based upon the length of the impulse-response
                  sequence, P. If P is a value less than 11 or greater
                  than 377, then B_length must be specified.

 RESTRICTIONS:
       1) The block length must be greater than the filter length.
          B_length > P
       2) The block length must be less than the number of signal samples.
          B_length < N_elements(Signal)

 EXAMPLE:
       Create an impulse-response sequence of length P = 32.
         filter = replicate(1.0, 32) ;Set all points to 1.0
         filter(2*indgen(16)) = 0.5  ;Set even points to 0.5

       Create a sampled signal with random noise.
         signal = sin((findgen(1000)/35.0)^2.5)
         noise  = (randomu(SEED,1000)-0.5)/2
         signal = signal + noise

       Convolve the filter and signal using block convolution.
         result = BLK_CON(filter, signal)

 PROCEDURE:
       Implementation of the "overlap-save" method in the frequency domain.
       The discrete signal samples are divided into overlapping segments of
       a length specified by the parameter B_length. B_length may be supplied
       by the user as an optional keyword parameter or determined by the
       algorithm to a near-optimal value. Each input segment consists of P-1
       samples from the previous input segment and (B_length-P+1) new signal
       samples, where P is the length of the filter. Each of these segments
       is processed in the frequency domain and then 'reassembled' in the
       time domain. The first and last input segments are handled differently.
       The result is an N-element floating-point vector containing the
       filtered signal.

 REFERENCE:
       Oppenheim, A.V. and Schafer, R.W.
       DIGITAL SIGNAL PROCESSING
       Prentice-Hall, 1975

 MODIFICATION HISTORY:
           Written by:  GGS, RSI, May 1993
           Modified:    GGS, RSI, June 1994
                        Added long indexing into vectors. Minor changes in
                        the use of intermediate variables reduces memory
                        allocation in certain instances. Made slight changes
                        to the documentation header.


BOX_CURSOR $RSI/box_cursor.pro
[Previous] [Next]
 NAME:
	BOX_CURSOR

 PURPOSE:
	Emulate the operation of a variable-sized box cursor (also known as
	a "marquee" selector).

 CATEGORY:
	Interactive graphics.

 CALLING SEQUENCE:
	BOX_CURSOR, x0, y0, nx, ny [, INIT = init] [, FIXED_SIZE = fixed_size]

 INPUTS:
	No required input parameters.

 OPTIONAL INPUT PARAMETERS:
	x0, y0, nx, and ny give the initial location (x0, y0) and
	size (nx, ny) of the box if the keyword INIT is set.  Otherwise, the
	box is initially drawn in the center of the screen.

 KEYWORD PARAMETERS:
	INIT:  If this keyword is set, x0, y0, nx, and ny contain the initial
	parameters for the box.

	FIXED_SIZE:  If this keyword is set, nx and ny contain the initial
	size of the box.  This size may not be changed by the user.

	MESSAGE:  If this keyword is set, print a short message describing
	operation of the cursor.

 OUTPUTS:
	x0:  X value of lower left corner of box.
	y0:  Y value of lower left corner of box.
	nx:  width of box in pixels.
	ny:  height of box in pixels.

	The box is also constrained to lie entirely within the window.

 CALLED BY:
	H_EQ_CT
 COMMON BLOCKS:
	None.

 SIDE EFFECTS:
	A box is drawn in the currently active window.  It is erased
	on exit.

 RESTRICTIONS:
	Works only with window system drivers.

 PROCEDURE:
	The graphics function is set to 6 for eXclusive OR.  This
	allows the box to be drawn and erased without disturbing the
	contents of the window.

	Operation is as follows:
	Left mouse button:   Move the box by dragging.
	Middle mouse button: Resize the box by dragging.  The corner
		nearest the initial mouse position is moved.
	Right mouse button:  Exit this procedure, returning the
			     current box parameters.

 MODIFICATION HISTORY:
	DMS, April, 1990.
	DMS, April, 1992.  Made dragging more intutitive.
	June, 1993 - Bill Thompson
			prevented the box from having a negative size.
       SJL, Nov, 1997.  Formatted, conform to IDL style guide.
                       Prevented crash from unitialized corner.
       RJF, Feb, 1998. Replaced !ERROR_STATE.CODE w/ !MOUSE.BUTTON and
			fixed some problems w/sizing when a corner might swap.
       DES, Oct, 1998. Fixed problem when a second btn is pressed before
			the first was released.  Also corrected problem of checking state
			of !MOUSE.BUTTON instead of the local variable "button".
  CT, RSI, May 2000: Add error checking; removed GOTO.
        Add left+right button=middle button logic.


butterworth $RSI/butterworth.pro
[Previous] [Next]
; NAME:
;   Butterworth
;
; PURPOSE:
;   This function returns an array which contains the Butterworth
;   kernel for a given input order and cutoff.
;
; PARAMETERS:
;   XIN - (required) Either a scalar containing the number of
;         elements in the X direction or a vector up to 3 elements
;         long giving the number of elements in the X, Y, and Z
;         directions, respectively.
;
;   YIN - The number of elements in the Y direction.  
;   
;   ZIN - The number of elements in the Z direction.
;   
; KEYWORDS:
;   CUTOFF - The cutoff frequency.
;
;   ORDER - The order of the filter.
;
;   ORIGIN - IF set, center the return array at the corners of the
;            array.
;
;   XDIM - The X spacing of the columns.
;
;   YDIM - The Y spacing of the rows.
;
;   ZDIM - The Z spacing of the planes.
;
; MODIFICATION HISTORY:
;   Created by:  AGEH, November 2005
 CALLS: ***
	REAL_PART