*! version 0.5.3 2014-10-24 | scott long | meanabs & keep()
* version 0.5.2 x2014-10-24 | scott long | meanabs & keep()
* version 0.5.1 2014-10-24 | scott long | refactoring code

//  _matrcsyntax

*DO option to keep original name for column

capture program drop _matrcsyntax
capture program drop _decodeoptions

program _help
    syntax,  rc(string)

di ""
di " mat`rc' -matrix- `rc'# = L`rc'# operator R`rc'#"
di " "
di "    math : + - * / ^"
di "    %of  : L`rc' as percent of R`rc'"
di "    %dif : change from L`rc' to R`rc' as % of L`rc'"
di " "
di " mat`rc' -matrix- `rc'# = operator(`rc'#)"
di " "
di "    abs log exp inv log10 logit odds sq sqrt "
di " "
di " mat`rc' -matrix- `rc'# = statistic, `rc's(`row' indices to analyze)"
di " "
di "    max mean meanabs min sd sum var range"
di
di " mat`rc' -matrix- `rc'# = number : add `rc' with `rc' number "
di ""
di " mat`rc' -matrix- `rc'#, name(new `rc' name) : replace `rc' name"
di ""
di "    list, format(), width(), decimals(), name(`rc'-name)"
di "    l = last row; n = next; p = prior (before 1)"
di ""
end

program _decodeoptions, sclass
    syntax [ , Name(string) Rows(numlist) Columns(numlist) List ///
        Format(string) Width(integer 9) Decimals(integer 3) NOName ///
        keep(string) * ]
    * with keep, need string since numlist won't allow l

    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 keeplist `keep'
end

program _matrcsyntax

    version 11.2

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

    * operations on two RCs
    local bi1ops "+ - / * ^"
    local bi2ops "%of %dif" // more complex
    local binaryops "`bi1ops' `bi2ops'"

    * operations on a single RC
    local un1ops "sqrt log log10 exp abs"
    local un2ops "sq inv logit odds"
    local unaryops "`un1ops' `un2ops'"

    * operations on a set of RCs
    local statops "sum min max mean meanabs sd var range"

    * utility cration of new RC
    local utilops "num number"

//  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
    }

//  matrix and index for output

    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

//  indexout

    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'"=="p") local indexout = 0
    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 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)'"

    local iskeep = 0
    local keeplist "`s(keeplist)'"
    if "`keeplist'" != "" {
        local iskeep = 1
        local keeplist = subinstr("`keeplist'"," "," \ ",.)
    }

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

//  decode operators

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

        local iserror = 0

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

        * binary operators
        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 is 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 bi1ops
            if `ipos'>0 local type "bi1"
            local ipos : list posof "`operator'" in bi2ops
            if `ipos'>0 local type "bi2"

        }

        * stat or util operator
        else {
            local indexleft "" // get index later
            local operator "`1'"
            local ipos : list posof "`operator'" in statops
            if (`ipos'>0) local type "stat"
            local ipos : list posof "`operator'" in utilops
            if (`ipos'>0) local type "util"
        }

        * unary operator if none of above
        if "`type'"!="bi1" & "`type'"!="bi2" ///
                & "`type'"!="stat" & "`type'"!="util" {

            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 incorrect"
                exit
            }
            local ipos : list posof "`operator'" in un1ops
            if `ipos'>0 local type "un1"
            local ipos : list posof "`operator'" in un2ops
            if `ipos'>0 local type "un2"
        }

    } // 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 concatentate in matrix
    if `isselect' {
        local selectlist = subinstr("`selectlist'"," "," \ ",.)
    }


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

//  do computations

    _matrcmath, operator(`operator') type(`type') ///
        matsource(`matsource') indexout(`indexout') ismatcol(`ismatcol') ///
        indexleft(`indexleft') indexright(`indexright') ///
        isselect(`isselect') selectlist(`selectlist') ///
        name(`name') `list' format(`format') `noname' ///
        iskeep(`iskeep') keeplist(`keeplist')

    _return restore `origreturns'

end
exit

* version 0.4.3 2014-08-16 | scott long | dec width help
*  version 0.4.2 2014-08-08 | scott long | preserve returns, format
*  version 0.4.1 2014-08-08 | scott long | abs
*  version 0.4.0 2014-08-02 | scott long | select for all operations
*  version 0.3.0 2014-08-02 | scott long | tempname
*  version 0.2.1 2014-08-02 | scott long |
*  version 0.2.0 2014-08-01 | scott long |
* version 0.5.0 2014-08-21work | scott long | refactor