*! version 0.5.2 2014-08-21 | scott long | tweak
* version 0.5.1 2014-08-21 | scott long | e() r()
* version 0.5.0 2014-08-21 | scott long | refactor

capture program drop matmath
capture program drop _help

program _help

    di " matmath -newmat- =  sort(-oldmat-), row(index)|col(index)"
    di ""
    di " matmath -newmat- = -mat1- operator -mat2-"
    di " "
    di "     math  : + - * / ^"
    di "     %of   : -mat1- as percent of -mat2-{"
    di "     %dif  : change from -mat1- to -mat2- as % of -mat1-"
    di "     before: concatenate -mat1- before -mat20- using mat_*app)"
    di "     above : concatenate -mat1- above -mat20- using mat_*app)"
    di ""
    di " matmath -newmat- = operator(-oldmat-)"
    di " "
    di "     abs sqrt sq log exp inv log10 odds logit"
    di ""
    di " matmath -newmat- = diag(-oldmat-) : vector from diagonal"
    di " matmath -newmat- = keep(-oldmat-), rows(indices) | cols(indices)"
    di " matmath -newmat- = drop(-oldmat-), rows(indices) | cols(indices)"
    di " matmath -newmat- = insert(-oldmat-), row(index) col(index) value(#) name()"
    di " matmath -newmat- = sort(-oldmat-), row(index) col(index)"
    di " matmath -newmat- = fill(-oldmat-), value(#)"
    di " "
    di "     indices: #, p-rior, l-ast, n-ext"
    di ""
    di " options"
    di ""
    di "     list, transpose"
    di ""
    di " input matrices can be e(b), r(b), e(V), r(V), and r(table)"
    di ""

end

program matmath, sclass

    version 11.2

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

    local bi1ops "+ - / * ^"
    local bi2ops "%of %dif" // more complex
    local bi3ops "before above" // more complex
    local binaryops "`bi1ops' `bi2ops' `bi3ops'"
    local bookops "keep drop insert sort"
    local un1ops "sqrt log log10 exp abs"
    local un2ops "sq inv logit odds"
    local un3ops "diag fill"
    local unaryops "`un1ops' `un2ops'"

    local input "`*'"

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

//  get options


    * change e(b) etc into matrices
    tempname retmat1 retmat2
    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
    local retchk `""e(V)" "e(b)" "r(V)" "r(b)" "r(table)" "'
    foreach r in `retchk' `retchk' { // twice to allow for l and r
        local ipos = strpos("`input'","`r'")
        if `ipos'>1 {
            matrix `retmat`retmatn'' = `r'
            local input : subinstr local input "`r'" "`retmat`retmatn''"
            local ++retmatn
        }
    }
    * clean input to allow later parsing
    local input : subinstr local input "cols(" "col(", all // synonym
    * remove , so _decodeoptions can use syntax
    local tempinput : subinstr local input "," " ", all
    foreach t in = `binaryops' {
        local input = subinstr("`input'","`t'"," `t' ",.)
    }
    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

//  determine which type and operator

    foreach grp in bi1 bi2 bi3 {
        foreach t in ``grp'ops' {
            local ipos : list posof "`t'" in input
            if `ipos'>0 {
                local operator "`t'"
                local type `grp'
            }
        }
    }

    foreach grp in book un1 un2 un3 {
        foreach t in ``grp'ops' {
            local ipos : list posof "`t'(" in input
            if `ipos'>0 {
                local operator "`t'"
                local type `grp'
            }
        }
    }

//  matrices being used

    if "`type'"=="bi1" | "`type'"=="bi2" | "`type'"=="bi3" {
        _decodebinary `input' // use syntax to decode
        local matout   `s(matout)'
        local matleft  `s(matleft)'
        local matright `s(matright)'
        local eq "`s(eq)'"
        local operator `s(op)'
        local ipos : list posof "`operator'" in binaryops
        if `ipos'==0 {
            di as error "operator `operator' is invalid"
            exit
        }
    }



    if "`operator'"=="" {
        display as error ///
        "invalid command or operator specified"
        exit
    }

    if "`type'"=="un1" | "`type'"=="un2" | "`type'"=="un3" ///
        | "`type'"=="book"  {

        local matout : word 1 of `input'
        local eq : word 2 of `input'
        local matleft : word 4 of `input'
        local matright ""
        local isscalar = 0
    }

    if "`eq'"!="=" {
        di as error "missing = sign"
        exit
    }

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

    if "`operator'"=="diag" {
        if "`matleftrowsN'"!="`matleftcolsN'" {
            di as error ///
            "matrix `matleft' must be square for diag()"
            exit
        }
        matrix `mymat' = vecdiag(`matleft')
        local origmatleft "`matleft'"
        local matleft "`mymat'"
    }

    if "`type'"=="bi1" | "`type'"=="bi2" {

        * right must be scalar or matrix
        capture confirm matrix `matright'
        if _rc { // is not matrix
            capture scalar `tmp' = `matright'
            local matright "`mymat'" // put scalar in matrix `mymat'
            capture confirm scalar `tmp'
            if _rc!=0 { // not scalar
                di as error ///
                "the right element is not a matrix or a scalar"
                exit
            }
            else matrix `matright' = J(1,1,`tmp')
        }
        else { // two matrices are used
            local matrightrowsN = rowsof(`matright')
            local matrightcolsN = colsof(`matright')
            if "`operator'"!="before" & "`operator'"!="above" {
                if (`matleftrowsN'!=`matrightrowsN' ///
                    | `matleftcolsN'!=`matrightcolsN')  {
                    display as error ///
                    "dimensions of matrices are incompatabile"
                    exit
                }
            }
        } // not scalar for second element

    } // binary

//  decode options after the ,

    _decodeoptions, ///
        `tempinput' rowlast(`matleftrowsN') collast(`matleftcolsN') ///
        value(string)
    local value  "`s(value)'"
    local name     `"`s(name)'"'
    local list      "`s(list)'"
    local colis     "`s(columns)'"
    local rowis     "`s(rows)'"
    local format    "`s(format)'"
    local transpose "`s(transpose)'"

    if ("`operator'"=="diag" & "`name'"=="") local name "diag_`origmatleft'"

    if "`operator'"=="fill" & "`value'"=="" {
            di as error "fill() requires value()"
            exit
    }

//  decode insert

    if "`operator'"=="insert" {

        if "`rowis'"=="" & "`colis'"=="" {
            display as error ///
            "either row() or col() is required with insert"
            exit
        }

        if "`rowis'"!="" {
            local rowisN = wordcount("`rowis'")
            if `rowisN'>1 {
                display as error "only one row can be inserted"
                exit
            }
            local rowis : word 1 of `rowis' // only one row allowed
            if `rowis'<0 | `rowis'>(`matleftrowsN'+1) {
                display as error ///
                "row() value must be between 0 and `matleftrowsN'"
                exit
            }
        }

        if "`colis'"!="" {
            local colisN = wordcount("`colis'")
            local colis : word 1 of `colis' // only one col allowed
            if `colisN'>1 {
                display as error "only one column can be inserted"
                exit
            }
            else if `colis'<0 | `colis'>(`matleftcolsN'+1) {
                display as error ///
                "col() value must be between 0 and `matleftcolsN'"
                exit
            }
        }

    } // insert

//  decode sort

    if "`operator'"=="sort" {

        if "`rowis'"!="" & "`colis'"!="" {
            display as error "row() or col() cannot be used together"
            exit
        }
        else if "`rowis'"=="" & "`colis'"=="" {
            display as error "either row() or col() must be specified"
            exit
        }
        else if "`rowis'"!="" {
            local rcN = wordcount("`rowis'")
            if `rcN'>1 {
                display as error "only one row() value is allowed"
                exit
            }
            else {
                local rowis : word 1 of `rowis' // only one row allowed
                if `rowis'<1 | `rowis'>(`matleftrowsN'+1) {
                    display as error ///
                    "row() value must be between 1 and `matleftrowsN'"
                    exit
                }
            }
        }
        else if "`colis'"!="" {
            local rcN = wordcount("`colis'")
            if `rcN'>1 {
                display as error "only one col() value is allowed"
                exit
            }
            else {
                local colis : word 1 of `colis' // only one col allowed
                if `colis'<1 | `colis'>(`matleftcolsN'+1) {
                    display as error ///
                    "col() value must be between 1 and `matleftcolsN'"
                    exit
                }
            }
        }
    } // sort

//  execute the operations

    _matmath , matout(`matout') matleft(`matleft') matright(`matright') ///
        type(`type') op(`operator') ///
        `list' cols(`colis') rows(`rowis') format(`format') ///
        value(`value') name(`name') `transpose'

    _return restore `origreturns'
    local nrows = rowsof(`matout')
    local ncols = colsof(`matout')
    sreturn local nrows `nrows'
    sreturn local ncols `ncols'

end

program _decodeoptions, sclass
    syntax [ ,  ROWs(string) COLumns(string) list ///
        rowlast(string) collast(string) ///
        format(string) Value(string) name(string) ///
        transpose Width(integer 9) Decimals(integer 3) ///
        * ]

    if ("`value'"!="") local value = real("`value'")
    else local value = real(".") // default

    if "`rows'"!="" {
        local rows : subinstr local rows "l" "`rowlast'", all
        numlist "`rows'"
        local rows "`r(numlist)'"
    }
    if "`columns'"!="" {
        local columns : subinstr local columns "l" "`collast'", all
        numlist "`columns'"
        local columns "`r(numlist)'"
    }

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

    sreturn local name `name'
    sreturn local value `value'
    sreturn local rows `rows'
    sreturn local columns `columns'
    sreturn local list `list'
    sreturn local format `format'
    sreturn local transpose `transpose'

end

program _decodebinary, sclass
    args matout eq matleft op matright opt1 opt2 opt3 opt4
    sreturn local matout `matout'
    sreturn local eq "`eq'"
    sreturn local matleft `matleft'
    sreturn local op "`op'"
    sreturn local matright `matright'
end

exit
*! version 0.3.10 2014-08-18 | scott long | sort