Fehler erhalten mit optim Funktion mit Grenzen in R

Question

Ich versuche, ein Optimierungsproblem zu lösen. Die Eingabeparameter in der optim Funktion haben einige untere und obere Grenzen. Also definiere ich ihre Grenzen in optim Funktion. Hoewever, ich bekomme einen Fehler bei der Definition der Grenzen. Ohne die Grenzen scheint der Code richtig zu funktionieren. Allerdings muss ich die Grenzen definieren. Wie kann ich das mit optimaler Funktion machen?

Lassen Sie sagen, ich die folgenden Daten:

data<-structure(c(0.00615493340985163, -0.0183523033409178, -0.0239523785317557, 
0.0119069594508896, -0.0236738098553008, 0.00620766467803002, 
0, 0, -0.0135139156796791, -0.013333722176743, 0.0268476378564221, 
-0.0135139156796791, -0.013333722176743, 0.013333722176743, 0.00673412977392229, 
-0.00673412977392229, 0, -0.00668908444213101, 0.00668908444213101, 
0, -0.0199344999738199, -0.00655749308617948, -0.0384668116232195, 
0.0254794345985866, 0.0598193511101729, -0.072640216412876, 0.0192934699679488, 
0, 0.0330067654193866, -0.013333722176743, 0.013333722176743, 
-0.013333722176743, 0.013333722176743, -0.00668908444213101, 
0, 0.0134232142160533, -0.00673412977392229, 0.0481199603578747, 
1.11022302462516e-16, -0.00701767864273251, -0.0138893197432578, 
0.0138893197432578, 0.0140849533532424, 0.0215065370300215, 0.0294143507296346, 
-0.00743509745461479, 0.0224732181609882, 0.0152677229601242, 
0.0233477550538765, -0.0684689206901783, 0.00738022451518927, 
0.00743509745461468, 2.22044604925031e-16, -0.0074350974546149, 
0.0149258899398627, 0.0228150511812496, 0.0233477550538768, -0.0310107541714851, 
-1.11022302462516e-16, 0.0794022066375132, -0.00823059632776157, 
0.0248978480958935, -0.0166672517681319, 0.0422008655824283, 
0.0262027007594979, -0.0262027007594979, -0.00858384940446988, 
-0.0418476125057201, -0.0711716103097515, -0.0151520520636412, 
-0.00749079248524787, 2.22044604925031e-16, -0.0074350974546149, 
0.0377409411211125, 0.00772217442522283, -0.00772217442522272, 
0.0155044452037838, 0.0813409849048499, 0.0432973437531967, 0.0639495630685765, 
0.0582697202410881, -0.00995047290670414, -0.038840374472406, 
-0.0188687397097502, -0.018519293799869, 0.00921677698219231, 
0.00930251681767669, 0.0577091141821562, 0.00496286001552748, 
-0.0148152957266917, 0.0198029086178682, -0.0049876128911765, 
0.0251906130129864, 0.0258416144357064, 0.026527158190343, -0.00536202564051175, 
0.0381523627082095, 0.0224732181609883, 0.00569811427981221, 
0.00573076894503241, 0.0115610141605023, -3.99203730968607, -3.30187780145509, 
-3.50548223941826, -2.91752716824826, -3.17492763371365, -3.53507451548409, 
-3.89518141271414, -3.88152836923837, -3.8883781931234, -3.90193865793583, 
-3.62428166915146, -3.89518141271415, -4.31078411075375, -3.90865054602706, 
-3.61759188278133, -3.90865054602705, -3.89518141271415, -3.21205168392545, 
-3.62428166915146, -3.62428166915146, -3.90865054602706, -3.23199118204902, 
-3.42417422616045, -3.67624725795418, -3.25797324409979, -2.05477936938672, 
-3.25154075748913, -3.65707525404955, -3.23855027497075, -3.61759188278133, 
-3.63092699428175, -3.39105256160677, -3.62428166915146, -3.62428166915146, 
-3.4110569336503, -3.90865054602705, -3.61085703614421, -3.04773029538416, 
-3.34980147791793, -3.8606927748257, -3.58345463266905, -3.87463129809686, 
-3.58345463266904, -3.15684949369853, -3.54088930436154, -3.12806158534685, 
-3.51890725078025, -2.92522323350839, -3.48116118577917, -3.06787261524203, 
-2.9479621461587, -3.81031850036527, -3.28454665255894, -3.29201110603814, 
-3.51890725078025, -3.50397938330381, -3.08326299924448, -3.06008764562223, 
-3.09842002466534, -2.38191708519966, -3.40940510523282, -3.40940510523283, 
-2.70767965228382, -3.00382611773014, -2.35925234419376, -2.54283503639689, 
-2.34190966178995, -2.36781202087106, -2.43376975085178, -3.78035118847322, 
-3.5039793833038, -3.28454665255894, -2.69649797383879, -2.96283902618942, 
-2.79544487368831, -2.76441473522112, -2.32836109669588, -2.75650428162744, 
-2.82871191242858, -2.63863192436288, -2.52047288863833, -3.51147117607425, 
-3.52137370329194, -2.71243376070309, -3.98895546754183, -3.99817264464609, 
-3.07713524996792, -2.70290281739706, -3.36965724112176, -3.34980147791793, 
-3.0104186116689, -3.51147117607425, -2.72042800404975, -3.47601897065901, 
-2.75119564294736, -3.43926334778568, -3.13533665372873, -3.38992938439265, 
-4.07468451164413, -4.06900240301525, -3.77271689629009), .Dim = c(101L, 
2L), .Dimnames = list(NULL, c("data", "range"))) 

den Code unten verwenden, möchte ich ein Optimierungsproblem mit der Optim-Funktion lösen:

solfun<-function(par,data) 
{ 
    data1<-data[,1]; 
    data2<-data[,2]; 

    n<-length(data1) 
    LL<-1:n; 
    sigs<-1:(n+1); 
    z<-1:n; 
    xd<-1:n; 
    sigs[1]<-sqrt(mean(data1^2)) ; 
    for(i in 2:(n+1)) { 
    z[i-1]=data1[i-1]/sigs[i-1]; 
    xd[i-1]=(data2[i-1]-0.43-log(sigs[i-1]))/0.29 
    sigs[i]=exp(par[1]/2+par[3]*log(sigs[i-1])+par[4]/2*xd[i-1]+par[2]/2*z[i-1]) 
    } ; 
    for(i in 1:n) { 
    LL[i] <- (-0.5*log(sqrt(2*pi)*0.29)-(data2[i]-0.43-log(sigs[i]))^2/(2*0.29^2)) 
    }; 
    return(sum(-LL)) ; 
} 


fit1<-optim(par<-c(0.19413280,0.02130018, 0.97327246, 0.13672007),solfun,data=data, 
      method = "L-BFGS-B",lower=c(-10,-10, -1,-10),upper=c(10,10, 1,10)) 

Allerdings habe ich den folgenden Fehler :

> fit1<-optim(par<-c(0.19413280,0.02130018, 0.97327246, 0.13672007),solfun,data=data, 
+    method = "L-BFGS-B",lower=c(-10,-10, -1,-10),upper=c(10,10, 1,10)) 
Error in optim(par <- c(0.1941328, 0.02130018, 0.97327246, 0.13672007), : 
    L-BFGS-B needs finite values of 'fn' 

Dank lot.I wird für jede Hilfe sehr freuen.

Answer 1

Das Problem ist, dass L-BFGS-B Methode (die das einzige multivariate Verfahren in optim ist, die mit Grenzen haben) den Funktionswert braucht eine endliche Zahl zu sein, damit die Funktion nicht NaN zurückkehren kann, Inf in den Grenzen, die Ihre Funktion wirklich gibt das zurück. Also hier ist ein schmutziger Trick, der sich um Ihr Problem kümmert. Sie können eine Funktion solfun1 wie folgt definieren, was nur eine kleine Änderung an solfun ist. Wenn der solfun Wert nicht endlich ist, gibt solfun1 eine große Zahl zurück return(1000 + sum(par^2)) (wie groß die Zahl sein sollte, hängt wirklich von dem Problem ab, das Sie haben, in diesem Problem fand ich, dass es groß genug ist, und Sie haben ziemlich Flexibilität beim Festlegen der Zahl) . Und ich füge einen Begriff sum(par^2) hinzu, um zu verhindern, dass der Optimierungsprozess blockiert wird. Und solfun1 befasst sich mit Ihrem Problem ziemlich gut.

Außerdem fand ich in diesem Beispiel die Grenzen nutzlos, weil optim mit Grenzen und ohne Grenzen tatsächlich sehr ähnliche Ergebnisse zurückgeben.

solfun<-function(par,data) 
{ 
    data1<-data[,1]; 
    data2<-data[,2]; 

    n<-length(data1) 
    LL<-1:n; 
    sigs<-1:(n+1); 
    z<-1:n; 
    xd<-1:n; 
    sigs[1]<-sqrt(mean(data1^2)) ; 
    for(i in 2:(n+1)) { 
     z[i-1]=data1[i-1]/sigs[i-1]; 
     xd[i-1]=(data2[i-1]-0.43-log(sigs[i-1]))/0.29 
     sigs[i]=exp(par[1]/2+par[3]*log(sigs[i-1])+par[4]/2*xd[i-1]+par[2]/2*z[i-1]) 
    } ; 
    for(i in 1:n) { 
     LL[i] <- (-0.5*log(sqrt(2*pi)*0.29)-(data2[i]-0.43-log(sigs[i]))^2/(2*0.29^2)) 
    }; 
    return(sum(-LL)) ; 
} 

solfun1<-function(par,data) 
{ 
    data1<-data[,1]; 
    data2<-data[,2]; 

    n<-length(data1) 
    LL<-1:n; 
    sigs<-1:(n+1); 
    z<-1:n; 
    xd<-1:n; 
    sigs[1]<-sqrt(mean(data1^2)) ; 
    for(i in 2:(n+1)) { 
     z[i-1]=data1[i-1]/sigs[i-1]; 
     xd[i-1]=(data2[i-1]-0.43-log(sigs[i-1]))/0.29 
     sigs[i]=exp(par[1]/2+par[3]*log(sigs[i-1])+par[4]/2*xd[i-1]+par[2]/2*z[i-1]) 
    } ; 
    for(i in 1:n) { 
     LL[i] <- (-0.5*log(sqrt(2*pi)*0.29)-(data2[i]-0.43-log(sigs[i]))^2/(2*0.29^2)) 
    }; 
    if (is.finite(sum(-LL))){ 
     return(sum(-LL)) 
    } 
    return(1000 + sum(par^2)) ; 
} 


fit1<-optim(par<-c(0.19413280,0.02130018, 0.97327246, 0.13672007),solfun,data=data) 

fit2<-optim(par<-c(0.19413280,0.02130018, 0.97327246, 0.13672007),solfun1,data=data, 
      method = "L-BFGS-B",lower=c(-10,-10, -1,-10),upper=c(10,10, 1,10))