The R Project SVN R

Rev

Rev 81390 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 81390 Rev 81482
Line 1... Line 1...
1 
/*
 1 
/*
2 
 *  R : A Computer Language for Statistical Data Analysis
 2 
 *  R : A Computer Language for Statistical Data Analysis
3 
 *  Copyright (C) 1998-2021   The R Core Team
 3 
 *  Copyright (C) 1998-2022   The R Core Team
4 
 *  Copyright (C) 2002-2015   The R Foundation
 4 
 *  Copyright (C) 2002-2015   The R Foundation
5 
 *  Copyright (C) 1995, 1996  Robert Gentleman and Ross Ihaka
 5 
 *  Copyright (C) 1995, 1996  Robert Gentleman and Ross Ihaka
6 
 *
 6 
 *
7 
 *  This program is free software; you can redistribute it and/or modify
 7 
 *  This program is free software; you can redistribute it and/or modify
8 
 *  it under the terms of the GNU General Public License as published by
 8 
 *  it under the terms of the GNU General Public License as published by
Line 24... Line 24...
24 
#endif
 24 
#endif
25 
 
 25 
 
26 
#include <Defn.h>
 26 
#include <Defn.h>
27 
#include <Internal.h>
 27 
#include <Internal.h>
28 
#include <Rmath.h>
 28 
#include <Rmath.h>
29 
#include <R_ext/RS.h>     /* for Calloc/Free, F77_CALL */
 29 
#include <R_ext/RS.h>     /* for R_Calloc/R_Free, F77_CALL */
30 
#include <R_ext/BLAS.h>
 30 
#include <R_ext/BLAS.h>
31 
#include <R_ext/Itermacros.h>
 31 
#include <R_ext/Itermacros.h>
32 
 
 32 
 
33 
#include "duplicate.h"
 33 
#include "duplicate.h"
34 
 
 34 
 
Line 1961... Line 1961...
1961 
	LDOUBLE *rans;
 1961 
	LDOUBLE *rans;
1962 
	if(n <= 10000) {
 1962 
	if(n <= 10000) {
1963 
	    R_CheckStack2(n * sizeof(LDOUBLE));
 1963 
	    R_CheckStack2(n * sizeof(LDOUBLE));
1964 
	    rans = (LDOUBLE *) alloca(n * sizeof(LDOUBLE));
 1964 
	    rans = (LDOUBLE *) alloca(n * sizeof(LDOUBLE));
1965 
	    Memzero(rans, n);
 1965 
	    Memzero(rans, n);
1966 
	} else rans = Calloc(n, LDOUBLE);
 1966 
	} else rans = R_Calloc(n, LDOUBLE);
1967 
	if (!keepNA && OP == 3) Cnt = Calloc(n, int);
 1967 
	if (!keepNA && OP == 3) Cnt = R_Calloc(n, int);
1968 
 
 1968 
 
1969 
	for (R_xlen_t j = 0; j < p; j++) {
 1969 
	for (R_xlen_t j = 0; j < p; j++) {
1970 
	    LDOUBLE *ra = rans;
 1970 
	    LDOUBLE *ra = rans;
1971 
	    switch (type) {
 1971 
	    switch (type) {
1972 
	    case REALSXP:
 1972 
	    case REALSXP:
Line 2018... Line 2018...
2018 
	    else
 2018 
	    else
2019 
		for (R_xlen_t i = 0; i < n; i++) rans[i] /= Cnt[i];
 2019 
		for (R_xlen_t i = 0; i < n; i++) rans[i] /= Cnt[i];
2020 
	}
 2020 
	}
2021 
	for (R_xlen_t i = 0; i < n; i++) REAL(ans)[i] = (double) rans[i];
 2021 
	for (R_xlen_t i = 0; i < n; i++) REAL(ans)[i] = (double) rans[i];
2022 
 
 2022 
 
2023 
	if (!keepNA && OP == 3) Free(Cnt);
 2023 
	if (!keepNA && OP == 3) R_Free(Cnt);
2024 
	if(n > 10000) Free(rans);
 2024 
	if(n > 10000) R_Free(rans);
2025 
    }
 2025 
    }
2026 
 
 2026 
 
2027 
    UNPROTECT(1);
 2027 
    UNPROTECT(1);
2028 
    return ans;
 2028 
    return ans;
2029 
}
 2029 
}