1# Copyright (C) 2010 Jelmer Ypma. All Rights Reserved.
2# This code is published under the Eclipse Public License.
3#
4# File:   is.ipoptr.R
5# Author: Jelmer Ypma
6# Date:   18 April 2010
7#
8# Input: object
9# Output: bool telling whether the object is an ipoptr or not
10#
11# Changelog:
12#   09/03/2012: Removed ipoptr_environment because this caused a bug in combination with
13#               data.table and it wasn't useful (thanks to Florian Oswald for reporting)
14
15is.ipoptr <- function(x) {
16
17    # Check whether the object exists and is a list
18    if( is.null(x) ) { return( FALSE ) }
19    if( !is.list(x) ) { return( FALSE ) }
20
21    # Define local flag defining whether we approximate the Hessian or not
22    flag_hessian_approximation = FALSE
23    if ( !is.null( x$options$string$hessian_approximation ) ) {
24        flag_hessian_approximation = ( x$options$string$hessian_approximation == "limited-memory" )
25    }
26
27    # Check whether the needed functions are supplied
28    stopifnot( is.function(x$eval_f) )
29    stopifnot( is.function(x$eval_grad_f) )
30    stopifnot( is.function(x$eval_g) )
31    stopifnot( is.function(x$eval_jac_g) )
32    if ( !flag_hessian_approximation ) { stopifnot( is.function(x$eval_h) ) }
33
34    # Check whether bounds are defined for all controls
35    stopifnot( length( x$x0 ) == length( x$lower_bounds ) )
36    stopifnot( length( x$x0 ) == length( x$upper_bounds ) )
37
38    # Check whether the initial value is within the bounds
39    stopifnot( all( x$x0 >= x$lower_bounds ) )
40    stopifnot( all( x$x0 <= x$upper_bounds ) )
41
42    num.controls <- length( x$x0 )
43    num.constraints <- length( x$constraint_lower_bounds )
44
45    # Check the length of some return values
46    stopifnot( length(x$eval_f( x$x0 ))==1 )
47    stopifnot( length(x$eval_grad_f( x$x0 ))==num.controls )
48    stopifnot( length(x$eval_g( x$x0 ))==num.constraints )
49    stopifnot( length(x$eval_jac_g( x$x0 ))==length(unlist(x$eval_jac_g_structure)) )		# the number of non-zero elements in the Jacobian
50    if ( !flag_hessian_approximation ) {
51        stopifnot( length(x$eval_h( x$x0, 1, rep(1,num.constraints) ))==length(unlist(x$eval_h_structure)) )		# the number of non-zero elements in the Hessian
52    }
53
54    # Check the whether we don't have NA's in initial values
55    stopifnot( all(!is.na(x$eval_f( x$x0 ))) )
56    stopifnot( all(!is.na(x$eval_grad_f( x$x0 ))) )
57    stopifnot( all(!is.na(x$eval_g( x$x0 ))) )
58    stopifnot( all(!is.na(x$eval_jac_g( x$x0 ))) )		# the number of non-zero elements in the Jacobian
59    if ( !flag_hessian_approximation ) {
60        stopifnot( all(!is.na(x$eval_h( x$x0, 1, rep(1,num.constraints) ))) )		# the number of non-zero elements in the Hessian
61    }
62
63    # Check whether a correct structure was supplied, and check the size
64    stopifnot( is.list(x$eval_jac_g_structure) )
65
66    stopifnot( length(x$eval_jac_g_structure)==num.constraints )
67    if ( !flag_hessian_approximation ) {
68        stopifnot( length(x$eval_h_structure)==num.controls )
69        stopifnot( is.list(x$eval_h_structure) )
70    }
71
72    # Check the number of non-linear constraints
73    stopifnot( length(x$constraint_lower_bounds)==length(x$constraint_upper_bounds) )
74
75    # Check whether none of the non-zero indices are larger than the number of controls
76    # Also, the smallest index should be bigger than 0
77    if ( length( x$eval_jac_g_structure ) > 0 ) {
78        stopifnot( max(unlist(x$eval_jac_g_structure)) <= num.controls )
79        stopifnot( min(unlist(x$eval_jac_g_structure)) > 0 )
80    }
81    if ( !flag_hessian_approximation ) {
82        stopifnot( max(unlist(x$eval_h_structure)) <= num.controls )
83        stopifnot( min(unlist(x$eval_h_structure)) > 0 )
84    }
85
86    # Check whether option to approximate hessian and eval_h are both set
87    # If we approximate the hessian, then we don't want to set eval_h
88    if ( flag_hessian_approximation ) {
89        if( !is.null( x$eval_h ) ) {
90            warning("Option supplied to approximate hessian, but eval_h is defined.\nSolution: remove option hessian_approximation=limited-memory to use analytic derivatives.")
91        }
92        if( !is.null( x$eval_h_structure ) ) {
93            warning("Option supplied to approximate hessian, but eval_h_structure is defined.\nSolution: remove option hessian_approximation=limited-memory to use analytic derivatives.")
94        }
95    }
96
97
98    return( TRUE )
99}
100