This question already has an answer here:
How to call C function from R?
                                
                                    (1个答案)
                                
                        
                                2年前关闭。
            
                    
我遇到了大规模QP问题,因此我在R中使用了Gurobi优化器。但是,我希望使用广义的顺序最小优化算法,但在R包中找不到它。因此,我尝试调用此C函数,但到目前为止仍失败。

如何从R调用此C函数?

#include <math.h>
#include <stdlib.h>
#include <stdio.h>
#include <string.h>
#include <stdint.h>
#include <limits.h>

#include "libqp.h"

libqp_state_T libqp_gsmo_solver(const double* (*get_col)(uint32_t),
        double *diag_H,
        double *f,
        double *a,
        double b,
        double *LB,
        double *UB,
        double *x,
        uint32_t n,
        uint32_t MaxIter,
        double TolKKT,
        void (*print_state)(libqp_state_T state))
{
  double *col_u;
  double *col_v;
  double *Nabla;
  double minF_up;
  double maxF_low;
  double tau;
  double F_i;
  double tau_ub, tau_lb;
  double Q_P;
  uint32_t i, j;
  uint32_t u, v;
  libqp_state_T state;

  Nabla = NULL;

  /* ------------------------------------------------------------ */
  /* Initialization                                               */
  /* ------------------------------------------------------------ */

  /* Nabla = H*x + f is gradient*/
  Nabla = (double*)LIBQP_CALLOC(n, sizeof(double));
  if( Nabla == NULL )
  {
      state.exitflag=-1;
      goto cleanup;
  }

  /* compute gradient */
  for( i=0; i < n; i++ )
  {
    Nabla[i] += f[i];
    if( x[i] != 0 ) {
      col_u = (double*)get_col(i);
      for( j=0; j < n; j++ ) {
          Nabla[j] += col_u[j]*x[i];
      }
    }
  }

   if( print_state != NULL)
  {
     state.QP = 0;
     for(i = 0; i < n; i++ )
        state.QP += 0.5*(x[i]*Nabla[i]+x[i]*f[i]);

     print_state( state );
  }


  /* ------------------------------------------------------------ */
  /* Main optimization loop                                       */
  /* ------------------------------------------------------------ */

  state.nIter = 0;
  state.exitflag = 100;
  while( state.exitflag == 100 )
  {
    state.nIter ++;

    /* find the most violating pair of variables */
    minF_up = LIBQP_PLUS_INF;
    maxF_low = -LIBQP_PLUS_INF;
    for(i = 0; i < n; i++ )
    {

      F_i = Nabla[i]/a[i];

      if(LB[i] < x[i] && x[i] < UB[i])
      { /* i is from I_0 */
        if( minF_up > F_i) { minF_up = F_i; u = i; }
        if( maxF_low < F_i) { maxF_low = F_i; v = i; }
      }
      else if((a[i] > 0 && x[i] == LB[i]) || (a[i] < 0 && x[i] == UB[i]))
      { /* i is from I_1 or I_2 */
        if( minF_up > F_i) { minF_up = F_i; u = i; }
      }
      else if((a[i] > 0 && x[i] == UB[i]) || (a[i] < 0 && x[i] == LB[i]))
      { /* i is from I_3 or I_4 */
        if( maxF_low < F_i) { maxF_low = F_i; v = i; }
      }
    }

    /* check KKT conditions */
    if( maxF_low - minF_up <= TolKKT )
      state.exitflag = 4;
    else
    {
      /* SMO update of the most violating pair */
      col_u = (double*)get_col(u);
      col_v = (double*)get_col(v);

      if( a[u] > 0 )
         { tau_lb = (LB[u]-x[u])*a[u]; tau_ub = (UB[u]-x[u])*a[u]; }
      else
         { tau_ub = (LB[u]-x[u])*a[u]; tau_lb = (UB[u]-x[u])*a[u]; }

      if( a[v] > 0 )
         { tau_lb = LIBQP_MAX(tau_lb,(x[v]-UB[v])*a[v]); tau_ub =
LIBQP_MIN(tau_ub,(x[v]-LB[v])*a[v]); }
      else
         { tau_lb = LIBQP_MAX(tau_lb,(x[v]-LB[v])*a[v]); tau_ub =
LIBQP_MIN(tau_ub,(x[v]-UB[v])*a[v]); }

      tau = (Nabla[v]/a[v]-Nabla[u]/a[u])/
            (diag_H[u]/(a[u]*a[u]) + diag_H[v]/(a[v]*a[v]) -
2*col_u[v]/(a[u]*a[v]));

      tau = LIBQP_MIN(LIBQP_MAX(tau,tau_lb),tau_ub);

      x[u] += tau/a[u];
      x[v] -= tau/a[v];

      /* update Nabla */
      for(i = 0; i < n; i++ )
         Nabla[i] += col_u[i]*tau/a[u] - col_v[i]*tau/a[v];

    }

     if( state.nIter >= MaxIter )
      state.exitflag = 0;

    if( print_state != NULL)
    {
      state.QP = 0;
      for(i = 0; i < n; i++ )
        state.QP += 0.5*(x[i]*Nabla[i]+x[i]*f[i]);

      print_state( state );
    }

  }

  /* compute primal objective value */
  state.QP = 0;
  for(i = 0; i < n; i++ )
    state.QP += 0.5*(x[i]*Nabla[i]+x[i]*f[i]);

cleanup:

  LIBQP_FREE(Nabla);

  return( state );
}

最佳答案

Dunno,如果您可以从R程序直接调用C函数,但是可以尝试从.so文件中加载符号。

您将C文件编译为动态库(.so),并使用“ dlopen”和“ dlsym”可能会起作用

man dlopen(C):https://linux.die.net/man/3/dlopen

man dlsym(C):https://linux.die.net/man/3/dlsym

我知道您可以像这样从C ++二进制文件调用C函数

关于c - 从R调用此C函数(libqp_gsmo.c)的方法是什么? ,我们在Stack Overflow上找到一个类似的问题:https://stackoverflow.com/questions/43785573/

10-09 09:04