*! version 0.1.1 2015-04-20 names of options
*! version 0.1.0 2015-04-18
* thanks for help from Fang Wang fwang@stata.cm

//  select rows and columns of a matrix

capture program drop matsel
capture program drop _help

/*
* fang wang fwang@stata.cm
mata:
void mm_selstripe(string scalar m, string scalar rn, string scalar cn) {
	real matrix y
	string matrix rname, cname
	real matrix x, v1, v2

	x = st_matrix(m)
	v1 = st_matrix(rn)
	v2 = st_matrix(cn)

	// select rows and cols
	y = x[v1, v2]

	// select row names and eqn
	rname = st_matrixrowstripe(m)
	rname = rname[v1, .]

	// select col names and eqn
	cname = st_matrixcolstripe(m)
	cname = cname[v2, .]

	st_matrix(m, y)
	st_matrixrowstripe(m, rname)
	st_matrixcolstripe(m, cname)
}
end
*/

mata:
void mm_selstripe(string scalar matnm, string scalar rownm, string scalar colnm) {
	real matrix outmat
	string matrix rowstripes, colstripes
	real matrix inmat, inrows, incols

	inmat = st_matrix(matnm)
	inrows = st_matrix(rownm)
	incols = st_matrix(colnm)

	// select rows and cols
	outmat = inmat[inrows, incols]

	// select row names and eqn
	rowstripes = st_matrixrowstripe(matnm)
	rowstripes = rowstripes[inrows, .]

	// select col names and eqn
	colstripes = st_matrixcolstripe(matnm)
	colstripes = colstripes[incols, .]

	st_matrix(matnm, outmat)
	st_matrixrowstripe(matnm, rowstripes)
	st_matrixcolstripe(matnm, colstripes)
}
end


/*
matrix x = (1, 2, 3 \ 4, 5, 6 \ 7, 8, 9)
mat rownames x = row1 row2 row3
mat colnames x = col1 col2 col3
mat xtest = x
matrix r1 = (3, 1)
matrix c1 = (2, 1, 3, 1)
mata: mm_selstripe("xtest", "r1", "c1")
mat list xtest

mat xtest = x
matrix r1 = (.)
mata: mm_selstripe("xtest", "r1", "c1")
mat list xtest

mat xtest2 = x
local xis "xtest2"
local ris "r1"
local cis "c1"
matlist `xis'
matlist `ris'
matlist `cis'
mata: mm_selstripe(st_local("xis"), st_local("ris"), st_local("cis"))
mat list xtest2
*/

program _help

    di ""
    di " matsel matout [= matin] , "
    di "        [ rowkeep(numlist) | rowdrop(numlist) ]"
    di "        [ colkeep(numlist) | coldrop(numlist) ] "
    di "        [options]"
    di ""
    di " options:  list, transpose, format(), width(), decimals()"
    di " matrices: e() or r() matrices or existing matrices"
    di ""

end

program matsel, sclass

    version 11.2

    tempname origreturns
    _return hold `origreturns'
    _return restore `origreturns', hold

    local input "`*'"
    if "`input'"=="" {
        _help
        exit
    }

//  syntax

    local input : subinstr local input "(  " "(", all
    local input : subinstr local input "( " "(", all
    local input : subinstr local input "  )" ")", all
    local input : subinstr local input " )" ")", all
    local input : subinstr local input "," " , ", all
    local retmatn = 1
*di "input: `input'"
    * change e(b) etc into matrices
    tempname retmat
    local retchk `""e(V)" "e(b)" "r(V)" "r(b)" "r(table)" "'
    foreach r in `retchk' {
        local ipos = strpos("`input'","`r'")
        if `ipos'>1 {
            matrix `retmat' = `r'
            local input : subinstr local input "`r'" "`retmat'"
            local ++retmatn
        }
    }

    * remove "," so _decodeoptions can use syntax to decode
    local tempinput : subinstr local input "," " ", all
    local input : subinstr local input "  " " ", all
    local input : subinstr local input "(" "( ", all
    local input : subinstr local input ")" " )", all

//  matrices being used and error checking

    local matout : word 1 of `input'
    local eq : word 2 of `input'
    local matleft : word 3 of `input'
    local isscalar = 0
    if ("`eq'"!="=") local matleft `matout'

    capture confirm matrix `matleft'
    if _rc {
        di as error "matrix `matleft' does not exist"
        exit
    }
    local matleftrowsN = rowsof(`matleft')
    local matleftcolsN = colsof(`matleft')

    _decodeoptions, ///
        `tempinput' rowlast(`matleftrowsN') collast(`matleftcolsN')

    local list      "`s(list)'"
    local format    "`s(format)'"
    local transpose "`s(transpose)'"
    local rowdrop  "`s(rowdrop)'"
    local coldrop  "`s(coldrop)'"
    local rowkeep  "`s(rowkeep)'"
    local colkeep  "`s(colkeep)'"

    if "`rowdrop'"!="" & "`rowkeep'"!="" {
        di as error "rowdrop() and rowkeep() cannot be used together"
        exit
    }
    if "`coldrop'"!="" & "`colkeep'"!="" {
        di as error "dropcolumns() and keepcolumns() cannot be used together"
        exit
    }
/*
di "DOG"
 foreach i in rowdrop coldrop rowkeep colkeep {
     di "`i': ``i''"
 }
 */

//  convert drops to keeps

    numlist "1/`matleftrowsN'"
    local allrows "`r(numlist)'"
    numlist "1/`matleftcolsN'"
    local allcols "`r(numlist)'"
*set trace on
    * rows
    if "`rowdrop'"=="" &"`rowkeep'"=="" { // keep all rows
        local newrowkeep "`allrows'"
    }
    else if ("`rowdrop'"=="") & ("`rowkeep'"!="") {
        local newrowkeep "`rowkeep'"
    }
    else local newrowkeep : list allrows - rowdrop
    * cols
    if "`coldrop'"=="" &"`colkeep'"=="" { // keep all cols
        local newcolkeep "`allcols'"
    }
    else if ("`coldrop'"=="") & ("`colkeep'"!="") {
        local newcolkeep "`colkeep'"
    }
    else local newcolkeep : list allcols - coldrop

    * need to keep at least 1 row and 1 column
    if "`newrowkeep'"=="" {
        di as error "no rows were selected to be kept"
        exit
    }
    if "`newcolkeep'"=="" {
        di as error "no columns were selected to be kept"
        exit
    }
*set trace off
/*
di
di "cleaned"
foreach i in newrowkeep newcolkeep {
    di "`i': ``i''"
}
*/
//  turn row col list into matrices

    tempname matrows matcols
    local rowkeep : subinstr local newrowkeep " " ",", all
    local colkeep : subinstr local newcolkeep " " ",", all
    mat `matrows' = (`rowkeep')
    mat `matcols' = (`colkeep')

*`debug' matlist `matrows', title(matrows)
*`debug' matlist `matcols', title(matcols)
*`debug' matlist `matleft', title(matleft before selection)

//  make selection and close up

    matrix `matout' = `matleft'
    mata: mm_selstripe("`matout'", "`matrows'", "`matcols'")
*`debug' matlist `matout', title(after selection)

    if ("`transpose'"=="transpose") matrix `matout' = `matout''
    if ("`list'"=="list") ///
        matlist `matout', title(matrix `matout') format(`format')

    local nrows = rowsof(`matout')
    local ncols = colsof(`matout')
    sreturn local nrows `nrows'
    sreturn local ncols `ncols'
end

program _decodeoptions, sclass

    syntax [ , ///
        ROWKeep(string) COLKeep(string) ///
        ROWDrop(string) COLDrop(string) ///
        rowlast(string) collast(string) ///
        List ///
        Format(string) ///
        Transpose Width(integer 9) Decimals(integer 3) ///
        ROWDecimals(string) COLDecimals(string) FMTtype(string) ///
        * ]

    local rowlastm1 = `rowlast' - 1
    local collastm1 = `collast' - 1

    if "`rowkeep'"!="" {
        local rowkeep : subinstr local rowkeep "lm1" "`rowlastm1'", all
        local rowkeep : subinstr local rowkeep "l" "`rowlast'", all
        numlist "`rowkeep'"
        local rowkeep "`r(numlist)'"
    }
    if "`colkeep'"!="" {
        local colkeep : subinstr local colkeep "lm1" "`collastm1'", all
        local colkeep : subinstr local colkeep "l" "`collast'", all
        numlist "`colkeep'"
        local colkeep "`r(numlist)'"
    }
    if "`rowdrop'"!="" {
        local rowdrop : subinstr local rowdrop "lm1" "`rowlastm1'", all
        local rowdrop : subinstr local rowdrop "l" "`rowlast'", all
        numlist "`rowdrop'"
        local rowdrop "`r(numlist)'"
    }
    if "`coldrop'"!="" {
        local coldrop : subinstr local coldrop "lm1" "`collastm1'", all
        local coldrop : subinstr local coldrop "l" "`collast'", all
        numlist "`coldrop'"
        local coldrop "`r(numlist)'"
    }

    if ("`format'"=="") local format "%`width'.`decimals'f"

    sreturn local rowdrop `rowdrop'
    sreturn local rowkeep `rowkeep'
    sreturn local coldrop `coldrop'
    sreturn local colkeep `colkeep'
    sreturn local list `list'
    sreturn local format `format'
    sreturn local transpose `transpose'

end


exit