我在R中创建了一个新的Robust HoltWinters函数(基于stats :: Holt-Winters)方法(per"具有指数和Holt-Winters的稳健预测) 平滑"作者:Sarah Gelper1,Roland Fried,Christophe Croux。 2008年9月26日。)为什么?嗯......为什么不呢!但我离题了......
stats :: Holt-Winters方法的核心是一个名为C_HoltWinters的C代码,我已将其修改为健壮(见下文)
p<-rep(1:length(b),b)
as.list(sapply(1:length(b), function(x) {sum(as.numeric(a)[which(p==x)])}))
所以我在windows 叹息中用R(3.2.2)编译它:
#include <stdlib.h>
#include <string.h> // memcpy
#include <math.h>
#include <R.h>
#include "ts.h"
void HoltWinters (
double *x, /*as.double(x) */
double *x_adj, /*Adjust time series data, if need be Added*/
int *xl, /*lenx - Length of the current time series*/
double *alpha, /*as.double(max(min(alpha, 1), 0)), */
double *beta, /*as.double(max(min(beta,1), 0)), */
double *gamma, /*as.double(max(min(gamma, 1), 0)), */
double *llamda,/*as.double(max(min(llamda,1),0)), ADDED*/
int *start_time, /*as.integer(start.time), */
int *seasonal, /*as.integer(!+(seasonal == "multiplicative")), */
int *period, /* as.integer(f), */
int *dotrend, /* as.integer(!is.logical(beta) || beta), */
int *doseasonal, /* as.integer(!is.logical(gamma) || gamma), */
double *a, /*l.start - starting values for level*/
double *b, /*b.start - starting values for Trend*/
double *s, /*s.start - starting values for SEasonal*/
double *l, /*t.start - starting values for LLamda ADDED*/
double *k, /* Value for K ADDED*/
double *ck, /*value for ck ADDED*/
/* return values */
double *SSE,
double *level,
double *trend,
double *season
)
{
double res = 0, xhat = 0, stmp = 0, theta = 1, RhoK = 0, phi = 0 ;
int i, i0, s0; /*i is the current t, i0 is the current LESS starting period, and s0 = is the seasonal current LESS Starting period*/
/* copy start values to the beginning of the vectors */
level[0] = *a;
if (*dotrend == 1) trend[0] = *b;
if (*doseasonal == 1) memcpy(season, s, *period * sizeof(double));
for (i = *start_time - 1; i < *xl; i++) {
/* indices for period i */
i0 = i - *start_time + 2;
s0 = i0 + *period - 1;
/* forecast *for* period i */
xhat = level[i0 - 1] + (*dotrend == 1 ? trend[i0 - 1] : 0);
stmp = *doseasonal == 1 ? season[s0 - *period] : (*seasonal != 1);
if (*seasonal == 1)
xhat += stmp;
else
xhat *= stmp;
/* Sum of Squared Errors */
res = x[i] - xhat;
/*adjusting for robustness....Gahds*/
RhoK = (abs(res / theta) <= *k ? *ck * (1 - pow(1 - pow((res / (*k * theta)),2),3)): *ck);
theta = sqrt(*llamda * RhoK * pow(theta,2) + (1 - *llamda) * pow(theta,2));
phi = (abs(res / theta) < *k ? res / theta : ((res / theta) / abs(res / theta) * (*k)));
x_adj[i] = phi * theta + xhat;
res = x_adj[i] - xhat;
*SSE += res * res;
/* estimate of level *in* period i */
if (*seasonal == 1)
level[i0] = *alpha * (x_adj[i] - stmp)
+ (1 - *alpha) * (level[i0 - 1] + trend[i0 - 1]);
else
level[i0] = *alpha * (x_adj[i] / stmp)
+ (1 - *alpha) * (level[i0 - 1] + trend[i0 - 1]);
/* estimate of trend *in* period i */
if (*dotrend == 1)
trend[i0] = *beta * (level[i0] - level[i0 - 1])
+ (1 - *beta) * trend[i0 - 1];
/* estimate of seasonal component *in* period i */
if (*doseasonal == 1) {
if (*seasonal == 1)
season[s0] = *gamma * (x_adj[i] - level[i0])
+ (1 - *gamma) * stmp;
else
season[s0] = *gamma * (x_adj[i] / level[i0])
+ (1 - *gamma) * stmp;
}
}
}
将其加载到R:
R CMD SHLIB C_R_HoltWinters.c
gcc -m64 -I"C:/PROGRA~1/R/R-32~1.2/include" -DNDEBUG -I"d:/RCompile/r-compiling/local/local320/include" -O2 -Wall -std=gnu99 -mtune=core2 -c C_R_HoltWinters.c -o C_R_HoltWinters.o
gcc -m64 -shared -s -static-libgcc -o C_R_HoltWinters.dll tmp.def C_R_HoltWinters.o -Ld:/RCompile/r-compiling/local/local320/lib/x64 -Ld:/RCompile/r-compiling/local/local320/lib -LC:/PROGRA~1/R/R-32~1.2/bin/x64 -lR
检查它是否在那里
dyn.load('C_R_HoltWinters.dll')
是啊,是的,是的。所以,只是对于大便和笑声,我对它进行了测试:
> getLoadedDLLs()
Filename Dynamic.Lookup
base base FALSE
utils C:/Program Files/RRO/R-3.2.2/library/utils/libs/x64/utils.dll FALSE
methods C:/Program Files/RRO/R-3.2.2/library/methods/libs/x64/methods.dll FALSE
RevoUtilsMath C:/Program Files/RRO/R-3.2.2/library/RevoUtilsMath/libs/x64/RevoUtilsMath.dll TRUE
grDevices C:/Program Files/RRO/R-3.2.2/library/grDevices/libs/x64/grDevices.dll FALSE
graphics C:/Program Files/RRO/R-3.2.2/library/graphics/libs/x64/graphics.dll FALSE
stats C:/Program Files/RRO/R-3.2.2/library/stats/libs/x64/stats.dll FALSE
tools C:/Program Files/RRO/R-3.2.2/library/tools/libs/x64/tools.dll FALSE
internet C:/PROGRA~1/RRO/R-32~1.2/modules/x64/internet.dll TRUE
(embedding) (embedding) FALSE
C_R_HoltWinters C:/scripts/R/C_R_HoltWinters.dll TRUE
好的......应该在那里,但事实并非如此。也许它知道我不知道的事情,所以我试着去运行它:
> is.loaded('C_R_HoltWinters')
[1] FALSE
> is.loaded("C_R_HoltWinters")
[1] FALSE
> is.loaded(C_R_HoltWinters)
Error in is.loaded(C_R_HoltWinters) : object 'C_R_HoltWinters' not found
但是当我加载一个名为foo的不同c代码并运行它时,运行正常。
为什么没有能够引用C_R_HoltWinters.dll?如果我把它放入包中,这也会破坏吗?
由于
答案 0 :(得分:0)
好的,这里的问题是符号名称(可能代表C中的函数)和共享库之间的混淆。运行dyn.load('C_R_HoltWinters.dll')
后,您可以通过查看getLoadedDlls()
来检查它是否已加载。现在,is.loaded
正在寻找的是在此DLL中定义的符号。因此,以下代码将向您显示可以从R调用C代码中定义的函数“HoltWinters”:
> is.loaded("HoltWinters")
[1] TRUE
这是你应该在.C调用上使用的函数名。