Fehler singuläre Gradientenmatrix

[Luisa_33]

Hallo liebe R-Freunde,

ich habe mich an einer Schätzung mit der e-Funktion probiert, da die lineare Regression nicht die gewünschten Ergebnisse liefert.
Leider bekomme ich folgenden Fehler

Code: Alles auswählen

Fehler in nlsModel(formula, mf, start, wts) : 
  singuläre Gradientenmatrix bei der ersten Parameterschätzung
  

Mein aktueller Code lautet:

Code: Alles auswählen

f <- function(Breite,Gruppe,Länge,a,b1,b2,b3) {a * exp((b1^ Breite) * (b2^ Gruppe)* (b3^Länge)) }
   
#Berechnung der nls
results <- nls(Zeit ~ f(Breite, Gruppe,Länge,a,b1,b2,b3), data = tdata, start = c(a=0, b1=1,b2=1, b3=1))

#Auslesen der Koeffizienten 
 co <- coef(results)
   
#Schätzung der Validierungsdaten 
prediction <- predict(results, vdata)

Vielleicht kann mir jemand bei meinem Fehler helfen.

Liebe Grüße,
Luisa_33

[EDi]

Kann vieles sein:

Oft passt das Model nicht zu den Daten (zu komplex, non-sense, etc...)
Oft passen auch die Startwerte nicht.
Seltener ist ein es, dass es ein perfekter (0 residuen) ist.

In die Richtung würde ich schauen...

Ansonsten mal trace=TRUE setzen um mehr Hinweise zu bekommen.

[jogo]

Hallo Luisa,

ich habe Dein Modell etwas reduziert:

Code: Alles auswählen

library("xlsx")
setwd("~/Desktop/R.Zeug/Luisa33")
tdata <- read.xlsx("Prediction_tdata.xlsx", 1, header=TRUE)

f <- function(Breite,Gruppe,Länge,a,b1) {a * exp((b1^ Breite) ) }
results <- nls(Zeit ~ f(Breite, Gruppe,Länge,a,b1), data = tdata, start = c(a=0.01, b1=1))

hm, geht immer noch nicht - allerding mit einer anderen Fehlermeldung.

Dann habe ich mir mal zwei Plota angeschaut:

Code: Alles auswählen

plot(Zeit ~ Breite, data=tdata)
plot(Zeit ~ Länge, data=tdata)

Das sieht alle nicht ganz stringent aus. ... und die Zahlen für Länge und Breite werden recht groß.

Ich habe die Funktion dann mal logarithmiert:

Code: Alles auswählen

f <- function(Breite,Gruppe,Länge,a,b1,b2) {a + (b1^ Breite) }
results <- nls(log(Zeit) ~ f(Breite, Gruppe,Länge,a,b1), data = tdata, start = c(a=1, b1=1))

Der Parameter a ist hier jetzt auch logarithmiert, aber das Modell wird berechnet.

Gruß, Jörg

[bigben]

Hallo Luisa,

ist das überhaupt Absicht, dass im Exponenten der E-Funktion nochmal Potenzen gebildet werden?

LG,
Bernhard

[jogo]

Hallo Luisa,

(wegen der Singularität)
bitte schau Dir summary(tdata) an

Auffällig ist, dass min(Gruppe) und max(Gruppe) gleich sind. Die Variable Gruppe hat also keine Varianz. An eine Variable ohne Varianz kann man keinen zu schätzenden Parameter binden (weder in einem linearen Modell noch in einem nichtlinearen). Wenn man es doch tut, gibt es die genannte Singularität.

Gruß, Jörg

[Luisa_33]

Hallo Bernhard,

das war ein Fehler von mir.
Ich habe gedacht, dass ich wenn ich Länge, Breite und Gruppe einbeziehen möchte.
Die Funktion in R so aufstellen muss.

Hallo Luisa,

ist das überhaupt Absicht, dass im Exponenten der E-Funktion nochmal Potenzen gebildet werden?

LG,
Bernhard

[Luisa_33]

Ja, ich habe schon gesehen, dass die Differenz zwischen minimalen und maximalen Wert sehr hoch sind.
Sollte ich zunächst die Ausreißer entfernen?
Falls ja, gibt es eine Möglichkeit alle Ausreißer auf einmal zu entfernen?
Ich habe es bis jetzt so gelöst:
tdata <- boxplot(tdata[, "Zeit"])$out
D.h. für alle Spalten extra und dann habe ich die Stellen ausgelesen und am Ende aus dem Datensatz gelöscht.

Kann ich die Daten statt zu logarithmieren auch einfach z-transformieren mit dem Befehl scale()?
Oder ist logarithmieren besser?

Hallo Luisa,

(wegen der Singularität)
bitte schau Dir summary(tdata) an

Gruß, Jörg

[jogo]

Hallo Luisa,

(wegen der Singularität)
bitte schau Dir summary(tdata) an

ich habe meine vorherige Nachricht noch etwas ergänzt um die Lösung.
Klar ist, die Variable Gruppe kann nicht im Modell sein.

Code: Alles auswählen

f <- function(Breite,Gruppe,Länge,a,b1,b3) { a + (b1^ Breite) * (b3^Länge) }
results <- nls(log(Zeit) ~ f(Breite, Gruppe,Länge,a,b1,b3), data = tdata, start = c(a=0.01, b1=1, b3=1))

f <- function(Breite,Gruppe,Länge,a,b1,b3) {a * exp((b1^ Breite) * (b3^Länge)) }
results <- nls(Zeit ~ f(Breite, Gruppe,Länge,a,b1,b3), data = tdata, start = c(a=0.01, b1=1, b3=1))

Ich bin mir allerdings nicht sicher, ob die Funktionen wirklich so aussehen sollen (siehe Nachricht von Bernhard)

Ja, ich habe schon gesehen, dass die Differenz zwischen minimalen und maximalen Wert sehr hoch sind.
Sollte ich zunächst die Ausreißer entfernen?

Gibt es denn Ausreißer? Was sind für Dich Ausreißer?

Falls ja, gibt es eine Möglichkeit alle Ausreißer auf einmal zu entfernen?

Wenn es ein Kriterium gibt, welches die Ausreißer von den anderen Beobachtungen unterscheidet, ja.

Kann ich die Daten statt zu logarithmieren auch einfach z-transformieren mit dem Befehl scale()?
Oder ist logarithmieren besser?

Das hat meistens auch Auswirkungen auf die zu schätzenden Parameter.
Weißt Du, wie sich dann die Parameter transformieren?
Kannst Du dann immer noch das Modell beurteilen?
(Bei manchen Modellen und bei manchen passenden Transformation bleiben einige Parameter im Modell unverändert bzw. können auf die originalen Werte zurückgerechnet werden.)

Gruß, Jörg

[Luisa_33]

Code: Alles auswählen

f <- function(Breite,Gruppe,Länge,a,b1,b3) { a + (b1^ Breite) * (b3^Länge) }
results <- nls(log(Zeit) ~ f(Breite, Gruppe,Länge,a,b1,b3), data = tdata, start = c(a=0.01, b1=1, b3=1))

Ja, ich bin mir auch nicht sicher, wie die Funktion aussieht.
Habe dazu leider auch kein Beispiel gefunden, wenn ich mehrere Variablen habe.
Aber eine Funktion wie unten ist angestrebt.

Ausreißer sind an sich Werte, die aufgrund von Messfehlern etc. entstanden sind.
Es ist schwer zu sagen, ob Werte Ausreißer sind oder "wahre Werte".
Wenn ich die Extremwerte aus den Datensatz nehme, wird natürlich meine Schätzung besser. Die Vorhersage neuer Werte könnte aber schlechter werden.

Das hat meistens auch Auswirkungen auf die zu schätzenden Parameter.
Weißt Du, wie sich dann die Parameter transformieren?
Kannst Du dann immer noch das Modell beurteilen?
(Bei manchen Modellen und bei manchen passenden Transformation bleiben einige Parameter im Modell unverändert bzw. können auf die originalen Werte zurückgerechnet werden.)

Das ergibt Sinn mit der Transformation Danke!

[bigben]

Ja, ich bin mir auch nicht sicher, wie die Funktion aussieht.
Habe dazu leider auch kein Beispiel gefunden, wenn ich mehrere Variablen habe.
Aber eine Funktion wie unten ist angestrebt.

In Deiner Grafik "unten" finden sich ganz einfache e-Funktionen. Die kann man ohne nls fitten, indem man die y-Variable log transformiert:

y = exp(c0 + c1*x1 + c2*x2) ist gleichbedeutend mit
log(y) = c0 + c1*x1 + c2*x2

Für Deine Daten könnte das etwa so aussehen:

Code: Alles auswählen

l <- read.table(dec =",", header=TRUE, text="Zeit	Breite	Gruppe	Länge
1535,4	75	3	27
3498	35	3	30
1984,666667	30	3	15
1540	25	3	5
1721	35	3	15
1822	30	3	13
997,5	25	3	13
1257	55	3	15
594	60	3	6
3097	70	3	35
32,38	15	3	13
3637	50	3	18
2329	55	3	143
203,6	75	3	39
679	110	3	10
683,2	110	3	130
2036	30	3	115
933,25	80	3	41
1548,6	70	3	15
1460,1	60	3	62
1647	45	3	12
680	90	3	9
1101	45	3	50
432,6666667	10	3	33
2831,333333	150	3	17
1726	150	3	9
1134,333333	150	3	35
140,3333333	32	3	105
922,4	30	3	8
288,5	55	3	56
758,8	20	3	75
1053	10	3	32
42,02	60	3	10
148,6666667	70	3	55
598,1666667	60	3	12
752	95	3	20
399,6666667	60	3	12
943,6	50	3	155
39,12	15	3	13
895,6666667	60	3	12
1131,533333	25	3	12
269,8333333	60	3	12
3926	90	3	15
2475	35	3	10
913,5	22	3	7
467,5	25	3	8
212,2666667	25	3	10
1864,333333	40	3	47
452,6	16	3	16
75,75	10	3	85
346	15	3	48
152,8333333	50	3	15
74,5	15	3	13
4779	90	3	20
4648	75	3	25
398,5	15	3	90
649,5	20	3	75
1147	60	3	44
951	70	3	30
243,8333333	12	3	33
457	75	3	11
4180	150	3	26
648,6666667	65	3	10
987,6666667	8	3	112
2770	65	3	9
4465	90	3	14
2075	75	3	25
3336	150	3	53
47,60416667	40	3	10
3700	35	3	360
1064	45	3	25
637,3333333	75	3	11
963,3333333	30	3	35
665,2	60	3	62
1317	50	3	60
3107	70	3	130
1620	70	3	10
1017	30	3	35
444,3	60	3	62
1286	45	3	0
3196	90	3	30
33,34	15	3	13
1600,333333	70	3	130
2425	70	3	10
68,28	60	3	10
464,75	80	3	41
3046,5	40	3	23
907,5	30	3	23
325,6	60	3	12
1183,714286	90	3	10
786,3571429	40	3	10
653,7142857	40	3	10
3452,5	70	3	41
2637	30	3	115
2712	70	3	15
238,3181818	30	3	5
138,4047619	30	3	6
1752	22	3	25
1026	22	3	25
965	70	3	13
1733	22	3	25
739	22	3	25
752	70	3	41
980,48	25	3	103
4040	150	3	17
2588,75	120	3	12
771,4	30	3	10
460,6	30	3	10
475,75	130	3	17
739,5	12	3	17
116,3666667	20	3	20
309,4545455	55	3	138
641,5	100	3	95
828,5	40	3	10
914	90	3	150
834	90	3	10
1025,8	70	3	41
797,5	110	3	15
444	15	3	22
140,3	8	3	95
1857,2	70	3	41
983	110	3	30
480	45	3	30
407,5	30	3	30
3839	130	3	45
27,58571429	50	3	22
832,5	35	3	78
1443,666667	130	3	17
2482,333333	90	3	36
929	50	3	127
304,3333333	20	3	43
2955	100	3	53
1182	15	3	22
939	35	3	78
385	170	3	317
405,8	30	3	7
436,5	45	3	27
2818	35	3	175
1113,8	40	3	47
1158	40	3	15
2054	40	3	33
1249	90	3	10
")


mod1 <- lm(log(Zeit) ~ Breite + Länge, data = l) 
summary(mod1)
plot(mod1)

Das ergibt dann:

Code: Alles auswählen

> mod1 <- lm(log(Zeit) ~ Breite + Länge, data = l) 
> summary(mod1)

Call:
lm(formula = log(Zeit) ~ Breite + Länge, data = l)

Residuals:
    Min      1Q  Median      3Q     Max 
-3.2735 -0.4759  0.2030  0.7177  1.7177 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept) 6.013177   0.178006  33.781  < 2e-16 ***
Breite      0.010809   0.002473   4.372  2.4e-05 ***
Länge       0.001691   0.001733   0.976    0.331    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 1.061 on 139 degrees of freedom
Multiple R-squared:  0.1288,	Adjusted R-squared:  0.1163 
F-statistic: 10.28 on 2 and 139 DF,  p-value: 6.873e-05

Also immerhin ein hochsignifikantes Modell mit 12 % Varianzaufklärung bei dem sich zeigt, dass der Einfluss von Breite hochsignifikant ist, in diese Modell ist Länge nicht signifikant. Wenn man sich die Diagnostik-Plots anschaut erkennt man, dass Messpunkt 135 eine sehr hohe Cook-Distanz hat. Wenn man den aus dem Modell rausnimmt, dann verbessert sich auch der fit:

Code: Alles auswählen

l2 <- l[-135,]

mod2 <- lm(log(Zeit) ~ Breite + Länge, data = l2) 
summary(mod2)
plot(mod2)

Code: Alles auswählen

> summary(mod2)

Call:
lm(formula = log(Zeit) ~ Breite + Länge, data = l2)

Residuals:
    Min      1Q  Median      3Q     Max 
-3.2383 -0.4952  0.1457  0.6775  1.7620 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept) 5.832563   0.186020  31.354  < 2e-16 ***
Breite      0.012675   0.002510   5.049 1.38e-06 ***
Länge       0.004060   0.001901   2.135   0.0345 *  
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 1.037 on 138 degrees of freedom
Multiple R-squared:  0.1713,	Adjusted R-squared:  0.1593 
F-statistic: 14.26 on 2 and 138 DF,  p-value: 2.343e-06

Jetzt hast Du 17 % Varianzaufklärung und beide Prädiktoren sind signifikant. Wenn es Dir um Signifikanz ging, dann ist das Ziel erreicht. Wenn es um Vorhersagekraft und Anpassung an Nichtliniearität geht, dann könnte man bei den Maschinenlernverfahren vielleicht noch was besseres als die lineare Regression finden.

LG,
Bernhard