*! version 0.6.1 2016-01-07 | scott long | help

//  _matrcsyntax

* TODO option to keep original name for column
*      or some indication of how it was constructed.

capture program drop _matrcsyntax
capture program drop _decodeoptions

program _help
    syntax,  rc(string)
    if "`rc'"=="row" local cr "col"
    if "`rc'"=="col" local cr "row"

di
di "Matrices and indices"
di
di "    M is a matrix; i, j & k are `rc' indices that can be the same."
di "    Indices can be a #. l indicates last `rc'; lm1 is last - 1."
di "    Index n is the next `rc' = l+1; 0 is the `rc' before 1"
di
di "Binary operations"
di
di "    mat`rc' M i = j + k     mat`rc' M i = j - k     mat`rc' M i = j * k"
di "    mat`rc' M i = j / k     mat`rc' M i = j ^ k"
di "    mat`rc' M i = j %of k   mat`rc' M i = j %dif k"
di ""
di "Unary operations"
di "    mat`rc' M i = abs(j)    mat`rc' M i = exp(j)    mat`rc' M i = inv(j)"
di "    mat`rc' M i = log(j)    mat`rc' M i = log10(j)  mat`rc' M i = logit(j)"
di "    mat`rc' M i = odds(j)   mat`rc' M i = sq(j)     mat`rc' M i = sqrt(j)"
di ""
di "Statistics computed from `rc's:"
di
di "    mat`rc' M i = max    , `rc's(`rc' indices to analyze)"
di "    mat`rc' M i = mean   , `rc's(`rc' indices to analyze)"
di "    mat`rc' M i = meanabs, `rc's(`rc' indices to analyze)"
di "    mat`rc' M i = min    , `rc's(`rc' indices to analyze)"
di "    mat`rc' M i = range  , `rc's(`rc' indices to analyze)"
di "    mat`rc' M i = sd     , `rc's(`rc' indices to analyze)"
di "    mat`rc' M i = sum    , `rc's(`rc' indices to analyze)"
di "    mat`rc' M i = var    , `rc's(`rc' indices to analyze)"
di
di "Utilities"
di
di "    mat`rc' M i = number     // place `cr' number in `rc' i"
di "    mat`rc' M i, name(sting) // change `rc'name for `rc' i"
di " "
di "Options"
di " "
di "    rowdrop()|rowkeep() and coldrop()|colkeep():"
di "        select rows and columns; rows/columns can be reordered "
di "        and duplicated."
di
di "    rownumber, colnumber: add #_ to the row and column labels."
di
di "    transpose: saves the transposed matrix."
di
di "    list, format(), width(), decimals(): lists the matrix"

end

program _decodeoptions, sclass
    syntax [ , Name(string) Rows(numlist) Columns(numlist) List ///
        Format(string) Width(integer 9) Decimals(integer 3) NOName ///
        /// XXkeep(string) ///
        ROWKeep(string) COLKeep(string) ROWDrop(string) COLDrop(string) ///
        * ]

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

    }
/*
di "rowdrop: `rowdrop'"
di "coldrop: `coldrop'"
di "rowkeep: `rowkeep'"
di "colkeep: `colkeep'"
*/

    if ("`format'"=="") local format "%`width'.`decimals'f"
    sreturn local name `name'
    sreturn local noname `noname'
    sreturn local rowlist `rows'
    sreturn local collist `columns'
    sreturn local list `list'
    sreturn local format `format'
    sreturn local rowdrop `rowdrop'
    sreturn local coldrop `coldrop'
    sreturn local rowkeep `rowkeep'
    sreturn local colkeep `colkeep'

end

program _matrcsyntax

    version 11.2

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

    local OPbinmath "+ - / * ^"
    local OPbinpct "%of %dif" // more complex
    local binaryops "`OPbinmath' `OPbinpct'"

    local OPunisimple "sqrt log log10 exp abs"
    local OPunicomplex "sq inv logit odds"
    local unaryops "`OPunisimple' `OPunicomplex'"

    local OPstats "sum min max mean meanabs sd var range"

    local OPutil "num number" // synonyms

//  row or col

    local rc "`1'" // is it matrow or matcol?
    if ("`rc'"=="row") local ismatcol = 0
    else local ismatcol = 1
    macro shift 1

    if "`*'"=="" {
        _help, rc(`rc')
        exit
    }

//  source matrix

    local matsource "`1'"
    capture matrix list `matsource'
    if _rc==0 { // matrix exists
        local rowsN = rowsof(`matsource')
        local colsN = colsof(`matsource')
    }
    else {
        display as error "matrix `matsource' does not exist"
        exit
    }
    macro shift 1

//  index of row/col being changed

    local indexout "`1'"

    if "`indexout'"=="l" { // last
        if `ismatcol' local indexout = `colsN'
        else local indexout = `rowsN'
    }

    else if "`indexout'"=="n" { // next after last
        if `ismatcol' local indexout = `colsN' + 1
        else local indexout = `rowsN' + 1
    }

    else if "`indexout'"=="lm1" { // last - 1
        if `ismatcol' local indexout = `colsN' - 1
        else local indexout = `rowsN' - 1
    }

    else if ("`indexout'"=="p") local indexout = 0 // 0 can be used instead of p

    else {
        capture confirm integer number `indexout'
        if (_rc==0) local indexout = `1'
        else {
            display as error "index number `indexout' is invalid"
            exit
        }
    }
    macro shift 1

//  decode options

    local input "`*'"
    local newinput : subinstr local input "," " ", all
    _decodeoptions , `newinput'
    local rowdrop "`s(rowdrop)'"
    local coldrop "`s(coldrop)'"
    local rowkeep "`s(rowkeep)'"
    local colkeep "`s(colkeep)'"
    local format  "`s(format)'"
    local name   `"`s(name)'"'
    local noname  "`s(noname)'"
    local iscollist = 0
    local collist "`s(collist)'"
    if ("`collist'"!="") local iscollist = 1
    local isrowlist = 0
    local rowlist "`s(rowlist)'"
    if ("`rowlist'"!="") local isrowlist = 1
    local list    "`s(list)'"

    * = sign required for all but name operation
    local OPtype ""
    if "`1'"!="=" {
        if "`name'"=="" {
            display as error "equal sign is missing"
            exit
        }
        else local OPtype "name" // rename row, nothing else
    }
    macro shift 1 // get rid of =

//  decode operators

    if "`OPtype'"!="name" {

        local iserror = 0

        local indexleft "`1'" // see if index # is given
        capture confirm integer number `indexleft'

        if _rc==0 { // if # is first, must be binary

            local isbinary = 1
            local indexright "`3'"
            confirm integer number `indexright'
            if _rc {
                di as err "index number required after the operator"
                exit
            }

            local operator "`2'"
            local ipos : list posof "`operator'" in binaryops
            if `ipos'==0 {
                display as error "invalid operator `operator'"
                exit
            }
            local ipos : list posof "`operator'" in OPbinmath
            if (`ipos'>0) local OPtype "OPbinmath"
            local ipos : list posof "`operator'" in OPbinpct
            if (`ipos'>0) local OPtype "OPbinpct"

        }


        else { // stat or util operator
            local indexleft "" // get index later
            local operator "`1'"
            local ipos : list posof "`operator'" in OPstats
            if (`ipos'>0) local OPtype "OPstats"
            local ipos : list posof "`operator'" in OPutil
            if (`ipos'>0) local OPtype "OPutil"
        }

        //  unary operator if none of type above

        if "`OPtype'"!="OPbinmath" & "`OPtype'"!="OPbinpct" ///
         & "`OPtype'"!="OPstats"   & "`OPtype'"!="OPutil" {

            local input "`*'"
            local input : subinstr local input "(" " ", all
            local input : subinstr local input ")" " ", all
            local operator : word 1 of `input'
            local indexleft : word 2 of `input'
            local ipos : list posof "`operator'" in unaryops
            if `ipos'==0 {
                display as error "invalid operator `operator'"
                exit
            }
            else local isunary = 1
            capture confirm integer number `indexleft'
            if _rc {
                di as err "index number is incorrect"
                exit
            }
            local ipos : list posof "`operator'" in OPunisimple
            if (`ipos'>0) local OPtype "OPunisimple"
            local ipos : list posof "`operator'" in OPunicomplex
            if (`ipos'>0) local OPtype "OPunicomplex"
        }

    } // not nameonly

//  create selection vector use for statistics operators

    if `ismatcol' {
        local selectlist "`collist'"
        local isselect = `iscollist'
    }
    else {
        local selectlist "`rowlist'"
        local isselect = `isrowlist'
    }
    * add \ to change list into a matrix
    if `isselect' {
        local selectlist = subinstr("`selectlist'"," "," \ ",.)
    }

if "$debug"=="1" {
    di "matsource   `matsource'   indexout  `indexout'"
    di "  ismatrow  `ismatrow'    ismatcol  `ismatcol'"
    di
    di "OPtype: `OPtype'    operator: `operator'  name: `name'"
    di
    di "indexleft   `indexleft' indexright  `indexright'"
    di
    di "isselect    `isselect'  selectlist: `selectlist'"
}

//  do computations

    _matrcmath, operator(`operator') optype(`OPtype') ///
        matsource(`matsource') indexout(`indexout') ismatcol(`ismatcol') ///
        indexleft(`indexleft') indexright(`indexright') ///
        isselect(`isselect') selectlist(`selectlist') ///
        name(`name') `list' format(`format') `noname' ///
        rowdrop(`rowdrop') coldrop(`coldrop') ///
        rowkeep(`rowkeep') colkeep(`colkeep')

    _return restore `origreturns'

end
exit