Overview Schemas Index

MATHEMATICAL_FUNCTIONS_SCHEMA (jsdai.SMathematical_functions_schema)


FUNCTION member_of
          (val : GENERIC:g, spc : maths_space) : LOGICAL;

FUNCTION fedex(val : AGGREGATE OF  GENERIC:X;
                 i   : INTEGER) : GENERIC:X;
    RETURN  (val[i]);
  END_FUNCTION;  -- fedex

  LOCAL
    v : maths_value := simplify_maths_value (convert_to_maths_value (val));
    vtypes : SET  OF  STRING  := stripped_typeof (v);
    s : maths_space := simplify_maths_space (spc);
    stypes : SET  OF  STRING := stripped_typeof (s);
    tmp_int : INTEGER;
    tmp_real : REAL;
    tmp_cmplx : complex_number_literal;
    lgcl, cum : LOGICAL;
    vspc, sspc : maths_space;
    smem : SET OF  maths_value;
    factors : LIST OF  maths_space;
  END_LOCAL;
  IF  NOT  EXISTS  (s) THEN
    RETURN  (FALSE);
  END_IF;
  IF  NOT  EXISTS (v) THEN
    RETURN  (s = the_generics);
  END_IF;
  IF  ('GENERIC_EXPRESSION' IN  vtypes) AND
    NOT  ('MATHS_SPACE' IN  vtypes) AND
    NOT  ('MATHS_FUNCTION' IN  vtypes) AND
    NOT  ('COMPLEX_NUMBER_LITERAL' IN  vtypes) THEN
    IF  has_values_space (v) THEN
      vspc := values_space_of (v);
      IF  subspace_of (vspc, s) THEN
        RETURN  (TRUE);
      END_IF;
      IF  NOT  compatible_spaces (vspc, s) THEN
        RETURN  (FALSE);
      END_IF;
      RETURN  (UNKNOWN);
    END_IF;
    RETURN  (UNKNOWN);
  END_IF;
  IF  'ELEMENTARY_SPACE' IN  stypes THEN
    CASE  s\elementary_space.space_id OF
    es_numbers :  RETURN  (('NUMBER' IN  vtypes) OR
                          ('COMPLEX_NUMBER_LITERAL' IN  vtypes));
    es_complex_numbers :  RETURN  ('COMPLEX_NUMBER_LITERAL' IN  vtypes);
    es_reals :  RETURN  (('REAL' IN  vtypes) AND  NOT  ('INTEGER' IN  vtypes));
    es_integers :  RETURN  ('INTEGER' IN  vtypes);
    es_logicals :  RETURN  ('LOGICAL' IN  vtypes);
    es_booleans :  RETURN  ('BOOLEAN' IN  vtypes);
    es_strings :  RETURN  ('STRING' IN  vtypes);
    es_binarys :  RETURN  ('BINARY' IN  vtypes);
    es_maths_spaces :  RETURN  ('MATHS_SPACE' IN  vtypes);
    es_maths_functions :  RETURN  ('MATHS_FUNCTION' IN  vtypes);
    es_generics :  RETURN  (TRUE);
    END_CASE;
  END_IF;
  IF  'FINITE_INTEGER_INTERVAL' IN  stypes THEN
    IF  'INTEGER' IN  vtypes THEN
      tmp_int := v;
      RETURN  ({s\finite_integer_interval.min <= tmp_int <=
        s\finite_integer_interval.max});
    END_IF;
    RETURN  (FALSE);
  END_IF;
  IF  'INTEGER_INTERVAL_FROM_MIN' IN  stypes THEN
    IF  'INTEGER' IN  vtypes THEN
      tmp_int := v;
      RETURN  (s\integer_interval_from_min.min <= tmp_int);
    END_IF;
    RETURN  (FALSE);
  END_IF;
  IF  'INTEGER_INTERVAL_TO_MAX' IN  stypes THEN
    IF  'INTEGER' IN  vtypes THEN
      tmp_int := v;
      RETURN  (tmp_int <= s\integer_interval_to_max.max);
    END_IF;
    RETURN  (FALSE);
  END_IF;
  IF  'FINITE_REAL_INTERVAL' IN  stypes THEN
    IF  ('REAL' IN  vtypes) AND  NOT  ('INTEGER' IN  vtypes) THEN
      tmp_real := v;
      IF  s\finite_real_interval.min_closure = closed THEN
        IF  s\finite_real_interval.max_closure = closed THEN
          RETURN  ({s\finite_real_interval.min <= tmp_real <=
            s\finite_real_interval.max});
        ELSE
          RETURN  ({s\finite_real_interval.min <= tmp_real <
            s\finite_real_interval.max});
        END_IF;
      ELSE
        IF  s\finite_real_interval.max_closure = closed THEN
          RETURN  ({s\finite_real_interval.min < tmp_real <=
            s\finite_real_interval.max});
        ELSE
          RETURN  ({s\finite_real_interval.min < tmp_real <
            s\finite_real_interval.max});
        END_IF;
      END_IF;
    END_IF;
    RETURN  (FALSE);
  END_IF;
  IF  'REAL_INTERVAL_FROM_MIN' IN  stypes THEN
    IF  ('REAL' IN  vtypes) AND  NOT  ('INTEGER' IN  vtypes) THEN
      tmp_real := v;
      IF  s\real_interval_from_min.min_closure = closed THEN
        RETURN  (s\real_interval_from_min.min <= tmp_real);
      ELSE
        RETURN  (s\real_interval_from_min.min < tmp_real);
     END_IF;
    END_IF;
    RETURN  (FALSE);
  END_IF;
  IF  'REAL_INTERVAL_TO_MAX' IN  stypes THEN
    IF  ('REAL' IN  vtypes) AND  NOT  ('INTEGER' IN  vtypes) THEN
      tmp_real := v;
      IF  s\real_interval_to_max.max_closure = closed THEN
        RETURN  (tmp_real <= s\real_interval_to_max.max);
      ELSE
        RETURN  (tmp_real < s\real_interval_to_max.max);
     END_IF;
    END_IF;
    RETURN  (FALSE);
  END_IF;
  IF  'CARTESIAN_COMPLEX_NUMBER_REGION' IN  stypes THEN
    IF  'COMPLEX_NUMBER_LITERAL' IN  vtypes THEN
      RETURN  (member_of(v\complex_number_literal.real_part,
        s\cartesian_complex_number_region.real_constraint) AND
        member_of(v\complex_number_literal.imag_part,
        s\cartesian_complex_number_region.imag_constraint));
    END_IF;
    RETURN  (FALSE);
  END_IF;
  IF  'POLAR_COMPLEX_NUMBER_REGION' IN  stypes THEN
    IF  'COMPLEX_NUMBER_LITERAL' IN  vtypes THEN
      tmp_cmplx := v;
      tmp_cmplx.real_part := tmp_cmplx.real_part -
        s\polar_complex_number_region.centre.real_part;
      tmp_cmplx.imag_part := tmp_cmplx.imag_part -
        s\polar_complex_number_region.centre.imag_part;
      tmp_real := SQRT (tmp_cmplx.real_part**2 + tmp_cmplx.imag_part**2);
      IF  NOT member_of(tmp_real,
        s\polar_complex_number_region.distance_constraint) THEN
        RETURN  (FALSE);
      END_IF;
      IF  tmp_real = 0.0 THEN
        RETURN  (TRUE);  -- The centre has no direction.
      END_IF;
      tmp_real := atan2(tmp_cmplx.imag_part,tmp_cmplx.real_part);
      RETURN  (member_of(tmp_real,
        s\polar_complex_number_region.direction_constraint) OR
        member_of(tmp_real + 2.0*PI,
        s\polar_complex_number_region.direction_constraint));
    END_IF;
    RETURN  (FALSE);
  END_IF;
  IF  'FINITE_SPACE' IN  stypes THEN
    smem := s\finite_space.members;
    cum := FALSE;
    REPEAT  i := 1 TO  SIZEOF  (smem);
      cum := cum OR equal_maths_values(v,smem[i]);
      IF  cum = TRUE THEN
        RETURN  (TRUE);
      END_IF;
    END_REPEAT;
    RETURN  (cum);
  END_IF;
  IF  'UNIFORM_PRODUCT_SPACE' IN  stypes THEN
    IF  'LIST' IN  vtypes THEN
      IF  SIZEOF  (v) = s\uniform_product_space.exponent THEN
        sspc := s\uniform_product_space.base;
        cum := TRUE;
        REPEAT  i := 1 TO  SIZEOF  (v);
          cum := cum AND  member_of(v[i],sspc);
--          cum := cum AND  member_of (fedex (v, i), sspc);
            -- See note above FOR  explanation OF  fedex()
          IF  cum = FALSE  THEN
            RETURN  (FALSE);
          END_IF;
        END_REPEAT;
        RETURN  (cum);
      END_IF;
    END_IF;
    RETURN  (FALSE);
  END_IF;
  IF  'LISTED_PRODUCT_SPACE' IN  stypes THEN
    IF  'LIST' IN  vtypes THEN
      factors := s\listed_product_space.factors;
      IF  SIZEOF  (v) = SIZEOF  (factors) THEN
        cum := TRUE;
        REPEAT  i := 1 TO  SIZEOF  (v);
          cum := cum AND  member_of(v[i],factors[i]);
--          cum := cum AND  member_of (fedex (v, i), factors[i]);
            -- See note above FOR  explanation OF  fedex()
          IF  cum = FALSE  THEN
            RETURN  (FALSE);
          END_IF;
        END_REPEAT;
        RETURN  (cum);
      END_IF;
    END_IF;
    RETURN  (FALSE);
  END_IF;
  IF  'EXTENDED_TUPLE_SPACE' IN  stypes THEN
    IF  'LIST' IN  vtypes THEN
      sspc := s\extended_tuple_space.base;
      tmp_int := space_dimension(sspc);
      IF  SIZEOF  (v) >= tmp_int THEN
        cum := TRUE;
        REPEAT  i := 1 TO  tmp_int;
          cum := cum AND  member_of(v[i],factor_space(sspc,i));
--          cum := cum AND  member_of (fedex (v, i), factor_space (sspc, i));
            -- See note above FOR explanation OF fedex()
          IF  cum = FALSE  THEN
            RETURN  (FALSE);
          END_IF;
        END_REPEAT;
        sspc := s\extended_tuple_space.extender;
        REPEAT i := tmp_int+1 TO SIZEOF (v);
          cum := cum AND  member_of(v[i],sspc);
          IF  cum = FALSE  THEN
            RETURN  (FALSE);
          END_IF;
        END_REPEAT;
        RETURN  (cum);
      END_IF;
    END_IF;
    RETURN  (FALSE);
  END_IF;
  IF  'FUNCTION_SPACE' IN  stypes THEN
    IF  'MATHS_FUNCTION' IN vtypes THEN
      vspc := v\maths_function.domain;
      sspc := s\function_space.domain_argument;
      CASE  s\function_space.domain_constraint OF
      sc_equal : cum := equal_maths_spaces (vspc, sspc);
      sc_subspace : cum := subspace_of (vspc, sspc);
      sc_member : cum := member_of (vspc, sspc);
      END_CASE;
      IF cum = FALSE THEN
        RETURN  (FALSE);
      END_IF;
      vspc := v\maths_function.range;
      sspc := s\function_space.range_argument;
      CASE s\function_space.range_constraint OF
      sc_equal : cum := cum AND  equal_maths_spaces (vspc, sspc);
      sc_subspace : cum := cum AND  subspace_of (vspc, sspc);
      sc_member : cum := cum AND member_of (vspc, sspc);
      END_CASE;
      RETURN  (cum);
    END_IF;
    RETURN  (FALSE);
  END_IF;
  -- Should be unreachable
  RETURN (UNKNOWN);

END_FUNCTION; -- member_of

public class FMember_of
          public static Value run(SdaiContext _context, Value val, Value spc)