[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