############################################################################
#
#	Name:	 retrops.icn
#
#	Title:	 logical operations for retrievals
#
#	Author:	 Richard L. Goerwitz
#
#	Version: 1.17
#
############################################################################
#
#  The following collection of procedures implements logical
#  and/or/and_not operations for the retrieve text-retrieval package.
#  Their general form is
#
#      r_op(set1, set2, filename, field, range)
#
#  where op = one of either and, or, or and_not.  The field and range
#  arguments are optional.
#
#  To illustrate how these operations are performed, let me explain
#  how one of the procedures below, r_and(), works.  Let us assume we
#  have retrieve()d bitmap sets for two patterns in a single indexed
#  file.  Call the sets set1 and set2.  Call the file filename.  These
#  two sets are passed to r_and() as arguments one and two.  R_and()
#  takes the intersection of these two sets.  The result is a
#  collection of all bitmaps pointing to blocks in filename containing
#  words matching *both* of the two patterns used to generate set1 and
#  set2.  R_and() returns this result to the calling procedure.
#
#  Note that, by default, r_and() retrieves co-ocurrences of patterns
#  within a single block.  If the programmer wishes to find
#  co-ocurrences within larger units, he or she may supply a field
#  argument.  Fields are fixed width bit-fields into which location
#  markers for filename are divided, numbered from the largest and
#  most general to the smallest and most specific.  See the file
#  makeind for a discussion of how they are handled.  A range
#  parameter may also be specified, which makes it possible to look
#  for coocurrences in collections of more than one unit of the type
#  specified in the field argument.
#
############################################################################
#
#  Links: none
#
#  See also: retrieve.icn, makeind.icn
#
############################################################################

# The following globals contain stats for current file (here, arg 3).
# global filestats    # declared in initfile.icn
# global IS           # declared in indexutl.icn

procedure r_or(set1, set2, filename, field, range)

    # Check for sloppy programming.
    /filename & abort("apply_op", "you gotta call me with a filename", 43)
    type(set1) == ("list"|"set") |
	abort("apply_op","arg 1 must be a list/set",45)
    type(set2) == ("list"|"set") |
	abort("apply_op","arg 2 must be a list/set",46)

    # Be sure to convert lists to sets.  Personally, I think list -> set
    # conversions should be as automatic in Icon as their string -> cset
    # correspondents.
    type(set1) == "set" | (set1 := set(set1))
    type(set2) == "set" | (set2 := set(set2))

    # No need to initialize variables.  Field and range are
    # meaningless for this op.
    return set1 ++ set2

end

procedure r_and(set1, set2, filename, field, range)
    # set intersection
    return apply_op("**", set1, set2, filename, field, range)
end

procedure r_and_not(set1, set2, filename, field, range)
    # simpler way of saying X and not Y, or Y and not X
    return apply_op("--", set1, set2, filename, field, range)
end


procedure apply_op(op, set1, set2, filename, field, range)

    local r_shift, tbl, elem, set1a, set2a, set3, set4, shifted_elem, elem2

    # globals:
    #
    # IS is a global record in which will be stored important stats for
    # the file named in arg 4 (filename).  We will be using two of IS's
    # fields:
    #
    # IS.len   = the number of bits needed to hold an integer
    #             representation of a single field in filename
    # IS.no    = number of fields for filename
    #
    # Filestats is a global table which contains various important stats
    # for every file that's been accessed.  These stats are kept in a
    # record of type Fs
    #  
    #     record Fs(ind_filename, bmp_filename, lim_filename, unt_filename
    #               IS, ofs_table)
    #
    # Fs is declared in initfile.icn; here all we need is Fs.IS,
    # which we access via filestats[filename].IS.  Initfile() sets up
    # filestats for filename, but we shouldn't call it here.  It has
    # (or should already have) been called by retrieve().
    #

    # Check for sloppy programming.
    /filename & abort("apply_op", "you gotta call me with a filename", 43)
    type(set1) == ("list"|"set") |
	abort("apply_op","arg 1 must be a list/set",47)
    type(set2) == ("list"|"set") |
	abort("apply_op","arg 2 must be a list/set",48)

    # Initialize important variables.
    #
    if /filestats | /filestats[filename]
    then abort("apply_op", "can't apply_op before retrieve()ing", 44)
    IS := filestats[filename].IS      # re-initialize IS for current file

    /field := IS.no; field := IS.no - field
    (/range := 0) | (range := abs(range))
    IS.no >= field >= 0 | abort("apply_op", "field out of range", 40)
    range >= 0 | abort("apply_op", "no negative ranges, please!", 41)

    if field = range = 0 then {
	type(set1) ~== "set" & set1 := set(set1)
	type(set2) ~== "set" & set2 := set(set2)
	# no need to shift anything around
	return op(set1, set2)
    } else {
	set1a := set()
	if field = 0 then {
	    # Great, no need to shift out any fields.
	    every elem := !set1 do {
		if abs(elem - !set2) <= range then
		    insert(set1a, elem)
	    }
	    if op == "**"
	    then return set1a
	    else {
		# op == "--"
		(type(set1) == "set") | (set1 := set(set1))
		return (set1 -- set1a)
	    }
	}
	# Uh oh, we need to knock out some fields!
	else {
	    tbl := table()
	    set1a := set(); set2a := set()
	    r_shift := -(field * IS.len)
	    every elem := !set1 do {
		shifted_elem := ishift(elem, r_shift)
		/tbl[shifted_elem] := set()
		insert(tbl[shifted_elem], elem)
		insert(set1a, shifted_elem)
	    }
	    every elem := !set2 do {
		shifted_elem := ishift(elem, r_shift)
		op == "**" & {
		    /tbl[shifted_elem] := set()
		    insert(tbl[shifted_elem], elem)
		}
		insert(set2a, shifted_elem)
	    }
	    set4 := set()
	    if range = 0 then {
		set3 := op(set1a, set2a)
		every insert(set4, !tbl[!set3])
                return set4
	    }
	    # Difficult stuff, field ~= verse, range ~= 0.
	    else {
		if op == "**" then {
		    every elem := !set1a do {
		        # Range is always positive (see above; range
		        # := abs(range)).
			if abs(elem - (elem2 := !set2a)) <= range then
			    every insert(set4, !tbl[elem|elem2])
		    }
		    return set4
		}
		# else if op == "--"
		else {
		    set3 := set()
		    every elem := !set1a do {
			if abs(elem - !set2a) <= range then {
			    insert(set3, elem)
			}
		    }
		    every insert(set4, !tbl[!(set1a -- set3)])
		    return set4
		}
	    }
	}
    }

end