// ===========================================================
//
// Methods.cpp: the C/C++ codes for the SeqArray package
//
// Copyright (C) 2015-2026    Xiuwen Zheng
//
// This file is part of SeqArray.
//
// SeqArray is free software: you can redistribute it and/or modify it
// under the terms of the GNU General Public License Version 3 as
// published by the Free Software Foundation.
//
// SeqArray is distributed in the hope that it will be useful, but
// WITHOUT ANY WARRANTY; without even the implied warranty of
// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
// GNU General Public License for more details.
//
// You should have received a copy of the GNU General Public License
// along with SeqArray.
// If not, see <http://www.gnu.org/licenses/>.

#include "Index.h"
#include <Rdefines.h>
#include <R_ext/Rdynload.h>
#include <string>
#include <vector>

using namespace std;
using namespace SeqArray;


// used in FC_SetPackedGenoSxV() and FC_SetPackedGenoVxS()

static inline unsigned char g2b(Rbyte g)
{
	// since Rbyte is unsigned
	return (g<=2) ? g : 3;
}

static inline unsigned char g2b(int g)
{
	return (0<=g && g<=2) ? g : 3;
}

static inline unsigned char g2b(double g)
{
	return R_FINITE(g) ? g2b((int)round(g)) : 3;
}

template<typename TYPE>
	static void packed_geno_SxV(Rbyte *p, TYPE *s, size_t n)
{
	unsigned char b0, b1, b2, b3;
	for (; n >= 4; n-=4, s+=4)
	{
		b0 = g2b(s[0]); b1 = g2b(s[1]); b2 = g2b(s[2]); b3 = g2b(s[3]);
		*p++ = b0 | (b1<<2) | (b2<<4) | (b3<<6);
	}
	switch (n)
	{
	case 3:
		b0 = g2b(s[0]); b1 = g2b(s[1]); b2 = g2b(s[2]);
		*p++ = b0 | (b1<<2) | (b2<<4) | 0xC0;  // 0xC0 = (0x03<<6);
		break;
	case 2:
		b0 = g2b(s[0]); b1 = g2b(s[1]);
		*p++ = b0 | (b1<<2) | 0xF0;  // (0x03<<4) | (0x03<<6);
		break;
	case 1:
		b0 = g2b(s[0]);
		*p++ = b0 | 0xFC;  // (0x03<<2) | (0x03<<4) | (0x03<<6);
	}
}


template<typename TYPE>
	static void packed_geno_VxS(Rbyte *p, TYPE *s, size_t n, size_t m,
		unsigned char bit_shift)
{
	bit_shift *= 2;  // since bit_shift is 0, 1, 2 or 3
	const unsigned char mask = ~((0x03 << bit_shift));
	for (size_t i=0; i < n; i++, p+=m)
	{
		unsigned char b = g2b(s[i]);
		*p = ((*p) & mask) | (b << bit_shift);
	}
}

static void packed_geno_VxS_missing(Rbyte *p, size_t n, size_t m,
	unsigned char bit_shift)
{
	bit_shift *= 2;  // since bit_shift is 0, 1, 2 or 3
	const unsigned char mask = (0x03 << bit_shift);
	for (size_t i=0; i < n; i++, p+=m) *p |= mask;
}


// ======================================================================

extern "C"
{

static const char *ERR_DS_TYPE = "Invalid type of dosage.";
static const char *ERR_DS_DIM  = "Invalid dimension of dosage.";

static void get_ds_n_m(SEXP DS, int &n, int &m)
{
	n = XLENGTH(DS); m = 1;
	SEXP dm = GET_DIM(DS);
	if (!Rf_isNull(dm))
	{
		if (XLENGTH(dm) != 2)
			throw ErrSeqArray("# of dimensions should be 2 for dosages.");
		m = INTEGER(dm)[1];
	}
}


// ======================================================================

/// Calculate the missing rate per variant
COREARRAY_DLL_EXPORT SEXP FC_Missing_PerVariant(SEXP Geno)
{
	size_t n = XLENGTH(Geno), n_miss;
	switch (TYPEOF(Geno))
	{
	case RAWSXP:
		n_miss = vec_i8_count((const char*)RAW(Geno), n, (char)NA_RAW); break;
	case INTSXP:
		n_miss = vec_i32_count(INTEGER(Geno), n, NA_INTEGER); break;
	case REALSXP:
		n_miss = vec_f64_num_notfinite(REAL(Geno), n); break;
	default:
		throw ErrSeqArray(ERR_DS_TYPE);
	}
	return Rf_ScalarReal((n > 0) ? (double(n_miss) / n) : R_NaN);
}

/// Calculate the missing rate per sample
COREARRAY_DLL_EXPORT SEXP FC_Missing_PerSamp(SEXP Geno, SEXP sum)
{
	int *pdim = INTEGER(GET_DIM(Geno));
	int num_ploidy=pdim[0], num_sample=pdim[1];
	int *pS = INTEGER(sum);

	if (TYPEOF(Geno) == RAWSXP)
	{
		const Rbyte *pG = RAW(Geno), MISSING=NA_RAW;
		for (int i=0; i < num_sample; i++)
		{
			for (int j=0; j < num_ploidy; j++)
				if (*pG++ == MISSING) pS[i]++;
		}
	} else {
		const int *pG = INTEGER(Geno);
		for (int i=0; i < num_sample; i++)
		{
			for (int j=0; j < num_ploidy; j++)
				if (*pG++ == NA_INTEGER) pS[i]++;
		}
	}

	return R_NilValue;
}

/// Calculate the missing rate per sample for annotation/format/DS
COREARRAY_DLL_EXPORT SEXP FC_Missing_DS_PerSamp(SEXP DS, SEXP sum, SEXP tmp)
{
	int num_samp = XLENGTH(sum), n, m;
	get_ds_n_m(DS, n, m);
	if (m * num_samp != n) throw ErrSeqArray(ERR_DS_DIM);

	int *pT = INTEGER(tmp);
	memset(pT, 0, sizeof(int)*num_samp);
	switch (TYPEOF(DS))
	{
	case RAWSXP:
		{
			const Rbyte *pG = RAW(DS), MISSING=NA_RAW;
			for (int j=0; j < m; j++)
				for (int i=0; i < num_samp; i++)
					if (*pG++ == MISSING) pT[i]++;
			break;
		}
	case INTSXP:
		{
			const int *pG = INTEGER(DS), MISSING=NA_INTEGER;
			for (int j=0; j < m; j++)
				for (int i=0; i < num_samp; i++)
					if (*pG++ == MISSING) pT[i]++;
			break;
		}
	case REALSXP:
		{
			const double *pG = REAL(DS);
			for (int j=0; j < m; j++)
				for (int i=0; i < num_samp; i++)
					if (!R_FINITE(*pG++)) pT[i]++;
			break;
		}
	default:
		throw ErrSeqArray(ERR_DS_TYPE);
	}

	int *pS = INTEGER(sum);
	for (int i=0; i < num_samp; i++)
		pS[i] += (pT[i] > 0) ? 1 : 0;

	return R_NilValue;
}

/// Calculate the missing rate per sample and variant
COREARRAY_DLL_EXPORT SEXP FC_Missing_SampVariant(SEXP Geno, SEXP sum)
{
	int *pdim = INTEGER(GET_DIM(Geno));
	int num_ploidy=pdim[0], num_sample=pdim[1];
	int *pS = INTEGER(sum), n=0;

	if (TYPEOF(Geno) == RAWSXP)
	{
		const Rbyte *pG = RAW(Geno), MISSING=NA_RAW;
		for (int i=0; i < num_sample; i++)
		{
			for (int j=0; j < num_ploidy; j++)
				if (*pG++ == MISSING) { pS[i]++; n++; }
		}
	} else {
		const int *pG = INTEGER(Geno);
		for (int i=0; i < num_sample; i++)
		{
			for (int j=0; j < num_ploidy; j++)
				if (*pG++ == NA_INTEGER) { pS[i]++; n++; }
		}
	}

	return Rf_ScalarReal((double)n / (num_ploidy*num_sample));
}

/// Calculate the missing rate per sample and variant
COREARRAY_DLL_EXPORT SEXP FC_Missing_DS_SampVariant(SEXP DS, SEXP sum, SEXP tmp)
{
	int num_samp = XLENGTH(sum), n, m;
	get_ds_n_m(DS, n, m);
	if (m * num_samp != n) throw ErrSeqArray(ERR_DS_DIM);

	int *pT = INTEGER(tmp);
	memset(pT, 0, sizeof(int)*num_samp);
	int n_miss;
	switch (TYPEOF(DS))
	{
	case RAWSXP:
		{
			const Rbyte *pG = RAW(DS), MISSING=NA_RAW;
			n_miss = vec_i8_count((const char*)pG, n, (char)NA_RAW);
			for (int j=0; j < m; j++)
				for (int i=0; i < num_samp; i++)
					if (*pG++ == MISSING) pT[i]++;
			break;
		}
	case INTSXP:
		{
			const int *pG = INTEGER(DS), MISSING=NA_INTEGER;
			n_miss = vec_i32_count(pG, n, NA_INTEGER);
			for (int j=0; j < m; j++)
				for (int i=0; i < num_samp; i++)
					if (*pG++ == MISSING) pT[i]++;
			break;
		}
	case REALSXP:
		{
			const double *pG = REAL(DS);
			n_miss = vec_f64_num_notfinite(pG, n);
			for (int j=0; j < m; j++)
				for (int i=0; i < num_samp; i++)
					if (!R_FINITE(*pG++)) pT[i]++;
			break;
		}
	default:
		throw ErrSeqArray(ERR_DS_TYPE);
	}

	int *pS = INTEGER(sum);
	for (int i=0; i < num_samp; i++)
		pS[i] += (pT[i] > 0) ? 1 : 0;

	return Rf_ScalarReal((n > 0) ? (double(n_miss) / n) : R_NaN);
}


// ======================================================================

static int  AFreq_Index  = 0;
static int* AFreq_RefPtr = NULL;
static SEXP AFreq_Allele = NULL;
static bool AFreq_Minor  = false;  //< true for return MAF/MAC
static int  AFreq_Ploidy = 0;      //< ploidy, e.g., 2 by default

/// Set the reference allele with an index
COREARRAY_DLL_EXPORT SEXP FC_AF_SetIndex(SEXP idx, SEXP minor, SEXP ploidy)
{
	if (XLENGTH(idx) == 1)
	{
		AFreq_Index = Rf_asInteger(idx);
		AFreq_RefPtr = NULL;
	} else {
		AFreq_Index = 0;
		AFreq_RefPtr = INTEGER(idx);
	}
	AFreq_Minor = (Rf_asLogical(minor)==TRUE);
	AFreq_Ploidy = Rf_asInteger(ploidy);
	return R_NilValue;
}

/// Set the reference allele with string
COREARRAY_DLL_EXPORT SEXP FC_AF_SetAllele(SEXP allele, SEXP minor, SEXP ploidy)
{
	AFreq_Allele = allele;
	AFreq_Index = 0;
	AFreq_Minor = (Rf_asLogical(minor)==TRUE);
	AFreq_Ploidy = Rf_asInteger(ploidy);
	return R_NilValue;
}

// ========

/// Get a list of allele frequencies
COREARRAY_DLL_EXPORT SEXP FC_AF_List(SEXP List)
{
	SEXP Geno = VECTOR_ELT(List, 0);
	const size_t N = XLENGTH(Geno);

	int nAllele = Rf_asInteger(VECTOR_ELT(List, 1));
	SEXP rv = NEW_NUMERIC(nAllele);
	double *pV = REAL(rv);

	size_t n1, n2, n3;
	switch (nAllele)
	{
	case 2:
		if (TYPEOF(Geno) == RAWSXP)
			vec_i8_count3((const char*)RAW(Geno), N, 0, 1, (char)NA_RAW, &n1, &n2, &n3);
		else
			vec_i32_count3(INTEGER(Geno), N, 0, 1, NA_INTEGER, &n1, &n2, &n3);
		n3 = N - n3;
		if (n3 > 0)
		{
			pV[0] = (double)n1 / n3;
			pV[1] = (double)n2 / n3;
		} else
			pV[0] = pV[1] = R_NaN;
		break;

	case 1:
		if (TYPEOF(Geno) == RAWSXP)
			vec_i8_count2((const char*)RAW(Geno), N, 0, (char)NA_RAW, &n1, &n2);
		else
			vec_i32_count2(INTEGER(Geno), N, 0, NA_INTEGER, &n1, &n2);
		n2 = N - n2;
		pV[0] = (n2 > 0) ? (double)n1 / n2 : R_NaN;
		break;

	default:
		int num = 0;
		memset((void*)pV, 0, sizeof(double)*nAllele);
		if (TYPEOF(Geno) == RAWSXP)
		{
			C_UInt8 *p = (C_UInt8*)RAW(Geno);
			for (size_t n=N; n > 0; n--)
			{
				C_UInt8 g = *p++;
				if (g != NA_RAW)
				{
					num ++;
					if (g < nAllele) pV[g] ++;
				}
			}
		} else {
			int *p = INTEGER(Geno);
			for (size_t n=N; n > 0; n--)
			{
				int g = *p++;
				if (g != NA_INTEGER)
				{
					num ++;
					if ((0 <= g) && (g < nAllele))
						pV[g] ++;
				}
			}
		}
		if (num > 0)
		{
			const double scale = 1.0 / num;
			for (; (nAllele--) > 0;) (*pV++) *= scale;
		} else {
			for (; (nAllele--) > 0;) (*pV++) = R_NaN;
		}
	}

	return rv;
}

/// Get reference allele frequency
COREARRAY_DLL_EXPORT SEXP FC_AF_Ref(SEXP Geno)
{
	const size_t N = XLENGTH(Geno);
	size_t n, m;
	if (TYPEOF(Geno) == RAWSXP)
		vec_i8_count2((const char*)RAW(Geno), N, 0, (char)NA_RAW, &m, &n);
	else
		vec_i32_count2(INTEGER(Geno), N, 0, NA_INTEGER, &m, &n);
	n = N - n;
	if (n > 0)
	{
		double p = double(m) / n;
		if (AFreq_Minor && p>0.5) p = 1 - p;
		return Rf_ScalarReal(p);
	} else
		return Rf_ScalarReal(R_NaN);
}

#define GET_SUM_NUM(TYPE, TYPEPTR, START, NA_VAL, N)  \
	{ \
		const TYPE *p = TYPEPTR(DS) + START; \
		for (int i=0; i < N; i++, p++) \
			if (*p != NA_VAL) { sum += *p; num++; } \
		break; \
	}
#define GET_SUM_NUM_F(START, N)  \
	{ \
		const double *p = REAL(DS) + START; \
		for (int i=0; i < N; i++, p++) \
			if (R_FINITE(*p)) { sum += *p; num++; } \
		break; \
	}

/// Get reference allele frequency from dosage
COREARRAY_DLL_EXPORT SEXP FC_AF_DS_Ref(SEXP DS)
{
	int n, m, num=0;
	get_ds_n_m(DS, n, m);

	double sum=0;
	switch (TYPEOF(DS))
	{
	case RAWSXP:
		GET_SUM_NUM(Rbyte, RAW, 0, NA_RAW, n)
	case INTSXP:
		GET_SUM_NUM(int, INTEGER, 0, NA_INTEGER, n)
	case REALSXP:
		GET_SUM_NUM_F(0, n)
	default:
		throw ErrSeqArray(ERR_DS_TYPE);
	}

	if (num > 0)
	{
		double p = 1 - sum * m / (num * AFreq_Ploidy);
		if (AFreq_Minor && p>0.5) p = 1 - p;
		return Rf_ScalarReal(p);
	} else
		return Rf_ScalarReal(R_NaN);
}

/// Get allele frequency
COREARRAY_DLL_EXPORT SEXP FC_AF_Index(SEXP List)
{
	SEXP Geno = VECTOR_ELT(List, 0);
	const int nAllele = Rf_asInteger(VECTOR_ELT(List, 1));

	const size_t N = XLENGTH(Geno);
	size_t n = 0, m = 0;
	int A = (AFreq_RefPtr==NULL) ?
		AFreq_Index : AFreq_RefPtr[AFreq_Index++];

	if (A < nAllele)
	{
		if (TYPEOF(Geno) == RAWSXP)
			vec_i8_count2((const char*)RAW(Geno), N, A, (char)NA_RAW, &m, &n);
		else
			vec_i32_count2(INTEGER(Geno), N, A, NA_INTEGER, &m, &n);
		n = N - n;
	}

	if (n > 0)
	{
		double p = double(m) / n;
		if (AFreq_Minor && p>0.5) p = 1 - p;
		return Rf_ScalarReal(p);
	} else
		return Rf_ScalarReal(R_NaN);
}

/// Get allele frequency
COREARRAY_DLL_EXPORT SEXP FC_AF_DS_Index(SEXP List)
{
	SEXP DS = VECTOR_ELT(List, 0);
	const int A = (AFreq_RefPtr==NULL) ?
		AFreq_Index : AFreq_RefPtr[AFreq_Index++];
	if (A == 0) return FC_AF_DS_Ref(DS);

	const int nAllele = Rf_asInteger(VECTOR_ELT(List, 1));
	if (A >= nAllele) return Rf_ScalarReal(R_NaN);

	int n, m;
	get_ds_n_m(DS, n, m);
	if (A > m) return Rf_ScalarReal(R_NaN);

	double sum=0;
	int num = 0, nrow = n/m;
	switch (TYPEOF(DS))
	{
	case RAWSXP:
		GET_SUM_NUM(Rbyte, RAW, nrow*(A-1), NA_RAW, nrow)
	case INTSXP:
		GET_SUM_NUM(int, INTEGER, nrow*(A-1), NA_INTEGER, nrow)
	case REALSXP:
		GET_SUM_NUM_F(nrow*(A-1), nrow)
	default:
		throw ErrSeqArray(ERR_DS_TYPE);
	}

	if (num > 0)
	{
		double p = sum / (num * AFreq_Ploidy);
		if (AFreq_Minor && p>0.5) p = 1 - p;
		return Rf_ScalarReal(p);
	} else
		return Rf_ScalarReal(R_NaN);
}

/// Get allele frequency
COREARRAY_DLL_EXPORT SEXP FC_AF_Allele(SEXP List)
{
	SEXP Ref = STRING_ELT(AFreq_Allele, AFreq_Index++);
	int A = -1;
	if (Ref != NA_STRING)
		A = GetIndexOfAllele(CHAR(Ref), CHAR(STRING_ELT(VECTOR_ELT(List, 1), 0)));

	size_t n = 0, m = 0;
	if (A >= 0)
	{
		SEXP Geno = VECTOR_ELT(List, 0);
		const size_t N = XLENGTH(Geno);
		if (TYPEOF(Geno) == RAWSXP)
		{
			if (A < 255)
				vec_i8_count2((const char*)RAW(Geno), N, A, (char)NA_RAW, &m, &n);
			else
				n = N;
		} else
			vec_i32_count2(INTEGER(Geno), N, A, NA_INTEGER, &m, &n);
		n = N - n;
	}

	if (n > 0)
	{
		double p = double(m) / n;
		if (AFreq_Minor && p>0.5) p = 1 - p;
		return Rf_ScalarReal(p);
	} else
		return Rf_ScalarReal(R_NaN);
}

/// Get allele frequency
COREARRAY_DLL_EXPORT SEXP FC_AF_DS_Allele(SEXP List)
{
	SEXP Ref = STRING_ELT(AFreq_Allele, AFreq_Index++);
	int A = -1;
	if (Ref != NA_STRING)
		A = GetIndexOfAllele(CHAR(Ref), CHAR(STRING_ELT(VECTOR_ELT(List, 1), 0)));

	SEXP DS = VECTOR_ELT(List, 0);
	if (A == 0) return FC_AF_DS_Ref(DS);

	int n, m;
	get_ds_n_m(DS, n, m);  // get total # and # of columns
	double sum = 0;
	int num = 0, nrow = n/m;
	if (A > 0 && A <= m)
	{
		switch (TYPEOF(DS))
		{
		case RAWSXP:
			GET_SUM_NUM(Rbyte, RAW, nrow*(A-1), NA_RAW, nrow)
		case INTSXP:
			GET_SUM_NUM(int, INTEGER, nrow*(A-1), NA_INTEGER, nrow)
		case REALSXP:
			GET_SUM_NUM_F(nrow*(A-1), nrow)
		default:
			throw ErrSeqArray(ERR_DS_TYPE);
		}
	}

	if (num > 0)
	{
		double p = sum / (num * AFreq_Ploidy);
		if (AFreq_Minor && p>0.5) p = 1 - p;
		return Rf_ScalarReal(p);
	} else
		return Rf_ScalarReal(R_NaN);
}


// ======================================================================

/// Get reference allele count
COREARRAY_DLL_EXPORT SEXP FC_AC_Ref(SEXP Geno)
{
	const size_t N = XLENGTH(Geno);
	size_t n, m;
	if (TYPEOF(Geno) == RAWSXP)
		vec_i8_count2((const char*)RAW(Geno), N, 0, (char)NA_RAW, &m, &n);
	else
		vec_i32_count2(INTEGER(Geno), N, 0, NA_INTEGER, &m, &n);
	if (AFreq_Minor)
	{
		size_t m0 = N - n - m;  // allele count for alternative
		if (m0 < m) m = m0;
	}
	return Rf_ScalarInteger((n < N) ? (int)m : NA_INTEGER);
}

/// Get reference allele count from dosage
COREARRAY_DLL_EXPORT SEXP FC_AC_DS_Ref(SEXP DS)
{
	int n, m, num=0;
	get_ds_n_m(DS, n, m);

	double sum=0;
	switch (TYPEOF(DS))
	{
	case RAWSXP:
		GET_SUM_NUM(Rbyte, RAW, 0, NA_RAW, n)
	case INTSXP:
		GET_SUM_NUM(int, INTEGER, 0, NA_INTEGER, n)
	case REALSXP:
		GET_SUM_NUM_F(0, n)
	default:
		throw ErrSeqArray(ERR_DS_TYPE);
	}

	if (num > 0)
	{
		double totac = double(num * AFreq_Ploidy) / m;
		double ac = totac - sum;
		if (AFreq_Minor && ac>0.5*totac) ac = totac - ac;
		return Rf_ScalarReal(ac);
	} else
		return Rf_ScalarReal(NA_REAL);
}

/// Get allele count from the reference allele index
COREARRAY_DLL_EXPORT SEXP FC_AC_Index(SEXP List)
{
	SEXP Geno = VECTOR_ELT(List, 0);
	const int nAllele = Rf_asInteger(VECTOR_ELT(List, 1));

	const size_t N = XLENGTH(Geno);
	int A = (AFreq_RefPtr==NULL) ?
		AFreq_Index : AFreq_RefPtr[AFreq_Index++];

	int ans;
	if (A < nAllele)
	{
		size_t n, m;
		if (TYPEOF(Geno) == RAWSXP)
			vec_i8_count2((const char*)RAW(Geno), N, A, (char)NA_RAW, &m, &n);
		else
			vec_i32_count2(INTEGER(Geno), N, A, NA_INTEGER, &m, &n);
		if (AFreq_Minor)
		{
			size_t m0 = N - n - m;  // allele count for alternative
			if (m0 < m) m = m0;
		}
		ans = (n < N) ? (int)m : NA_INTEGER;
	} else
		ans = NA_INTEGER;
	
	return Rf_ScalarInteger(ans);
}

/// Get allele count from dosage and the reference allele index
COREARRAY_DLL_EXPORT SEXP FC_AC_DS_Index(SEXP List)
{
	SEXP DS = VECTOR_ELT(List, 0);
	const int A = (AFreq_RefPtr==NULL) ?
		AFreq_Index : AFreq_RefPtr[AFreq_Index++];
	if (A == 0) return FC_AC_DS_Ref(DS);

	const int nAllele = Rf_asInteger(VECTOR_ELT(List, 1));
	if (A >= nAllele) return Rf_ScalarReal(R_NaN);

	int n, m;
	get_ds_n_m(DS, n, m);
	if (A > m) return Rf_ScalarReal(R_NaN);

	double sum=0;
	int num = 0, nrow = n/m;
	switch (TYPEOF(DS))
	{
	case RAWSXP:
		GET_SUM_NUM(Rbyte, RAW, nrow*(A-1), NA_RAW, nrow)
	case INTSXP:
		GET_SUM_NUM(int, INTEGER, nrow*(A-1), NA_INTEGER, nrow)
	case REALSXP:
		GET_SUM_NUM_F(nrow*(A-1), nrow)
	default:
		throw ErrSeqArray(ERR_DS_TYPE);
	}

	if (num > 0)
	{
		double sum2 = num * AFreq_Ploidy - sum;
		if (AFreq_Minor && sum>sum2) sum = sum2;
		return Rf_ScalarReal(sum);
	} else
		return Rf_ScalarReal(NA_REAL);
}

/// Get allele count for a given allele
COREARRAY_DLL_EXPORT SEXP FC_AC_Allele(SEXP List)
{
	SEXP Geno = VECTOR_ELT(List, 0);
	int A = GetIndexOfAllele(
		CHAR(STRING_ELT(AFreq_Allele, AFreq_Index++)),
		CHAR(STRING_ELT(VECTOR_ELT(List, 1), 0)));

	int ans = NA_INTEGER;
	if (A >= 0)
	{
		const size_t N = XLENGTH(Geno);
		size_t n, m;
		if (TYPEOF(Geno) == RAWSXP)
		{
			if (A < 255)
			{
				vec_i8_count2((const char*)RAW(Geno), N, A, (char)NA_RAW, &m, &n);
				if (AFreq_Minor)
				{
					size_t m0 = N - n - m;  // allele count for alternative
					if (m0 < m) m = m0;
				}
				ans = (n < N) ? (int)m : NA_INTEGER;
			}
		} else {
			vec_i32_count2(INTEGER(Geno), N, A, NA_INTEGER, &m, &n);
			if (AFreq_Minor)
			{
				size_t m0 = N - n - m;  // allele count for alternative
				if (m0 < m) m = m0;
			}
			ans = (n < N) ? (int)m : NA_INTEGER;
		}
	}

	return Rf_ScalarInteger(ans);
}

/// Get allele count
COREARRAY_DLL_EXPORT SEXP FC_AC_DS_Allele(SEXP List)
{
	SEXP Ref = STRING_ELT(AFreq_Allele, AFreq_Index++);
	int A = -1;
	if (Ref != NA_STRING)
		A = GetIndexOfAllele(CHAR(Ref), CHAR(STRING_ELT(VECTOR_ELT(List, 1), 0)));

	SEXP DS = VECTOR_ELT(List, 0);
	if (A == 0) return FC_AC_DS_Ref(DS);

	int n, m;
	get_ds_n_m(DS, n, m);  // get total # and # of columns
	double sum = 0;
	int num = 0, nrow = n/m;
	if (A > 0 && A <= m)
	{
		switch (TYPEOF(DS))
		{
		case RAWSXP:
			GET_SUM_NUM(Rbyte, RAW, nrow*(A-1), NA_RAW, nrow)
		case INTSXP:
			GET_SUM_NUM(int, INTEGER, nrow*(A-1), NA_INTEGER, nrow)
		case REALSXP:
			GET_SUM_NUM_F(nrow*(A-1), nrow)
		default:
			throw ErrSeqArray(ERR_DS_TYPE);
		}
	}

	if (num > 0)
	{
		double sum2 = num * AFreq_Ploidy - sum;
		if (AFreq_Minor && sum>sum2) sum = sum2;
		return Rf_ScalarReal(sum);
	} else
		return Rf_ScalarReal(NA_REAL);
}


// ======================================================================

/// Convert a SeqArray GDS file to a SNP GDS file in `seqGDS2SNP()`
COREARRAY_DLL_EXPORT SEXP FC_AlleleStr(SEXP allele)
{
	const R_xlen_t n = XLENGTH(allele);
	for (R_xlen_t i=0; i < n; i++)
	{
		char *s = (char*)CHAR(STRING_ELT(allele, i));
		while (*s)
		{
			if (*s == ',')
				{ *s = '/'; break; }
			s ++;
		}
	}
	return allele;
}


// ======================================================================

/// Get a list of allele counts
COREARRAY_DLL_EXPORT SEXP FC_AlleleCount(SEXP List)
{
	SEXP Geno = VECTOR_ELT(List, 0);
	const size_t N = XLENGTH(Geno);

	int nAllele = Rf_asInteger(VECTOR_ELT(List, 1));
	SEXP rv = NEW_INTEGER(nAllele);
	int *pV = INTEGER(rv);

	size_t n1, n2;
	switch (nAllele)
	{
	case 2:
		if (TYPEOF(Geno) == RAWSXP)
			vec_i8_count2((const char*)RAW(Geno), N, 0, 1, &n1, &n2);
		else
			vec_i32_count2(INTEGER(Geno), N, 0, 1, &n1, &n2);
		pV[0] = n1; pV[1] = n2;
		break;

	case 1:
		if (TYPEOF(Geno) == RAWSXP)
			pV[0] = vec_i8_count((const char*)RAW(Geno), N, 0);
		else
			pV[0] = vec_i32_count(INTEGER(Geno), N, 0);
		break;

	default:
		memset((void*)pV, 0, sizeof(int)*nAllele);
		if (TYPEOF(Geno) == RAWSXP)
		{
			C_UInt8 *p = (C_UInt8*)RAW(Geno);
			for (size_t n=N; n > 0; n--)
			{
				C_UInt8 g = *p++;
				if (g < nAllele) pV[g] ++;
			}
		} else {
			int *p = INTEGER(Geno);
			for (size_t n=N; n > 0; n--)
			{
				int g = *p++;
				if ((0 <= g) && (g < nAllele)) pV[g] ++;
			}
		}
	}

	return rv;
}


// ======================================================================

// val[0] -- AF/MAF, val[1] -- AC/MAC, val[2] -- missing
static double *af_ac_miss_ptr = NULL;
// ploidy
static int af_ac_miss_ploidy = 0;
// whether return minor AF/AC
static bool af_ac_miss_minor = false;
// whether return alternative allele
static bool af_ac_miss_alt = false;

static inline void swap(double &v1, double &v2)
{
	double tmp = v1;
	v1 = v2; v2 = tmp;
}

/// Initialize maf/mac/missing internal variable
COREARRAY_DLL_EXPORT SEXP FC_AF_AC_MISS_Init(SEXP M_3n, SEXP ploidy,
	SEXP minor, SEXP alt)
{
	af_ac_miss_ptr = REAL(M_3n);  // M_3n is a matrix with three rows
	af_ac_miss_ploidy = Rf_asInteger(ploidy);
	if (af_ac_miss_ploidy < 0) af_ac_miss_ploidy = 2;
	af_ac_miss_minor = (Rf_asLogical(minor) == TRUE);
	af_ac_miss_alt   = (Rf_asLogical(alt) == TRUE);
	return R_NilValue;
}

/// Get MAF/MAC/missing rate from integer genotypes
COREARRAY_DLL_EXPORT SEXP FC_AF_AC_MISS_Geno(SEXP Geno)
{
	const size_t N = XLENGTH(Geno);
	size_t n0, nmiss;
	if (TYPEOF(Geno) == RAWSXP)
		vec_i8_count2((const char*)RAW(Geno), N, 0, (char)NA_RAW, &n0, &nmiss);
	else
		vec_i32_count2(INTEGER(Geno), N, 0, NA_INTEGER, &n0, &nmiss);
	size_t n = N - nmiss;
	// AF/MAF
	double af = R_NaN;
	if (n > 0)
	{
		af = (double)n0 / n;
		if (af_ac_miss_alt) af = 1 - af;
		if (af_ac_miss_minor && (af > 0.5))
			af = 1 - af;
	}
	// AC/MAC
	double ac = n0, ac2 = n - n0;
	if (af_ac_miss_alt) swap(ac, ac2);
	if (af_ac_miss_minor && (ac > ac2)) ac = ac2;

	// output
	af_ac_miss_ptr[0] = af;  // AF or MAF
	af_ac_miss_ptr[1] = (n > 0) ? ac : NA_REAL;  // AC or MAC
	af_ac_miss_ptr[2] = (double)nmiss / N;  // missing rate
	af_ac_miss_ptr += 3;
	return R_NilValue;
}

/// Get AF/AC/missing rate from dosages
COREARRAY_DLL_EXPORT SEXP FC_AF_AC_MISS_DS(SEXP DS)
{
	int n, m, num=0;
	get_ds_n_m(DS, n, m);

	double sum=0;
	switch (TYPEOF(DS))
	{
	case RAWSXP:
		GET_SUM_NUM(Rbyte, RAW, 0, NA_RAW, n)
	case INTSXP:
		GET_SUM_NUM(int, INTEGER, 0, NA_INTEGER, n)
	case REALSXP:
		GET_SUM_NUM_F(0, n)
	default:
		throw ErrSeqArray(ERR_DS_TYPE);
	}

	double af=R_NaN, ac=NA_REAL;
	if (num > 0)
	{
		af = 1 - sum * m / (num * af_ac_miss_ploidy);
		if (af_ac_miss_alt) af = 1 - af;
		if (af_ac_miss_minor && (af > 0.5))
			af = 1 - af;
		double totac = double(num * af_ac_miss_ploidy) / m;
		double ac2 = sum;
		ac = totac - sum;
		if (af_ac_miss_alt) swap(ac, ac2);
		if (af_ac_miss_minor && (ac > ac2)) ac = ac2;
	}

	// output
	af_ac_miss_ptr[0] = af;  // AF or MAF
	af_ac_miss_ptr[1] = ac;  // AC or MAC
	af_ac_miss_ptr[2] = (double)(n - num) / n;  // missing rate
	af_ac_miss_ptr += 3;
	return R_NilValue;
}


// ======================================================================
// ======================================================================

static const char *pkg_digest = "digest";
static int digest_data_type = -1;

#define PKG_LOAD(name)	\
	{ \
		DL_FUNC f =  R_FindSymbol(#name, pkg_digest, NULL); \
		if (!f) \
			Rf_error("No function '%s' in the %s package", #name, pkg_digest); \
		memcpy(&name, &f, sizeof(f)); \
	}

typedef struct _md5_context
{
	C_UInt32 total[2];
	C_UInt32 state[4];
	C_UInt8  buffer[64];
	char tmp[1024];
} md5_context;


static void (*md5_starts)(md5_context*) = NULL;
static void (*md5_update)(md5_context*, void*, C_UInt32) = NULL;
static void (*md5_finish)(md5_context*, C_UInt8[16]) = NULL;
static md5_context md5_ctx;

/// Initialize digest method
COREARRAY_DLL_EXPORT SEXP FC_DigestInit(SEXP Algo)
{
	digest_data_type = -1;
	if (!md5_starts) PKG_LOAD(md5_starts);
	if (!md5_update) PKG_LOAD(md5_update);
	if (!md5_finish) PKG_LOAD(md5_finish);
	(*md5_starts)(&md5_ctx);
	return R_NilValue;
}

/// Finalize digest method
COREARRAY_DLL_EXPORT SEXP FC_DigestDone(SEXP Algo)
{
	C_UInt8 digest[16];
	(*md5_finish)(&md5_ctx, digest);

	int Len = sizeof(digest);
	char buffer[1024 + 1];
	char *p = buffer;
	C_UInt8 *Code = digest;
	for (; Len > 0; Code++, Len--)
	{
		C_UInt8 v1 = (*Code) & 0x0F;
		C_UInt8 v2 = (*Code) >> 4;
		*p++ = (v2 < 10) ? (v2 + '0') : (v2 - 10 + 'a');
		*p++ = (v1 < 10) ? (v1 + '0') : (v1 - 10 + 'a');
	}
	*p = 0;

	return Rf_mkString(buffer);
}

/// Applied digest function
COREARRAY_DLL_EXPORT SEXP FC_DigestScan(SEXP Data)
{
	if (digest_data_type < 0)
	{
		if (TYPEOF(Data) == RAWSXP)
			digest_data_type = 0;
		else if (TYPEOF(Data) == INTSXP)
			digest_data_type = !Rf_inherits(Data, "factor") ? 1 : 2;
		else if (Rf_isLogical(Data))
			digest_data_type = 3;
		else if (Rf_isReal(Data))
			digest_data_type = 4;
		else if (Rf_isString(Data))
			digest_data_type = 5;
		else if (!Rf_isNull(Data))
			Rf_error("Not support data type.");
	}
	switch (digest_data_type)
	{
		case 0:
			(*md5_update)(&md5_ctx, RAW(Data), XLENGTH(Data));
			break;
		case 1:
			(*md5_update)(&md5_ctx, INTEGER(Data), XLENGTH(Data)*sizeof(int));
			break;
		case 2:
			{
				int *p = INTEGER(Data);
				SEXP ls = Rf_getAttrib(Data, R_LevelsSymbol);
				int nls = LENGTH(ls);
				for (size_t n=XLENGTH(Data); n > 0; n--, p++)
				{
					const char *s;
					if ((0 < *p) && (*p <= nls))
						s = CHAR(STRING_ELT(ls, *p - 1));
					else
						s = "";
					(*md5_update)(&md5_ctx, (void*)s, strlen(s)+1);
				}
			}
			break;
		case 3:
			(*md5_update)(&md5_ctx, LOGICAL(Data), XLENGTH(Data)*sizeof(int));
			break;
		case 4:
			(*md5_update)(&md5_ctx, REAL(Data), XLENGTH(Data)*sizeof(double));
			break;
		case 5:
			{
				const size_t n = XLENGTH(Data);
				for (size_t i=0; i < n; i++)
				{
					const char *s = CHAR(STRING_ELT(Data, i));
					(*md5_update)(&md5_ctx, (void*)s, strlen(s)+1);
				}
			}
	}

	return R_NilValue;
}


// ======================================================================

static Rbyte *geno_raw_ptr = NULL;
static size_t geno_nrow = 0;
static size_t geno_ncol = 0;
static size_t geno_index = 0;

static const char *ERR_PACKED_GENO_N =
	"Internal error: store genotype in packed raw format!";
static const char *ERR_PACKED_GENO_TYPE =
	"Internal error: invalid data type of dosage!";

/// initialize the packed raw genotype matrix
COREARRAY_DLL_EXPORT SEXP FC_InitPackedGeno(SEXP geno)
{
	geno_raw_ptr = RAW(geno);
	const int *dm = INTEGER(GET_DIM(geno));
	geno_nrow = dm[0];
	geno_ncol = dm[1];
	geno_index = 0;
	return R_NilValue;
}

/// store dosage in a 2-bit packed matrix (sample by variant)
COREARRAY_DLL_EXPORT SEXP FC_SetPackedGenoSxV(SEXP dosage)
{
	Rbyte *p = geno_raw_ptr + geno_nrow * geno_index;
	if (!Rf_isNull(dosage))
	{
		size_t n = Rf_xlength(dosage);
		if (n > geno_nrow*4) Rf_error("%s", ERR_PACKED_GENO_N);
		switch (TYPEOF(dosage))
		{
		case RAWSXP:
			packed_geno_SxV<Rbyte>(p, RAW(dosage), n);
			break;
		case INTSXP:
			packed_geno_SxV<int>(p, INTEGER(dosage), n);
			break;
		case REALSXP:
			packed_geno_SxV<double>(p, REAL(dosage), n);
			break;
		default:
			Rf_error("%s", ERR_PACKED_GENO_TYPE);
		}
	} else {
		memset(p, 0xFF, geno_nrow);
	}
	geno_index ++;
	return R_NilValue;
}

/// store dosage in a 2-bit packed matrix (variant by sample)
COREARRAY_DLL_EXPORT SEXP FC_SetPackedGenoVxS(SEXP dosage)
{
	Rbyte *p = geno_raw_ptr + (geno_index >> 2);
	unsigned char bit_shift = geno_index & 0x03;
	if (!Rf_isNull(dosage))
	{
		size_t n = Rf_xlength(dosage);
		if (n != geno_ncol) Rf_error("%s", ERR_PACKED_GENO_N);
		switch (TYPEOF(dosage))
		{
		case RAWSXP:
			packed_geno_VxS<Rbyte>(p, RAW(dosage), n, geno_nrow, bit_shift);
			break;
		case INTSXP:
			packed_geno_VxS<int>(p, INTEGER(dosage), n, geno_nrow, bit_shift);
			break;
		case REALSXP:
			packed_geno_VxS<double>(p, REAL(dosage), n, geno_nrow, bit_shift);
			break;
		default:
			Rf_error("%s", ERR_PACKED_GENO_TYPE);
		}
	} else {
		packed_geno_VxS_missing(p, geno_ncol, geno_nrow, bit_shift);
	}
	geno_index ++;
	return R_NilValue;
}

/// store dosage subset in a 2-bit packed matrix (sample by variant)
COREARRAY_DLL_EXPORT SEXP FC_SetPackedGenoSubsetSxV(SEXP geno_out,
	SEXP block_i, SEXP block_size, SEXP geno_sub)
{
	const int i_col = (Rf_asInteger(block_i) - 1) * Rf_asInteger(block_size);
	const size_t nrow = INTEGER(GET_DIM(geno_out))[0];
	Rbyte *p = RAW(geno_out) + nrow*i_col;
	const Rbyte *s = RAW(geno_sub);
	const size_t n = Rf_xlength(geno_sub);
	memcpy(p, s, n);
	return R_NilValue;
}

/// store dosage subset in a 2-bit packed matrix (variant by sample)
COREARRAY_DLL_EXPORT SEXP FC_SetPackedGenoSubsetVxS(SEXP geno_out,
	SEXP block_i, SEXP block_size, SEXP geno_sub)
{
	const int *d1 = INTEGER(GET_DIM(geno_out));
	const int *d2 = INTEGER(GET_DIM(geno_sub));
	const size_t nr1 = d1[0], nc1 = d1[1];
	const size_t nr2 = d2[0], nc2 = d2[1];
	if (nc1 != nc2)
		Rf_error("Internal error in FC_SetPackedGenoSubsetVxS: # of columns.");
	const int i_row = (Rf_asInteger(block_i)-1) * Rf_asInteger(block_size) / 4;
	Rbyte *p = RAW(geno_out) + i_row;
	Rbyte *s = RAW(geno_sub);
	for (size_t i=0; i < nc1; i++)
	{
		memcpy(p, s, nr2);
		p += nr1; s += nr2;
	}
	return R_NilValue;
}


// ======================================================================

/// Many-to-many left join on integer position key using sort-merge join
/// pos0: full query position vector
/// ref0, alt0: query ref/alt character vectors (or R_NilValue if NULL)
/// ord0: sorted indices into pos0 (1-based, subset for this chromosome)
/// pos1, idx1: GDS positions and their variant indices
/// ord1: order indices for pos1 (1-based, from R's order())
/// node: GDS node for allele data
/// multi_pos: whether to return multiple matches for the same position 
/// Returns a list with i0, i1 and i2 integer vectors
COREARRAY_DLL_EXPORT SEXP SEQ_FindMatchIndex(SEXP pos0,
	SEXP ref0, SEXP alt0, SEXP ord0, SEXP pos1, SEXP idx1, SEXP ord1,
	SEXP node, SEXP multi_pos)
{
	const R_xlen_t n0 = XLENGTH(ord0);
	const R_xlen_t n1 = XLENGTH(pos1);
	const int *p0 = INTEGER(pos0);
	const int *k0 = INTEGER(ord0);  // 1-based sorted indices into p0
	const int *p1 = INTEGER(pos1);
	const int *i1 = INTEGER(idx1);
	const int *k1 = INTEGER(ord1);  // 1-based sort order
	const bool use_allele = !Rf_isNull(ref0) && !Rf_isNull(alt0);
	const bool need_i2 = Rf_asLogical(multi_pos) != FALSE;  // TRUE or NA

	COREARRAY_TRY

		R_xlen_t total = 0;
		if (need_i2)
		{
			// First pass: max count total output rows using sort-merge
			R_xlen_t i = 0, j = 0;
			while (i < n0)
			{
				int v0 = p0[k0[i] - 1];
				// advance j past values smaller than v0
				while (j < n1 && p1[k1[j] - 1] < v0) j++;
				if (j < n1 && p1[k1[j] - 1] == v0)
				{
					// count duplicates on both sides
					R_xlen_t cnt0 = 0;
					for (R_xlen_t ii = i; ii < n0 && p0[k0[ii] - 1] == v0; ii++)
						cnt0 ++;
					R_xlen_t cnt1 = 0;
					for (R_xlen_t jj = j; jj < n1 && p1[k1[jj] - 1] == v0; jj++)
						cnt1 ++;
					// each right entry written at most once (cnt1) in out_i2
					total += cnt1;
					i += cnt0;
				} else {
					// no match: count consecutive duplicates on left side
					R_xlen_t cnt0 = 0;
					for (R_xlen_t ii = i; ii < n0 && p0[k0[ii] - 1] == v0; ii++)
						cnt0 ++;
					i += cnt0;
				}
			}
		}

		// Allocate output (named list: i0, i1, i2)
		rv_ans = PROTECT(Rf_allocVector(VECSXP, 3));
		SET_VECTOR_ELT(rv_ans, 0, ord0);
		SEXP out_i1 = PROTECT(Rf_allocVector(INTSXP, n0));
		SET_VECTOR_ELT(rv_ans, 1, out_i1);
		SEXP out_i2 = PROTECT(Rf_allocVector(INTSXP, total));
		SET_VECTOR_ELT(rv_ans, 2, out_i2);

		int *oi1 = INTEGER(out_i1);
		int *oi2 = need_i2 ? INTEGER(out_i2) : NULL;
		if (need_i2)
			for (R_xlen_t k=0; k < total; k++) oi2[k] = NA_INTEGER;
		R_xlen_t oi2_index = 0;

		// allele in the GDS file
		vector<string> allele_vec;
		vector<C_BOOL> allele_flag_vec;
		PdGDSObj node_allele = GDS_R_SEXP2Obj(node, TRUE);

		// Second pass: fill output using sort-merge with ref & alt (if provided)
		R_xlen_t i = 0, j = 0;
		while (i < n0)
		{
			int v0 = p0[k0[i] - 1];
			// advance j past values smaller than v0
			while ((j < n1) && (p1[k1[j] - 1] < v0)) j++;
			// find the run of equal values on the right side
			R_xlen_t j_start = j;
			R_xlen_t j_end = j;
			if (j < n1 && p1[k1[j] - 1] == v0)
			{
				while ((j_end < n1) && (p1[k1[j_end] - 1] == v0))
					j_end ++;
				if (use_allele && (j_start < j_end))
				{
					// read allele data from the GDS file
					R_xlen_t n_allele = j_end - j_start;
					if (n_allele > allele_vec.size()) allele_vec.resize(n_allele);
					// reset allele flag vector
					const int st = i1[k1[j_start] - 1];
					R_xlen_t n = i1[k1[j_end-1] - 1] - st + 1;
					if (n <= 0)
						throw ErrSeqArray("SEQ_FindMatchIndex: invalid variant index range.");
					if (n > allele_flag_vec.size()) allele_flag_vec.resize(n);
					memset(&allele_flag_vec[0], 0, sizeof(C_BOOL)*n);
					int last = -1;  // used for checking
					for (R_xlen_t jj = j_start; jj < j_end; jj++)
					{
						int ii = i1[k1[jj] - 1] - st;
						if (ii <= last)
							throw ErrSeqArray("SEQ_FindMatchIndex: allele index not increasing.");
						last = ii;
						allele_flag_vec[ii] = TRUE;
					}
					// read
					const C_Int32 start = st-1, length = n;
					const C_BOOL *sel = &allele_flag_vec[0];
					GDS_Array_ReadDataEx(node_allele, &start, &length, &sel,
						&allele_vec[0], svStrUTF8);
				}
			}
			// emit cross-product for all left entries with this position
			while ((i < n0) && (p0[k0[i] - 1] == v0))
			{
				if (j_start < j_end)
				{
					if (use_allele)
					{
						// check: (is.na(ref) | ref==r) & (is.na(alt) | alt==a)
						const int k0_i = k0[i] - 1;
						SEXP ref_s = STRING_ELT(ref0, k0_i);
						SEXP alt_s = STRING_ELT(alt0, k0_i);
						const bool ref_is_na = (ref_s == NA_STRING);
						const bool alt_is_na = (alt_s == NA_STRING);
						const char *ref = ref_is_na ? "" : CHAR(ref_s);
						const char *alt = alt_is_na ? "" : CHAR(alt_s);
						const int i1_k1_j_start = i1[k1[j_start] - 1];
						int found = NA_INTEGER;
						for (R_xlen_t jj = j_start; jj < j_end; jj++)
						{
							const string &al = allele_vec[jj - j_start];
							// parse "ref,alt" from GDS allele string
							size_t cp = al.find(',');
							bool ref_ok = ref_is_na ||
								(cp != string::npos ? (al.compare(0, cp, ref) == 0) : (al == ref));
							if (!ref_ok) continue;
							bool alt_ok = alt_is_na ||
								(cp != string::npos ? (strcmp(alt, al.c_str()+cp+1) == 0) : false);
							if (alt_ok)
							{
								const int i1_index = i1[k1[jj] - 1];
								if (found < 0) found = i1_index;
								if (need_i2 && allele_flag_vec[i1_index - i1_k1_j_start])
								{
									allele_flag_vec[i1_index - i1_k1_j_start] = 0;  // mark as used
									oi2[oi2_index++] = i1_index;
								}
							}
						}
						oi1[i] = found;
					} else {
						// no allele check: all entries match
						// use the first one as the representative
						const int i1_k1_j_start = i1[k1[j_start] - 1];
						oi1[i] = i1_k1_j_start;
						// fill out_i2 once for this position group
						if (need_i2)
						{
							for (R_xlen_t jj = j_start; jj < j_end; jj++)
								oi2[oi2_index++] = i1[k1[jj] - 1];
						}
						// set oi1 for remaining left entries at this position
						i++;
						while ((i < n0) && (p0[k0[i] - 1] == v0))
						{
							oi1[i] = i1_k1_j_start;
							i++;
						}
						break;
					}
				} else {
					// not found: output NA for right index
					oi1[i] = NA_INTEGER;
				}
				i++;
			}
		}

		UNPROTECT(3);

	COREARRAY_CATCH
}

} // extern "C"
