# Copyright (C) 2010 Jelmer Ypma. All Rights Reserved.
# This code is published under the Eclipse Public License.
#
# File: is.ipoptr.R
# Author: Jelmer Ypma
# Date: 18 April 2010
#
# Input: object
# Output: bool telling whether the object is an ipoptr or not
#
# Changelog:
# 09/03/2012: Removed ipoptr_environment because this caused a bug in combination with
# data.table and it wasn't useful (thanks to Florian Oswald for reporting)
is.ipoptr <- function(x) {
# Check whether the object exists and is a list
if( is.null(x) ) { return( FALSE ) }
if( !is.list(x) ) { return( FALSE ) }
# Define local flag defining whether we approximate the Hessian or not
flag_hessian_approximation = FALSE
if ( !is.null( x$options$string$hessian_approximation ) ) {
flag_hessian_approximation = ( x$options$string$hessian_approximation == "limited-memory" )
}
# Check whether the needed functions are supplied
stopifnot( is.function(x$eval_f) )
stopifnot( is.function(x$eval_grad_f) )
stopifnot( is.function(x$eval_g) )
stopifnot( is.function(x$eval_jac_g) )
if ( !flag_hessian_approximation ) { stopifnot( is.function(x$eval_h) ) }
# Check whether bounds are defined for all controls
stopifnot( length( x$x0 ) == length( x$lower_bounds ) )
stopifnot( length( x$x0 ) == length( x$upper_bounds ) )
# Check whether the initial value is within the bounds
stopifnot( all( x$x0 >= x$lower_bounds ) )
stopifnot( all( x$x0 <= x$upper_bounds ) )
num.controls <- length( x$x0 )
num.constraints <- length( x$constraint_lower_bounds )
# Check the length of some return values
stopifnot( length(x$eval_f( x$x0 ))==1 )
stopifnot( length(x$eval_grad_f( x$x0 ))==num.controls )
stopifnot( length(x$eval_g( x$x0 ))==num.constraints )
stopifnot( length(x$eval_jac_g( x$x0 ))==length(unlist(x$eval_jac_g_structure)) ) # the number of non-zero elements in the Jacobian
if ( !flag_hessian_approximation ) {
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
}
# Check the whether we don't have NA's in initial values
stopifnot( all(!is.na(x$eval_f( x$x0 ))) )
stopifnot( all(!is.na(x$eval_grad_f( x$x0 ))) )
stopifnot( all(!is.na(x$eval_g( x$x0 ))) )
stopifnot( all(!is.na(x$eval_jac_g( x$x0 ))) ) # the number of non-zero elements in the Jacobian
if ( !flag_hessian_approximation ) {
stopifnot( all(!is.na(x$eval_h( x$x0, 1, rep(1,num.constraints) ))) ) # the number of non-zero elements in the Hessian
}
# Check whether a correct structure was supplied, and check the size
stopifnot( is.list(x$eval_jac_g_structure) )
stopifnot( length(x$eval_jac_g_structure)==num.constraints )
if ( !flag_hessian_approximation ) {
stopifnot( length(x$eval_h_structure)==num.controls )
stopifnot( is.list(x$eval_h_structure) )
}
# Check the number of non-linear constraints
stopifnot( length(x$constraint_lower_bounds)==length(x$constraint_upper_bounds) )
# Check whether none of the non-zero indices are larger than the number of controls
# Also, the smallest index should be bigger than 0
if ( length( x$eval_jac_g_structure ) > 0 ) {
stopifnot( max(unlist(x$eval_jac_g_structure)) <= num.controls )
stopifnot( min(unlist(x$eval_jac_g_structure)) > 0 )
}
if ( !flag_hessian_approximation ) {
stopifnot( max(unlist(x$eval_h_structure)) <= num.controls )
stopifnot( min(unlist(x$eval_h_structure)) > 0 )
}
# Check whether option to approximate hessian and eval_h are both set
# If we approximate the hessian, then we don't want to set eval_h
if ( flag_hessian_approximation ) {
if( !is.null( x$eval_h ) ) {
warning("Option supplied to approximate hessian, but eval_h is defined.\nSolution: remove option hessian_approximation=limited-memory to use analytic derivatives.")
}
if( !is.null( x$eval_h_structure ) ) {
warning("Option supplied to approximate hessian, but eval_h_structure is defined.\nSolution: remove option hessian_approximation=limited-memory to use analytic derivatives.")
}
}
return( TRUE )
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.