[Wavetiling-commits] r40 - pkg/src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon May 21 11:23:14 CEST 2012
Author: ppipeler
Date: 2012-05-21 11:23:13 +0200 (Mon, 21 May 2012)
New Revision: 40
Removed:
pkg/src/MAPmarlikImp.c
Modified:
pkg/src/waveTiling.c
Log:
Deleted: pkg/src/MAPmarlikImp.c
===================================================================
--- pkg/src/MAPmarlikImp.c 2012-05-21 08:27:21 UTC (rev 39)
+++ pkg/src/MAPmarlikImp.c 2012-05-21 09:23:13 UTC (rev 40)
@@ -1,32 +0,0 @@
-void MAPMARGIMP(double *Din,int *K, double *vareps,double *Bout,double *varBout,double *Phiout, double *X, double *XtX, int *q,int *N,int *ends)
-{
-int i,j,m,n,Jcount=0;
-double phi;
-for (i=0;i<*K;i++)
-{
- if (i>=ends[Jcount]) Jcount++;
- for (m=0;m<*q;m++)
- {
- phi=0;
- for (j=0;j<*N;j++)
- {
- phi+=X[j+m*(*N)]*Din[j+i*(*N)];
- }
- Bout[m*(*K)+i]=phi;
- phi=phi*phi/XtX[m]/XtX[m]/(vareps[Jcount])/3-1/XtX[m];
- if (phi<=0)
- {
- Bout[m*(*K)+i]=0;
- varBout[m*(*K)+i]=0;
- Phiout[m*(*K)+i]=0;
- }
- else
- {
- Bout[m*(*K)+i]=Bout[m*(*K)+i]/(XtX[m]+1/phi);
- varBout[m*(*K)+i]=(vareps[Jcount])/(XtX[m]+1/phi);
- Phiout[m*(*K)+i]=phi;
- };
-
- }
-}
-}
Modified: pkg/src/waveTiling.c
===================================================================
--- pkg/src/waveTiling.c 2012-05-21 08:27:21 UTC (rev 39)
+++ pkg/src/waveTiling.c 2012-05-21 09:23:13 UTC (rev 40)
@@ -109,6 +109,44 @@
}
}
+void MAPMARGIMPEQSMOOTH(double *Din,int *K, double *vareps,double *Bout,double *varBout,double *Phiout, double *X, double *XtX, int *q,int *N,int *ends)
+{
+int i,j,m,n,Jcount=0;
+double phi,XDm,XD;
+for (i=0;i<*K;i++)
+{
+ if (i>=ends[Jcount]) Jcount++;
+ XD=0;
+ for (m=0;m<*q;m++)
+ {
+ XDm=0;
+ for (j=0;j<*N;j++)
+ {
+ XDm+=X[j+m*(*N)]*Din[j+i*(*N)];
+ }
+ Bout[m*(*K)+i]=XDm;
+ XD+=XDm;
+ }
+ phi=XD*XD/(*q+2)/(vareps[Jcount])-1;
+ for (m=0;m<*q;m++)
+ {
+ if (phi<=0)
+ {
+ Bout[m*(*K)+i]=0;
+ varBout[m*(*K)+i]=0;
+ Phiout[m*(*K)+i]=0;
+ }
+ else
+ {
+ Bout[m*(*K)+i]=Bout[m*(*K)+i]/(XtX[m]+1/phi);
+ varBout[m*(*K)+i]=(vareps[Jcount])/(XtX[m]+1/phi);
+ Phiout[m*(*K)+i]=phi;
+ };
+
+ }
+}
+}
+
/* Registration information for DLL */
R_CMethodDef cMethods[] = {
{ "MAPMARG", ( DL_FUNC ) &MAPMARG, 11, /*{ REALSXP, INTSXP, REALSXP, REALSXP, REALSXP, REALSXP, REALSXP, REALSXP, INTSXP, INTSXP, INTSXP }*/ },
@@ -116,6 +154,8 @@
{ "MAPMARGEQSMOOTH", ( DL_FUNC ) &MAPMARGEQSMOOTH, 11, /*{ REALSXP, INTSXP, REALSXP, REALSXP, REALSXP, REALSXP, REALSXP, REALSXP, INTSXP, INTSXP, INTSXP }*/ },
{ NULL, NULL, 0 },
{ "MAPMARGIMP", ( DL_FUNC ) &MAPMARGIMP, 11, /*{ REALSXP, INTSXP, REALSXP, REALSXP, REALSXP, REALSXP, REALSXP, REALSXP, INTSXP, INTSXP, INTSXP }*/ },
+ { NULL, NULL, 0 },
+ { "MAPMARGIMPEQSMOOTH", ( DL_FUNC ) &MAPMARGIMPEQSMOOTH, 11, /*{ REALSXP, INTSXP, REALSXP, REALSXP, REALSXP, REALSXP, REALSXP, REALSXP, INTSXP, INTSXP, INTSXP }*/ },
{ NULL, NULL, 0 }
};
More information about the Wavetiling-commits
mailing list