触发根 function 时更改 R 的 deSolve 中的参数值

Question

Short version

As suggested in comments, I am leaving a summarized, short version of the problem I found here. The original complete explanation can be found below.

In summary, I am currently using the deSolve package and am interested in implementing events in response to root functions. I understand that I can use such events to introduce sudden changes in the state variables of the model, but I would like to also modify parameter values of the model in response to such root functions.

Is this possible?

Long version

I have implemented an orbital numerical propagator (a function to calculate the position of a space satellite given an initial position and velocity state) in R. The problem is formulated as a set of 6 ODEs (X, Y and Z components for position and velocity). My implemented models calculate the acceleration at any given time, and then I use the deSolve package to perform integration and calculate the trajectory.

A key parameter that must be decided when performing such calculation is the center of the frame of reference, which is usually placed at the center of mass of the celestial object that exerts the most significant gravitational influence on the satellite. This is because, even though in principle it is possible to perform integration and calculate the trajectory using any arbitrary frame of reference, in practice we only obtain reasonable results when the center of coordinates is placed on the celestial object that exerts the main gravitational influence (ie, Earth for Earth-orbiting satellites, Moon for Moon-orbiting satellites, and so on), as discussed in this SE question .

Initially, my implementation used a constant center of coordinates, either provided by the user or automatically determined from the sphere of influence of the different main celestial objects.

However, this is not appropriate for modeling interpl.netary space missions, since the celestial object that exerts the main gravitational influence changes during the trajectory. A good example is the Apollo missions, where satellites started in an Earth orbit, and then moved to a Moon orbit.

I have managed to detect when such changes of the central celestial object happen, and return it as part of the results of the integrator. However, in order to actually perform the correct modeling, the central body being used during integration needs to be changed when these changes are detected. This process of "changing the central body" involves two tasks (note that it is just a shift of the center of coordinates, with no rotations involved):

1. Subtracting the coordinates of the celestial body to be used as the new center of coordinates from the coordinates of the satellite (by doing so, the coordinates of the satellite are now referred to the new celestial body).
2. Modifying the value of the argument specifying the central celestial body that is passed to the function calculating acceleration, which is one of the elements of the list of parameters provided to the function defining the ODE model.

I believe Task 1 can be easily solved by using a root-activated event. In order to do so, I define a variable in an environment specifically created for this purpose that stores the value of the automatically calculated celestial body that exerts the main gravitational influence in each iteration of the integrator. At a new iteration, a new value is calculated, and is compared with the previous value. If it is the same, nothing happens. But if it is different, a root function would return 0, triggering an event function. The event function would then return the position minus the coordinates of the new central celestial body.

However, I am unsure about how to perform Task 2, since this would involve changing one of the initial parameters provided to the ODE model. Any ideas on this would be greatly appreciated, (either a continuation of my approach. or a completely different one).

I am leaving a simplified version of the involved code.

My main function is called hpop , and is the user-level function to which the initial state vector and other parameters are passed. It looks like this:

hpop <- function(position, velocity, dateTime, times, satelliteMass, dragArea, 
                 radiationArea, dragCoefficient, radiationCoefficient, 
                 earthSphericalHarmonicsDegree = 130, solidEarthTides=TRUE,
                 oceanTides=TRUE, moonSphericalHarmonicsDegree = 150, 
                 centralBody="Earth", ...) {
    extraArgs <- list(...)
    ## This is the environment used to hold the variable that keeps track of what
    ## the central body should be at each iteration
    propagationGlobalVars <- new.env()
    ## This is the initial value of such variable, which is the user-provided central body, by default Earth
    propagationGlobalVars$latestCentralBody <- centralBody
    ## This is the initial state, composed by 6 variables (X, Y and Z components of position and velocity)
    initial_state <- c(position, velocity)
    ## This is the list of parameters required for trajectory calculation
    ## There is quite a few, but the 2 most relevant for this question are the last 2
    ## centralBody is the body that will be used as the center of coordinates, and
    ## globalVarsEnv is the environment that will be containing the variable that keeps track of what the central body should be
    parameters = list(
        dateTime = dateTime,
        solarArea = radiationArea,
        satelliteMass = satelliteMass,
        satelliteArea = dragArea,
        Cr = radiationCoefficient,
        Cd = dragCoefficient,
        earthSPHDegree = earthSphericalHarmonicsDegree,
        moonSPHDegree = moonSphericalHarmonicsDegree,
        SETcorrections = solidEarthTides,
        OTcorrections = oceanTides,
        centralBody = centralBody,
        globalVarsEnv = propagationGlobalVars)
    ## This calles function ode from the deSolve package, passing the previously defined initial state, 
    ## integration times and the function defining the ode model (code below)
    integration_results <- ode(y=initial_state, times=times, func=odeModel,
                               parms=parameters, method="radau", rtol=1e-13,
                               atol=1e-16, hini=0.01, ...)
    numeric_results <- integration_results[, 1:7]
    central_bodies <- names(centralBodiesNum[integration_results[, 8]])
    output <- cbind(as.data.frame(numeric_results), central_bodies)
    colnames(output) <- c("time", "X", "Y", "Z", "dX", "dY", "dZ", "Central body")
    return(output)
}

A simplified version of the code for the ODE model, called odeModel and which I pass as the func argument to function ode from the deSolve package, is:

odeModel <- function(t, state, parameters) {
    with(as.list(c(state, parameters)), {
        state_vector <- state
        ## Function accel calculates the acceleration and velocity at time t. It returns a list with
        ## two elements. The first is a numeric vector with the X, Y and Z components of velocity,
        ## and the X, Y and Z components of acceleration, in this order. 
        ## The second element is the celestial body that, given the position at that iteration,
        ## exerts the main gravitational influence on the satellite
        results <- accel(t, state_vector, dateTime, solarArea, satelliteMass, 
                              satelliteArea, Cr, Cd, earthSPHDegree, SETcorrections,
                              OTcorrections, moonSPHDegree, centralBody)
        centralBody <- results[[2]]
        ## Now we can compare the central body with that of the previous iteration,
        ## and assign the new value to the tracking variable
        if(centralBody != globalVarsEnv$latestCentralBody) {
            message(strwrap(paste("A transition from the sphere of influence of ",
                                  globalVarsEnv$latestCentralBody, " to that of ",
                                  centralBody, " has been detected.", sep=""), initial="", prefix="\n"))
            assign("latestCentralBody", centralBody, envir = globalVarsEnv)
        ## here I would also trigger the root function, to perform Task 1 of the two 
        ## tasks required to change the central body as described above. And also,
        ## I would need a way to change the value of centralBody in the parameters argument, which is the main issue of this question
        }
        acceleration <- results[[1]]
        dx <- acceleration[1, 1]
        dy <- acceleration[1, 2]
        dz <- acceleration[1, 3]
        d2x <- acceleration[2, 1]
        d2y <- acceleration[2, 2]
        d2z <- acceleration[2, 3]
        ## This is the return value of the odeModel function. As specified in the
        ## documentation for the func argument of the ode function, the first element
        ## of the list are the values of the derivatives of the model, and the
        ## second one can be any other variable. Note that since such other variables
        ## must be numeric, I actually access a named vector of numbers, and then convert
        ## back to the proper names when outputting final results to the users.
        ## It is important to provide the central body of each output step so that
        ## we know what the center of coordinates are at each step
        list(c(dx, dy, dz, d2x, d2y, d2z),
             centralBodiesNum[centralBody])
    })
}

Answer 1

To change a parameter depending on a root function, one can use an additional state variable ( y3 below) that has a derivative zero in the model function and can only be changed by an event. Modifying the bouncing ball example from a tutorial example ( Example3 ) we get:

library(deSolve)
ball <- function(t, y, p) {
  dy1 <- y[2]
  dy2 <- y[3]
  dy3 <- 0  # emulates a parameter, derivative = 0 but can be changed by event
  list(c(dy1, dy2, dy3))
}

## gravity is essentially a parameter
yini <- c(height = 0, velocity = 10, gravity = -9.8)

rootfunc <- function(t, y, p){
  return (y[1])
}

eventfunc <- function(t, y, p) {
  y[1] <- 0
  y[2] <- -0.9 * y[2]
  y[3] <-  0.5 * y[3] # 0.5 just for technical demonstration
  return(y)
}

times <- seq(from = 0, to = 20, by = 0.01)

out <- ode(times = times, y = yini, func = ball,
           parms = NULL, rootfun = rootfunc,
           events = list(func = eventfunc, root = TRUE))

plot(out)

This works of course also for more than one parameter. It can also be extended with forcings or lookup tables.