R: fonctions générées par une fonction d'ajustement non linéaire - comment spécifier un ensemble de paramètres

Question

Ce que j'essaie de faire est de faire une régression non linéaire en utilisant des sous-modèles possibles de mon modèle complet, puis de choisir le modèle le plus approprié en utilisant AIC critère. Le problème est de générer tous les sous-modèles possibles, puis de les appliquer à la fonction nls pour trouver le meilleur ajustement.

Disons que j'ai données:

x <- rnorm(100) 
y <- 1+x+x^2-x^3-x^4+rnorm(100, sd=0.1) 

Et la formule complète en fonction de la x variable et certains paramètres a, b, c, d, e:

full <- function(x, a, b, c, d, e){ 
    return(a + b*x + c*x^2 + d*x^3 + e*x^4) 
} 

(I sachez qu'il s'agit d'un exemple stupide de modèle non linéaire et que je pourrais utiliser la transformation de données + modèle linéaire pour cela, mais je veux que ce soit simple)

Je souhaite générer tous les sous-modèles possibles, en ignorant certains paramètres. J'ai essayé de simplement mettre les sautée paramètres à zéro:

skip <- function(args){ 
    # args = subset of c("a", "b", "c", "d", "e") 
    return (function(x, a=0, b=0, c=0, d=0, e=0) { 
    par <- c("a", "b", "c", "d", "e") 
    parameters <- lapply(par, function(p){ 
     if(p %in% args){ 
     return (0) 
     } 
     else{ 
     return (get(p)) 
     } 
    }) 
    names(parameters) <- c("a", "b", "c", "d", "e") 
    return (with(parameters, a + b*x + c*x^2 + d*x^3 + e*x^4)) 
    }) 
} 

Et j'écrire une fonction pour appliquer ces formules à nls:

apply_nls <- function(func, start){ 
    fit <- nls(y~func(x, a, b, c, d, e), 
      start=start) 
    return(fit) 
} 

Le problème est que cela ne fonctionne pas. Si je spécifier la valeur de départ pour les paramètres ommited:

apply_nls(skip("e"), start=list(a=1, b=1, c=1, d=-1, e=-1)) 

je reçu un message d'erreur

matrice gradient singulier au paramètre initial estime

(parce qu'en effet, ma fonction ne ne dépend pas du paramètre e).

Mais quand je ne spécifie pas les valeurs de départ pour b et d (je devrais être capable de le faire, parce que je spécifié les Vales par défaut de ces paramètres à l'intérieur skip):

apply_nls(skip("e"), start=list(a=1, b=1, c=1, d=-1)) 

Je suis une autre erreur message:

paramètres sans valeur à partir de 'données': e

Je suppose que je devrais limiter les paramètres skip et/ou dans apply_nls fonctions afin qu'ils ne prennent que les paramètres dont j'ai besoin à ce moment-là, comme:

apply_nls <- function(func, args, start){ 
    fit <- nls(y~func(x, args), 
      start=start) 
    return(fit) 
} 

Mais cela ne fonctionne pas et je ne sais pas comment correctement Mettre en œuvre.

Answer 1

Si quelqu'un est intéressé, j'ai résolu ce problème. La fonction apply_nls fonctionne quand elle est sous la forme:

apply_nls <- function(func, par, start){ 
    fit <- nls(y~do.call(func, args=append(list(x=x), mget(par))), 
      start=start) 
    return(fit) 
} 

Ici mget valeur de retour de chaque paramètre donné le nom de paramètre (sous forme de chaîne) et do.call permettent d'alimenter le func avec des arguments obtenus. Cette func est une fonction (sous-formule) après avoir ignoré certains paramètres, par sont les paramètres restants et start sont des valeurs de départ pour ces paramètres. Ainsi, l'application de apply_nls ressemble à ceci:

apply_nls(skip("e"), par=c("a", "b", "c", "d"), start=list(a=1, b=1, c=1, d=-1)) 

Pour obtenir tous les ajustements pour les sous-modèles:

1) J'attribuer des noms de paramètres et valeurs de départ pour tous les

parameters <- c("a", "b", "c", "d", "e") 
start <- list(a=1, b=1, c=1, d=-1, e=-1) 

2) Je fais une liste de toutes les combinaisons de paramètres perdus

drops <- append(NA, c(parameters, 
      combn(parameters, 2, simplify=F), 
      combn(parameters, 3, simplify=F), 
      combn(parameters, 4, simplify=F))) 

3) J'écris deux f onctions qui rentreraient autres paramètres ou valeurs de départ en fonction des paramètres d'abandonner:

choose_starts <- function(args, start){ 
    return(start[!(names(start) %in% args)]) 
} 

choose_pars <- function(args, all_pars){ 
    return(all_pars[!all_pars %in% args]) 
} 

4) Je crée toutes les combinaisons de formules, les paramètres et les valeurs de départ donné les paramètres sautées:

all_formulas <- lapply(drops, skip) 

all_starts <- lapply(drops, choose_starts, start) 

all_pars <- lapply(drops, choose_pars, parameters) 

5) I adapter les modèles non linéaires pour tout ce qui précède.

all_fits <- mapply(apply_nls, all_formulas, all_pars, all_starts, SIMPLIFY=F)