; $Id: dave_evaluate.pro,v 1.4 2005/02/03 18:04:12 azuah Exp $
;###############################################################################
;
; LICENSE:
;  The software in this file is written by an employee of 
;  National Institute of Standards and Technology 
;  as part of the DAVE software project.
;
;  The DAVE software package is not subject to copyright protection
;  and is in the public domain. It should be considered as an
;  experimental neutron scattering data reduction, visualization, and
;  analysis system. As such, the authors assume no responsibility
;  whatsoever for its use, and make no guarantees, expressed or
;  implied, about its quality, reliability, or any other
;  characteristic. The use of certain trade names or commercial
;  products does not imply any endorsement of a particular product,
;  nor does it imply that the named product is necessarily the best
;  product for the stated purpose. We would appreciate acknowledgment
;  if the DAVE software is used of if the code in this file is
;  included in another product.
;
;###############################################################################
;
; Written by J.R.D. Copley.
;************************************************************************************************
function dave_evaluate,_instring,_qtys,_errs
;************************************************************************************************
;
; This function evaluates the expression "_instring" using quantities
; and associated errors contained in *_qtys and *_errs respectively.
; Results for the evaluated expression and its error, assuming that
; the variables are independent so that the errors can be added root
; mean square, are placed in the returned structure.
; If "_instring" cannot be evaluated the returned quantity is a string
; whose first six characters are "_Error".
;
compile_opt strictarr
;
;	This statement ensures that the mathematical function routines
; are compiled.
	_z=ops2d()
;
_instring=strcompress(_instring,/remove_all)
if (_instring eq "") then return,"_Error: Null expression string."
;
;	Convert from infix to modified prefix notation.
; e.g. d+4 becomes (a2d(d,4)).
inftopre,_instring,_outstring,_lvar,_error
if (_error ne "") then return,"_Error: "+_error
;
;	Create sorted list of variables.
_lvar=strupcase(_lvar[uniq(_lvar,sort(_lvar))])
_nvar=n_elements(_lvar)
;
; Check that all of the variables in _instring are present in *_qtys.
_qtynames=strupcase(tag_names(*_qtys))
for _k=0,_nvar-1 do begin
	dummy=where(_lvar[_k] eq _qtynames,_count)
	if (_count eq 0) then return,"_Error: Expression variables are missing from *_qtys."
endfor
;
; Check that *_errs has tag names that match those in *qtys.
_errnames=strupcase(tag_names(*_errs))
_errnames=_errnames[sort(_errnames)]
_nerr=n_elements(_errnames)
_qtynames=_qtynames[sort(_qtynames)]
_nqty=n_elements(_qtynames)
if (_nerr ne _nqty) then return,"_Error: Different numbers of qty and err tag names."
if (total(_errnames eq _qtynames) ne _nqty) then return,"_Error: Mismatched qty and err tag names."
;
; Check that all variables that are not scalars have the same shape.
_nels=intarr(_nvar)
for _i=0,_nvar-1 do begin
	_com1="_nels[_i]=size((*_qtys)."+_lvar[_i]+",/n_elements)"
	if (not execute(_com1)) then return,"_Error: Error executing command _com1"
endfor
;
; _indices contains the indices of the variables that are not scalars.
_indices=where(_nels gt 1,_narrays)
;
if (_narrays gt 1) then begin
	_com2="_dims0=size((*_qtys)."+_lvar[_indices[0]]+",/dimensions)"
	if (not execute(_com2)) then return,"_Error executing command _com2"
	for _i=1,_narrays-1 do begin
		_com3="_dims=size((*_qtys)."+_lvar[_indices[_i]]+",/dimensions)"
		if (not execute(_com3)) then return,"_Error executing command _com3"
		_comparison=(_dims eq _dims0)
		if (total(_comparison) ne n_elements(_comparison)) then return,"_Error: Array shapes mismatch."
	endfor
endif
;
;	Evaluate value of result.
for _i=0,_nvar-1 do begin
	_com4=_lvar[_i]+"={_q:(*_qtys)."+_lvar[_i]+",_e:(*_errs)."+_lvar[_i]+"}"
	if (not execute(_com4)) then return,"_Error executing command _com4"
endfor
;
_com5="_val="+_outstring
if (not execute(_com5)) then return,"_Error executing command _com5"
;
;	Evaluate error on result.
_var=0.0
for _i=0,_nvar-1 do begin
	for _j=0,_nvar-1 do begin
		_com6=_lvar[_j]+"=(*_qtys)."+_lvar[_j]
		if (not execute(_com6)) then return,"_Error executing command _com6"
	endfor
	_com7=_lvar[_i]+"={_q:(*_qtys)."+_lvar[_i]+",_e:(*_errs)."+_lvar[_i]+"}"
	if (not execute(_com7)) then return,"_Error executing command _com7"
	_com8="_sdev="+_outstring
	if (not execute(_com8)) then return,"_Error executing command _com8"
	_var=_var+_sdev.(1)^2
endfor
;
_result=ptr_new({qty:_val.(0),err:sqrt(_var)},/no_copy)
return,_result
;
end
