楼主: tulipsliu
1317 0

[学科前沿] 怎么开发R语言的 S4 class package [推广有奖]

促进中国计量经济学发展学科带头人

学科带头人

43%

还不是VIP/贵宾

-

0%
威望
0 级
论坛币
386080 个
通用积分
470.0502
学术水平
127 点
热心指数
140 点
信用等级
103 点
经验
46957 点
帖子
1769
精华
0
在线时间
2481 小时
注册时间
2007-11-5
最后登录
2024-4-26

初级热心勋章

楼主
tulipsliu 在职认证  发表于 2020-5-30 10:51:48 |只看作者 |坛友微信交流群|倒序 |AI写论文

+2 论坛币
k人 参与回答

经管之家送您一份

应届毕业生专属福利!

求职就业群
赵安豆老师微信：zhaoandou666

经管之家联合CDA

送您一个全额奖学金名额~ !

立即领取

感谢您参与论坛问题回答

经管之家送您两个论坛币！

+2 论坛币

R 工具包开发准备文件

经管之家：Do the best economic and management education！
中国青年学者基地：949614744
Author: Daniel tulips liu

rugarch package c++ file

/*################################################################################
##
##   R package rugarch by Alexios Ghalanos Copyright (C) 2008-2015.
##   This file is part of the R package rugarch.
##
##   The R package rugarch is free software: you can redistribute it and/or modify
##   it under the terms of the GNU General Public License as published by
##   the Free Software Foundation, either version 3 of the License, or
##   (at your option) any later version.
##
##   The R package rugarch 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.
##
#################################################################################*/

#include "garchsim.h"
using namespace Rcpp;

SEXP marmaxsim(SEXP model, SEXP pars, SEXP idx, SEXP mu, SEXP x, SEXP res, SEXP N)
{
	try {
			Rcpp::NumericMatrix xx(x);
			Rcpp::NumericMatrix xres(res);
			Rcpp::NumericMatrix xmu(mu);
			int *xidx = INTEGER(idx);
			int *xmodel = INTEGER(model);
			double *xpars = REAL(pars);
			int *xN = INTEGER(N);
			int m = (int) xN[0];
			int n = (int) xN[1];
			int T = n + m;
			int nr = xx.nrow(), nc = xx.ncol(), i, j;
			arma::mat Qx(xx.begin(), nr, nc, true);
			arma::mat Qres(xres.begin(), nr, nc, true);
			arma::mat Qmu(xmu.begin(), nr, nc, true);

			for(i=m; i<T; i++)
			{
				Qx.row(i) = Qmu.row(i);
				for( j=0; j<xmodel[1]; j++ )
				{
					Qx.row(i) = Qx.row(i) + xpars[xidx[1]+j] * (Qx.row(i-(j+1)) - Qmu.row(i - (j+1)));
				}
				for( j=0; j<xmodel[2]; j++ )
				{
					Qx.row(i) = Qx.row(i) + xpars[xidx[2]+j] * Qres.row(i-(j+1));
				}
				Qx.row(i) = Qx.row(i) + Qres.row(i);
			}
			return Rcpp::List::create(Rcpp::Named("x") = Qx);
		} catch( std::exception &ex ) {
			forward_exception_to_r( ex );
	    } catch(...) {
			::Rf_error( "rugarch-->ugarchsim c++ exception (unknown reason)" );
	    }
	    return R_NilValue;
}

SEXP msgarchsim(SEXP model, SEXP pars, SEXP idx, SEXP h, SEXP z, SEXP res,
		SEXP e, SEXP vxs, SEXP N)
{
	try {
		Rcpp::NumericMatrix xh(h);
		Rcpp::NumericMatrix xz(z);
		Rcpp::NumericMatrix xres(res);
		Rcpp::NumericMatrix xe(e);
		Rcpp::NumericMatrix xvxs(vxs);

		int *xidx = INTEGER(idx);
		double *xpars = REAL(pars);
		int *xmodel = INTEGER(model);
		int *xN = INTEGER(N);
		int m = (int) xN[0];
		int nr = xh.nrow(), nc = xh.ncol(), i, j;

		arma::mat Qh(xh.begin(), nr, nc, false);
		arma::mat Qz(xz.begin(), nr, nc, false);
		arma::mat Qres(xres.begin(), nr, nc, false);
		arma::mat Qe(xe.begin(), nr, nc, false);
		arma::mat Qvxs(xvxs.begin(), nr, nc, false);

		for( i=m; i<nr; i++ )
		{
			Qh.row(i) = Qh.row(i) + xpars[xidx[6]];
			Qh.row(i) = Qh.row(i) + Qvxs.row(i);
			for( j=0; j<xmodel[7]; j++ )
			{
				Qh.row(i) = Qh.row(i) + xpars[xidx[7]+j]*Qe.row(i-(j+1));
			}
			for( j=0; j<xmodel[8]; j++ )
			{
				Qh.row(i) = Qh.row(i) + xpars[xidx[8]+j]*Qh.row(i-(j+1));
			}
			Qres.row(i) = arma::pow( Qh.row(i), 0.5 ) % Qz.row(i);
			Qe.row(i) = Qres.row(i) % Qres.row(i);
		}
		return Rcpp::List::create(Rcpp::Named("h") = Qh, Rcpp::Named("res") = Qres);
	} catch( std::exception &ex ) {
		forward_exception_to_r( ex );
    } catch(...) {
		::Rf_error( "rugarch-->ugarchsim c++ exception (unknown reason)" );
    }
    return R_NilValue;
}


SEXP mgjrgarchsim(SEXP model, SEXP pars, SEXP idx, SEXP h, SEXP z, SEXP res, SEXP e,
		SEXP nres, SEXP nindx, SEXP vxs, SEXP N)
{
	try {
		Rcpp::NumericMatrix xh(h);
		Rcpp::NumericMatrix xz(z);
		Rcpp::NumericMatrix xres(res);
		Rcpp::NumericMatrix xe(e);
		Rcpp::NumericMatrix xnres(nres);
		Rcpp::NumericMatrix xneg(nindx);
		Rcpp::NumericMatrix xvxs(vxs);

		int *xidx = INTEGER(idx);
		double *xpars = REAL(pars);
		int *xmodel = INTEGER(model);
		int *xN = INTEGER(N);
		int m = (int) xN[0];
		int nr = xh.nrow(), nc = xh.ncol(), i, j;

		arma::mat Qh(xh.begin(), nr, nc, false);
		arma::mat Qz(xz.begin(), nr, nc, false);
		arma::mat Qres(xres.begin(), nr, nc, false);
		arma::mat Qe(xe.begin(), nr, nc, false);
		arma::mat Qnres(xnres.begin(), nr, nc, false);
		arma::mat Qvxs(xvxs.begin(), nr, nc, false);
		arma::mat Qneg(xneg.begin(), nr, nc, false);

		for( i=m; i<nr; i++ )
		{
			Qh.row(i) = Qh.row(i) + xpars[xidx[6]];
			Qh.row(i) = Qh.row(i) + Qvxs.row(i);
			for( j=0; j<xmodel[7]; j++ )
			{
				Qh.row(i) = Qh.row(i) + xpars[xidx[7]+j]*Qe.row(i-(j+1)) + xpars[xidx[9]+j]*Qnres.row(i-(j+1));
			}
			for( j=0; j<xmodel[8]; j++ )
			{
				Qh.row(i) = Qh.row(i) + xpars[xidx[8]+j]*Qh.row(i-(j+1));
			}
			Qres.row(i) = arma::pow( Qh.row(i), 0.5 ) % Qz.row(i);
			Qe.row(i) = Qres.row(i) % Qres.row(i);
			Qnres.row(i) = Qneg.row(i) % Qe.row(i);
		}
		return Rcpp::List::create(Rcpp::Named("h") = Qh, Rcpp::Named("res") = Qres);
	} catch( std::exception &ex ) {
		forward_exception_to_r( ex );
    } catch(...) {
		::Rf_error( "rugarch-->ugarchsim c++ exception (unknown reason)" );
    }
    return R_NilValue;
}

SEXP maparchsim(SEXP model, SEXP pars, SEXP idx, SEXP h, SEXP z, SEXP res, SEXP vxs, SEXP N)
{
	try {
		Rcpp::NumericMatrix xh(h);
		Rcpp::NumericMatrix xz(z);
		Rcpp::NumericMatrix xres(res);
		Rcpp::NumericMatrix xvxs(vxs);

		int *xidx = INTEGER(idx);
		double *xpars = REAL(pars);
		int *xmodel = INTEGER(model);
		int *xN = INTEGER(N);
		int m = (int) xN[0];
		int nr = xh.nrow(), nc = xh.ncol(), i, j;

		arma::mat Qh(xh.begin(), nr, nc, false);
		arma::mat Qz(xz.begin(), nr, nc, false);
		arma::mat Qres(xres.begin(), nr, nc, false);
		arma::mat Qvxs(xvxs.begin(), nr, nc, false);

		for( i=m; i<nr; i++ )
		{
			Qh.row(i) = Qh.row(i) + xpars[xidx[6]];
			Qh.row(i) = Qh.row(i) + Qvxs.row(i);
			for( j=0; j<xmodel[7]; j++ )
			{
				Qh.row(i) = Qh.row(i) + xpars[xidx[7]+j]*arma::pow(arma::abs(Qres.row(i-(j+1))) - xpars[xidx[9]+j]*Qres.row(i-(j+1)), xpars[xidx[12]]);
			}
			for( j=0; j<xmodel[8]; j++ )
			{
				Qh.row(i) = Qh.row(i) + xpars[xidx[8]+j]*arma::pow(Qh.row(i-(j+1)), xpars[xidx[12]]);
			}
			Qh.row(i) = arma::pow(Qh.row(i), 1/xpars[xidx[12]]);
			Qres.row(i) = Qh.row(i) % Qz.row(i);
		}
		return Rcpp::List::create(Rcpp::Named("h") = Qh, Rcpp::Named("res") = Qres);
	} catch( std::exception &ex ) {
		forward_exception_to_r( ex );
    } catch(...) {
		::Rf_error( "rugarch-->ugarchsim c++ exception (unknown reason)" );
    }
    return R_NilValue;
}

SEXP mfgarchsim(SEXP model, SEXP pars, SEXP idx, SEXP kdelta, SEXP h, SEXP z,
		SEXP res, SEXP vxs, SEXP N)
{
	try {
		Rcpp::NumericMatrix xh(h);
		Rcpp::NumericMatrix xz(z);
		Rcpp::NumericMatrix xres(res);
		Rcpp::NumericMatrix xvxs(vxs);

		int *xidx = INTEGER(idx);
		double *xpars = REAL(pars);
		int *xmodel = INTEGER(model);
		int *xN = INTEGER(N);
		int m = (int) xN[0];
		int nr = xh.nrow(), nc = xh.ncol(), i, j;

		arma::mat Qh(xh.begin(), nr, nc, false);
		arma::mat Qz(xz.begin(), nr, nc, false);
		arma::mat Qres(xres.begin(), nr, nc, false);
		arma::mat Qvxs(xvxs.begin(), nr, nc, false);

		double *qkdelta  = REAL(kdelta);
		double cnst = 0.001 * 0.001;

		for( i=m; i<nr; i++ )
		{
			Qh.row(i) = Qh.row(i) + xpars[xidx[6]];
			Qh.row(i) = Qh.row(i) + Qvxs.row(i);
			for( j=0; j<xmodel[7]; j++ )
			{
				Qh.row(i) = Qh.row(i) + xpars[xidx[7]+j] * ( arma::pow(arma::pow(cnst + arma::pow( Qz.row(i-(j+1)) - xpars[xidx[11]+j],2), 0.5) - xpars[xidx[10]+j] *(Qz.row(i-(j+1)) - xpars[xidx[11]+j]), qkdelta[0] ) % arma::pow( Qh.row(i-(j+1)), xpars[xidx[13]]) );
			}
			for( j=0; j<xmodel[8]; j++ )
			{
				Qh.row(i) = Qh.row(i) + xpars[xidx[8]+j]*arma::pow(Qh.row(i-(j+1)), xpars[xidx[13]]);
			}
			Qh.row(i) = arma::pow(Qh.row(i), 1/xpars[xidx[13]]);
			Qres.row(i) = Qh.row(i) % Qz.row(i);
		}
		return Rcpp::List::create(Rcpp::Named("h") = Qh, Rcpp::Named("res") = Qres);
	} catch( std::exception &ex ) {
		forward_exception_to_r( ex );
    } catch(...) {
		::Rf_error( "rugarch-->ugarchsim c++ exception (unknown reason)" );
    }
    return R_NilValue;
}

SEXP megarchsim(SEXP model, SEXP pars, SEXP idx, SEXP meanz, SEXP h, SEXP z,
		SEXP res, SEXP vxs, SEXP N)
{
	try {
		Rcpp::NumericMatrix xh(h);
		Rcpp::NumericMatrix xz(z);
		Rcpp::NumericMatrix xres(res);
		Rcpp::NumericMatrix xvxs(vxs);

		int *xidx = INTEGER(idx);
		double *xpars = REAL(pars);
		int *xmodel = INTEGER(model);
		int *xN = INTEGER(N);
		int m = (int) xN[0];
		int nr = xh.nrow(), nc = xh.ncol(), i, j;

		arma::mat Qh(xh.begin(), nr, nc, false);
		arma::mat Qz(xz.begin(), nr, nc, false);
		arma::mat Qres(xres.begin(), nr, nc, false);
		arma::mat Qvxs(xvxs.begin(), nr, nc, false);
		double *qmeanz = REAL(meanz);

		for( i=m; i<nr; i++ )
		{
			Qh.row(i) = Qh.row(i) + xpars[xidx[6]];
			Qh.row(i) = Qh.row(i) + Qvxs.row(i);
			for( j=0; j<xmodel[7]; j++ )
			{
				Qh.row(i) = Qh.row(i) + xpars[xidx[7]+j]*Qz.row(i-(j+1)) + xpars[xidx[9]+j]*(arma::abs(Qz.row(i-(j+1))) - qmeanz[0]);
			}
			for( j=0; j<xmodel[8]; j++ )
			{
				Qh.row(i) = Qh.row(i) + xpars[xidx[8]+j]*arma::log(Qh.row(i-(j+1)));
			}
			Qh.row(i) = arma::exp( Qh.row(i) );
			Qres.row(i) = arma::pow( Qh.row(i), 0.5 ) % Qz.row(i);
		}
		return Rcpp::List::create(Rcpp::Named("h") = Qh, Rcpp::Named("res") = Qres);
	} catch( std::exception &ex ) {
		forward_exception_to_r( ex );
    } catch(...) {
		::Rf_error( "rugarch-->ugarchsim c++ exception (unknown reason)" );
    }
    return R_NilValue;
}

SEXP mcsgarchsim(SEXP model, SEXP pars, SEXP idx, SEXP h, SEXP q, SEXP z, SEXP res,
		SEXP e, SEXP vxs, SEXP N)
{
	try {
		Rcpp::NumericMatrix xh(h);
		Rcpp::NumericMatrix xq(q);
		Rcpp::NumericMatrix xz(z);
		Rcpp::NumericMatrix xres(res);
		Rcpp::NumericMatrix xe(e);
		Rcpp::NumericMatrix xvxs(vxs);

		int *xidx = INTEGER(idx);
		double *xpars = REAL(pars);
		int *xmodel = INTEGER(model);
		int *xN = INTEGER(N);
		int m = (int) xN[0];
		int nr = xh.nrow(), nc = xh.ncol(), i, j;

		arma::mat Qh(xh.begin(), nr, nc, false);
		arma::mat Qq(xq.begin(), nr, nc, false);
		arma::mat Qz(xz.begin(), nr, nc, false);
		arma::mat Qres(xres.begin(), nr, nc, false);
		arma::mat Qe(xe.begin(), nr, nc, false);
		arma::mat Qvxs(xvxs.begin(), nr, nc, false);

		for( i=m; i<nr; i++ )
		{
			Qq.row(i) = xpars[xidx[6]] + Qvxs.row(i) + xpars[xidx[10]]*Qq.row(i-1) + xpars[xidx[11]]*(Qe.row(i-1) - Qh.row(i-1));
			Qh.row(i) = Qh.row(i) + Qq.row(i);
			for( j=0; j<xmodel[7]; j++ )
			{
				Qh.row(i) = Qh.row(i) + xpars[xidx[7]+j]*(Qe.row(i-(j+1)) - Qq.row(i-(j+1)));
			}
			for( j=0; j<xmodel[8]; j++ )
			{
				Qh.row(i) = Qh.row(i) + xpars[xidx[8]+j]*(Qh.row(i-(j+1)) - Qq.row(i-(j+1)));
			}
			Qres.row(i) = arma::pow( Qh.row(i), 0.5 ) % Qz.row(i);
			Qe.row(i) = Qres.row(i) % Qres.row(i);
		}
		return Rcpp::List::create(Rcpp::Named("h") = Qh, Rcpp::Named("res") = Qres, Rcpp::Named("q") = Qq);
	} catch( std::exception &ex ) {
		forward_exception_to_r( ex );
    } catch(...) {
		::Rf_error( "rugarch-->ugarchsim c++ exception (unknown reason)" );
    }
    return R_NilValue;
}

SEXP colMaxRcpp(SEXP X_){
	Rcpp::NumericMatrix X(X_);
	int n = X.ncol();
	Rcpp::NumericVector V(n);
	for (int i=0; i<n; i++) {
	Rcpp::NumericVector W = X.column(i);
	V[i] = *std::max_element(W.begin(), W.end());
	}
	return(V);
}

S4 class file

#################################################################################
##
##   R package rugarch by Alexios Ghalanos Copyright (C) 2008-2015.
##   This file is part of the R package rugarch.
##
##   The R package rugarch is free software: you can redistribute it and/or modify
##   it under the terms of the GNU General Public License as published by
##   the Free Software Foundation, either version 3 of the License, or
##   (at your option) any later version.
##
##   The R package rugarch 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.
##
#################################################################################


setClass("ARFIMA", contains = c("rGARCH", "VIRTUAL"))

# ARFIMA Model
setClass("ARFIMAspec",
		representation(model = "vector"),
		contains = "ARFIMA")

setClass("ARFIMAfilter",
		representation(filter = "vector",
				model = "vector"),
		contains = "ARFIMA")


setClass("ARFIMAfit",
		representation(fit = "vector",
				model = "vector"),
		contains = "ARFIMA")

setClass("ARFIMAsim",
		representation(simulation = "vector",
				model = "vector",
				seed = "integer"),
		contains = "ARFIMA")

setClass("ARFIMAforecast",
		representation(forecast = "vector",
				model = "vector"),
		contains = "ARFIMA")

setClass("ARFIMApath",
		representation(path = "vector",
				model = "vector",
				seed = "integer"),
		contains = "ARFIMA")

setClass("ARFIMAroll",
		representation(model = "vector",
				forecast = "vector"),
		contains = "ARFIMA")


setClass("ARFIMAdistribution",
		representation(dist = "vector",
				truecoef = "matrix",
				model = "vector"),
		contains =  "ARFIMA")

# Have not yet implemented the ARFIMA bootstrap and not likely to in near future
setClass("ARFIMAboot",
		representation(
				fseries = "matrix",
				bcoef = "data.fr ame",
				model = "vector",
				forc = "ARFIMAforecast"),
		contains =  "ARFIMA")
#----------------------------------------------------------------------------------
# multiple spec/fit/filter/forecast ARFIMA methods
#----------------------------------------------------------------------------------

# Multiple Spec List Class
setClass("ARFIMAmultispec", 
		representation(spec = "vector",
				type = "character"),
		contains = "ARFIMA")

.validarfimaspeclist = function(ob ject){
	all(unlist(lapply(ob ject@spec, FUN = function(x) is(x, "ARFIMAspec"))))
}

setValidity(Class = "ARFIMAmultispec", method = .validarfimaspeclist)

# Multiple Fit ACD List Class
setClass("ARFIMAmultifit", 
		representation(fit = "vector",
				desc = "vector"),
		contains = "ARFIMA")

.validarfimafitlist = function(ob ject){
	all(unlist(lapply(ob ject@fit, FUN = function(x) is(x, "ARFIMAfit"))))
}

setValidity("ARFIMAmultifit", .validarfimafitlist)

# Multiple Fit ACD List Class
setClass("ARFIMAmultifilter", 
		representation(filter = "vector",
				desc = "vector"),
		contains = "ARFIMA")

.validarfimafilterlist = function(ob ject){
	all(unlist(lapply(ob ject@filter, FUN = function(x) is(x, "ARFIMAfilter"))))
}

setValidity("ARFIMAmultifilter", .validarfimafilterlist)


# Multiple Forecast ACD List Class
setClass("ARFIMAmultiforecast", 
		representation(forecast = "vector",
				desc = "vector"),
		contains = "ARFIMA")

.validarfimaforecastlist = function(ob ject){
	all(unlist(lapply(ob ject@forecast, FUN = function(x) is(x, "ARFIMAforecast"))))
}

setValidity("ARFIMAmultiforecast", .validarfimaforecastlist)

-method

#################################################################################
##
##   R package rugarch by Alexios Ghalanos Copyright (C) 2008-2015.
##   This file is part of the R package rugarch.
##
##   The R package rugarch is free software: you can redistribute it and/or modify
##   it under the terms of the GNU General Public License as published by
##   the Free Software Foundation, either version 3 of the License, or
##   (at your option) any later version.
##
##   The R package rugarch 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.
##
#################################################################################


#----------------------------------------------------------------------------------
# univariate spec method
#----------------------------------------------------------------------------------
arfimaspec = function( mean.model = list(armaOrder = c(1,1), include.mean = TRUE, arfima = FALSE, 
				external.regressors = NULL), 
		distribution.model = "norm", start.pars = list(), fixed.pars = list(), ...)
{
	UseMethod("arfimaspec")
}


.xarfimaspec = function( mean.model = list(armaOrder = c(1,1), include.mean = TRUE, arfima = FALSE, 
				external.regressors = NULL), 
		distribution.model = "norm", start.pars = list(), fixed.pars = list(), ...)
{
	mmodel = mean.model
	dmodel = distribution.model
	# make the temporary subsitution so that it will be accepted by ugarchspec
	if(!is.null(fixed.pars$sigma)){
		fixed.pars$omega = fixed.pars$sigma
		fixed.pars$sigma = NULL
	}
	if(!is.null(start.pars$sigma)){
		start.pars$omega = start.pars$sigma
		start.pars$sigma = NULL
	}
	mm = match(names(mean.model), c("armaOrder", "include.mean", "arfima", "external.regressors"))
	if(any(is.na(mm))){
		idx = which(is.na(mm))
		enx = NULL
		for(i in 1:length(idx)) enx = c(enx, names(mean.model)[idx[i]])
		warning(paste(c("unidentified option(s) in mean.model:\n", enx), sep="", collapse=" "), call. = FALSE, domain = NULL)
	}
	ans = ugarchspec(mean.model = list(armaOrder = mmodel$armaOrder, include.mean = mmodel$include.mean,
					arfima = mmodel$arfima, external.regressors = mmodel$external.regressors, archm = FALSE,
	archpow = 1), variance.model = list(garchOrder = c(0,0), model = "sGARCH"), distribution.model = dmodel,
	start.pars = start.pars, fixed.pars = fixed.pars)

	if(!is.null(ans@model$fixed.pars$omega)){
		ans@model$fixed.pars$sigma = ans@model$fixed.pars$omega
		ans@model$fixed.pars$omega = NULL
	}
	if(!is.null(ans@model$start.pars$omega)){
		ans@model$start.pars$sigma = ans@model$start.pars$omega
		ans@model$start.pars$omega = NULL
	}
	model = ans@model
	# change the omega name to sigma
	names(model$modelinc)[7] = "sigma"
	model$modeldesc$vmodel = "constant"
    idx = which(rownames(model$pars) == "omega")
	rownames(model$pars)[idx] = "sigma"
	rownames(model$pos.matrix)[7] = "sigma"
	rownames(model$pidx)[7] = "sigma"
	sol = new("ARFIMAspec", model = model)
	return(sol)
}

setMethod(f = "arfimaspec", definition = .xarfimaspec)

##############################################################################
# custom arfima for non consecutive arma orders
.zarfimaspec = function( arOrder = c(1,1), maOrder = c(1,1), include.mean = TRUE, 
		arfima = FALSE, external.regressors = NULL, distribution.model = "norm", 
		start.pars = list(), fixed.pars = list(), ...){
	
	fx = list()
	if(sum(arOrder)>0){
		arm = max(which(arOrder==1))
		arOrder = arOrder[1:arm]
	} else{
		arm = 0
	}
	if(sum(maOrder)>0){
		mam = max(which(maOrder==1)) 
		maOrder = maOrder[1:mam]
	} else{
		mam = 0
	}
	if(any(arOrder==0)){
		idx = which(arOrder==0)
		for(i in 1:length(idx)){
			eval(parse(text=paste("fx$ar", idx[i],"=0",sep="")))
		}
	}
	if(any(maOrder==0)){
		idx = which(maOrder==0)
		for(i in 1:length(idx)){
			eval(parse(text=paste("fx$ma", idx[i],"=0",sep="")))
		}
	}
	fx = c(fx, fixed.pars)
	spec = arfimaspec(mean.model = list(armaOrder = c(arm, mam),
					include.mean = include.mean, arfima = arfima, 
					external.regressors = external.regressors), 
					distribution.model = distribution.model, 
					start.pars = start.pars, fixed.pars = fx)
	return(spec)
}

.getarfimaspec = function(ob ject)
{
	spec = arfimaspec(mean.model = list(armaOrder = c(ob ject@model$modelinc[2], ob ject@model$modelinc[3]),
					include.mean = ob ject@model$modelinc[1], 
					arfima = ob ject@model$modelinc[4], external.regressors = ob ject@model$modeldata$mexdata), 
			distribution.model = ob ject@model$modeldesc$distribution, start.pars  = ob ject@model$start.pars, 
			fixed.pars = ob ject@model$fixed.pars)
	return(spec)
}
setMethod(f = "getspec", signature(ob ject = "ARFIMAfit"), definition = .getarfimaspec)

.setfixedarfima = function(ob ject, value){
	# get parameter values
	model = ob ject@model
	ipars = model$pars
	pars = unlist(value)
	names(pars) = parnames = tolower(names(pars))
	# included parameters in model
	modelnames = rownames(ipars[which(ipars[,4]==1 | ipars[,2]==1), ])
	inc = NULL
	for(i in seq_along(parnames)){
		if(is.na(match(parnames[i], modelnames))){
			warning( (paste("Unrecognized Parameter in Fixed Values: ", parnames[i], "...Ignored", sep = "")))
		} else{
			inc = c(inc, i)
		}
	}
	fixed.pars = pars[inc]
	names(fixed.pars) = tolower(names(pars[inc]))
	# set parameter values
	tmp = arfimaspec(mean.model = list(armaOrder = c(model$modelinc[2], model$modelinc[3]), 
					include.mean = model$modelinc[1], 
					arfima = model$modelinc[4], external.regressors = model$modeldata$mexdata), 
			distribution.model = model$modeldesc$distribution, start.pars  = model$start.pars, 
			fixed.pars = as.list(fixed.pars))
	# ToDo: Need to check that the parameters are not outside the bounds...
	idx = which(is.na(tmp@model$pars[,"LB"]))
	tmp@model$pars[idx,"LB"] = ob ject@model$pars[idx,"LB"]
	idx = which(is.na(tmp@model$pars[,"UB"]))
	tmp@model$pars[idx,"UB"] = ob ject@model$pars[idx,"UB"]
	return(tmp)
}
setReplaceMethod(f="setfixed", signature= c(ob ject = "ARFIMAspec", value = "vector"), definition = .setfixedarfima)

.setstartarfima = function(ob ject, value){
	# get parameter values
	model = ob ject@model
	ipars = model$pars
	pars = unlist(value)
	names(pars) = parnames = tolower(names(pars))
	# included parameters in model
	modelnames = rownames(ipars[which(ipars[,4]==1 | ipars[,2]==1), ])
	inc = NULL
	for(i in seq_along(parnames)){
		if(is.na(match(parnames[i], modelnames))){
			warning( (paste("Unrecognized Parameter in Fixed Values: ", parnames[i], "...Ignored", sep = "")))
		} else{
			inc = c(inc, i)
		}
	}
	start.pars = pars[inc]
	names(start.pars) = tolower(names(pars[inc]))
	# set parameter values
	tmp = arfimaspec(mean.model = list(armaOrder = c(model$modelinc[2], model$modelinc[3]), 
					include.mean = model$modelinc[1], 
					arfima = model$modelinc[4], external.regressors = model$modeldata$mexdata), 
			distribution.model = model$modeldesc$distribution, fixed.pars  = model$fixed.pars, 
			start.pars = as.list(start.pars))
	# ToDo: Need to check that the parameters are not outside the bounds...
	idx = which(is.na(tmp@model$pars[,"LB"]))
	tmp@model$pars[idx,"LB"] = ob ject@model$pars[idx,"LB"]
	idx = which(is.na(tmp@model$pars[,"UB"]))
	tmp@model$pars[idx,"UB"] = ob ject@model$pars[idx,"UB"]
	return(tmp)
}

setReplaceMethod(f="setstart", signature= c(ob ject = "ARFIMAspec", value = "vector"), definition = .setstartarfima)

setReplaceMethod(f="setbounds", signature= c(ob ject = "ARFIMAspec", value = "vector"), definition = .setbounds)

arfimafit = function(spec, data, out.sample = 0, solver = "solnp", solver.control = list(), 
		fit.control = list(fixed.se = 0, scale = 0), 
		numderiv.control = list(grad.eps=1e-4, grad.d=0.0001, grad.zero.tol=sqrt(.Machine$double.eps/7e-7),
				hess.eps=1e-4, hess.d=0.1, hess.zero.tol=sqrt(.Machine$double.eps/7e-7), r=4, v=2), ...)
{
	UseMethod("arfimafit")
}

setMethod("arfimafit", signature(spec = "ARFIMAspec"), .arfimafit)

arfimafilter = function(spec, data, out.sample = 0, n.old = NULL, ...)
{
	UseMethod("arfimafilter")
}

setMethod("arfimafilter", signature(spec = "ARFIMAspec"), .arfimafilter)


arfimaforecast = function(fitORspec, data = NULL, n.ahead = 10, n.roll = 0, out.sample = 0, 
		external.forecasts = list(mregfor = NULL), ...)
{
	UseMethod("arfimaforecast")
}

setMethod("arfimaforecast", signature(fitORspec = "ARFIMAfit"), .arfimaforecast)

setMethod("arfimaforecast", signature(fitORspec = "ARFIMAspec"), .arfimaforecast2)

arfimasim = function(fit, n.sim = 1000, n.start = 0, m.sim = 1, startMethod = c("unconditional","sample"), 
		prereturns = NA, preresiduals = NA, rseed = NA, custom.dist = list(name = NA, distfit = NA, type = "z"), 
		mexsimdata = NULL, ...)
{
	UseMethod("arfimasim")
}


setMethod("arfimasim", signature(fit = "ARFIMAfit"), .arfimasim)

arfimapath = function(spec, n.sim = 1000, n.start = 0, m.sim = 1, prereturns = NA, preresiduals = NA, 
		rseed = NA,  custom.dist = list(name = NA, distfit = NA, type = "z"), mexsimdata = NULL, ...)
{
	UseMethod("arfimapath")
}


setMethod("arfimapath", signature(spec = "ARFIMAspec"), .arfimapath)


arfimaroll = function(spec, data, n.ahead = 1, forecast.length = 500, 
		n.start = NULL, refit.every = 25, refit.window = c("recursive", "moving"), 
		window.size = NULL, solver = "hybrid", fit.control = list(), 
		solver.control = list(), calculate.VaR = TRUE, VaR.alpha = c(0.01, 0.05), 
		cluster = NULL, keep.coef = TRUE, ...)
{
	setMethod("arfimaroll")
}

setMethod("arfimaroll", signature(spec = "ARFIMAspec"),  definition = .arfimaroll)

setMethod("resume", signature(ob ject = "ARFIMAroll"),  definition = .resumeroll2)


arfimadistribution = function(fitORspec, n.sim = 2000, n.start = 1, 
		m.sim = 100, recursive = FALSE, recursive.length = 6000, recursive.window = 1000, 
		prereturns = NA, preresiduals = NA, rseed = NA, 
		custom.dist = list(name = NA, distfit = NA, type = "z"), 
		mexsimdata = NULL, fit.control = list(), solver = "solnp", 
		solver.control = list(), cluster = NULL, ...)
{
	setMethod("arfimadistribution")
}
setMethod("arfimadistribution", signature(fitORspec = "ARFIMAfit"), .arfimadistribution)
setMethod("arfimadistribution", signature(fitORspec = "ARFIMAspec"), .arfimadistribution)

setMethod("show",
		signature(ob ject = "ARFIMAspec"),
		function(ob ject){
			model = ob ject@model
			modelinc = model$modelinc
			cat(paste("\n*----------------------------------*", sep = ""))
			cat(paste("\n*       ARFIMA Model Spec          *", sep = ""))
			cat(paste("\n*----------------------------------*", sep = ""))
			cat("\nConditional Mean Dynamics")
			cat(paste("\n------------------------------------\n",sep=""))
			cat("Mean Model\t\t\t: ARFIMA(", modelinc[2],",", ifelse(modelinc[4]>0, "d", 0),",",modelinc[3],")\n", sep = "")
			cat("Include Mean\t\t:", as.logical(modelinc[1]),"\n")
			if(modelinc[6]>0) cat(paste("Exogenous Regressor Dimension: ", modelinc[6],"\n",sep=""))
			cat("\nConditional Distribution")
			cat(paste("\n------------------------------------\n",sep=""))
			cat("Distribution\t: ", model$modeldesc$distribution,"\n")
			cat("Includes Skew\t: ", as.logical(modelinc[16]),"\n")
			cat("Includes Shape\t: ", as.logical(modelinc[17]),"\n")
			cat("Includes Lambda\t: ", as.logical(modelinc[18]),"\n\n")
			return(invisible(ob ject))
		})

# fit show
# fit show
setMethod("show",
		signature(ob ject = "ARFIMAfit"),
		function(ob ject){
			model = ob ject@model
			modelinc = model$modelinc
			cat(paste("\n*----------------------------------*", sep = ""))
			cat(paste("\n*          ARFIMA Model Fit        *", sep = ""))
			cat(paste("\n*----------------------------------*", sep = ""))
			cat("\nMean Model\t: ARFIMA(", modelinc[2],",",ifelse(modelinc[4]>0, "d", 0),",",modelinc[3],")\n", sep = "")
			cat("Distribution\t:", model$modeldesc$distribution,"\n")
			if(ob ject@fit$convergence == 0){
				cat("\nOptimal Parameters")
				cat(paste("\n------------------------------------\n",sep=""))
				print(round(ob ject@fit$matcoef,6), digits = 5)
				cat("\nRobust Standard Errors:\n")
				print(round(ob ject@fit$robust.matcoef,6), digits = 5)
				if(!is.null(ob ject@fit$hessian.message)){
					cat(paste("\n", ob ject@fit$hessian.message))
				}
				cat("\nLogLikelihood :", ob ject@fit$LLH, "\n")
				stdresid = ob ject@fit$residuals/coef(ob ject)["sigma"]
				itestm = infocriteria(ob ject)
				cat("\nInformation Criteria")
				cat(paste("\n------------------------------------\n",sep=""))
				print(itestm,digits=5)
				cat("\nWeighted Ljung-Box Test on Standardized Residuals")
				cat(paste("\n------------------------------------\n",sep=""))
				tmp1 = .weightedBoxTest(stdresid, p = 1, df = sum(modelinc[2:3]))
				print(tmp1, digits = 4)
				cat("\nH0 : No serial correlation\n")
				cat("\nWeighted Ljung-Box Test on Standardized Squared Residuals")
				cat(paste("\n------------------------------------\n",sep=""))
				tmp2 = .weightedBoxTest(stdresid, p = 2, df = sum(modelinc[8:9]))
				print(tmp2, digits = 4)
				cat("\n\nARCH LM Tests")
				cat(paste("\n------------------------------------\n",sep=""))
				L2 = .archlmtest(stdresid, lags = 2)
				L5 = .archlmtest(stdresid, lags = 5)
				L10 = .archlmtest(stdresid, lags = 10)
				alm = matrix(0,ncol = 3,nrow = 3)
				alm[1,1:3] = c(L2$statistic, L2$parameter, L2$p.value)
				alm[2,1:3] = c(L5$statistic, L5$parameter, L5$p.value)
				alm[3,1:3] = c(L10$statistic, L10$parameter, L10$p.value)
				colnames(alm) = c("Statistic", "DoF", "P-Value")
				rownames(alm) = c("ARCH Lag[2]", "ARCH Lag[5]", "ARCH Lag[10]")
				print(alm,digits = 4)
				nyb = .nyblomTest(ob ject)
				if(is.character(nyb$JointCritical)){
					colnames(nyb$IndividualStat)<-""
					cat("\nNyblom stability test")
					cat(paste("\n------------------------------------\n",sep=""))
					cat("Joint Statistic: ", "no.parameters>20 (not available)")
					cat("\nIndividual Statistics:")
					print(nyb$IndividualStat, digits = 4)
					cat("\nAsymptotic Critical Values (10% 5% 1%)")
					cat("\nIndividual Statistic:\t", round(nyb$IndividualCritical, 2))
					cat("\n\n")
				} else{
					colnames(nyb$IndividualStat)<-""
					cat("\nNyblom stability test")
					cat(paste("\n------------------------------------\n",sep=""))
					cat("Joint Statistic: ", round(nyb$JointStat,4))
					cat("\nIndividual Statistics:")
					print(nyb$IndividualStat, digits = 4)
					cat("\nAsymptotic Critical Values (10% 5% 1%)")
					cat("\nJoint Statistic:     \t", round(nyb$JointCritical, 3))
					cat("\nIndividual Statistic:\t", round(nyb$IndividualCritical, 2))
					cat("\n\n")
				}
				cat("\nElapsed time :", ob ject@fit$timer,"\n\n")
			} else{
				cat("\nConvergence Problem:")
				cat("\nSolver Message:", ob ject@fit$message,"\n\n")
				
			}
			return(invisible(ob ject))
		})
# filter show
setMethod("show",
		signature(ob ject = "ARFIMAfilter"),
		function(ob ject){
			model = ob ject@model
			modelinc = ob ject@model$modelinc
			cat(paste("\n*-------------------------------------*", sep = ""))
			cat(paste("\n*          ARFIMA Model Filter        *", sep = ""))
			cat(paste("\n*-------------------------------------*", sep = ""))
			cat("\nMean Model\t: ARFIMA(", modelinc[2],",",ifelse(modelinc[4]>0, "d", 0),",",modelinc[3],")\n", sep = "")
			cat("Distribution\t:", model$modeldesc$distribution,"\n")
			cat("\nFilter Parameters")
			cat(paste("\n---------------------------------------\n",sep=""))
			print(matrix(coef(ob ject), ncol=1, dimnames = list(names(coef(ob ject)), "")), digits = 5)
			cat("\nLogLikelihood :", ob ject@filter$LLH, "\n")
			stdresid = ob ject@filter$residuals/ob ject@model$pars["sigma", 1]
			itestm = infocriteria(ob ject)
			cat("\nInformation Criteria")
			cat(paste("\n---------------------------------------\n",sep=""))
			print(itestm,digits=5)
			cat("\nQ-Statistics on Standardized Residuals")
			cat(paste("\n---------------------------------------\n",sep=""))
			tmp1 = .box.test(stdresid, p = 1, df = sum(modelinc[2:3]))
			print(tmp1, digits = 4)
			cat("\nH0 : No serial correlation\n")
			cat("\nQ-Statistics on Standardized Squared Residuals")
			cat(paste("\n---------------------------------------\n",sep=""))
			tmp2 = .box.test(stdresid, p = 2, df = sum(modelinc[2:3]))
			print(tmp2, digits = 4)
			cat("\nARCH LM Tests")
			cat(paste("\n---------------------------------------\n",sep=""))
			L2 = .archlmtest(stdresid, lags = 2)
			L5 = .archlmtest(stdresid, lags = 5)
			L10 = .archlmtest(stdresid, lags = 10)
			alm = matrix(0,ncol = 3,nrow = 3)
			alm[1,1:3] = c(L2$statistic, L2$parameter, L2$p.value)
			alm[2,1:3] = c(L5$statistic, L5$parameter, L5$p.value)
			alm[3,1:3] = c(L10$statistic, L10$parameter, L10$p.value)
			colnames(alm) = c("Statistic", "DoF", "P-Value")
			rownames(alm) = c("ARCH Lag[2]", "ARCH Lag[5]", "ARCH Lag[10]")
			print(alm,digits = 4)
			cat("\n\n")
			return(invisible(ob ject))
		})
# sim show
setMethod("show",
		signature(ob ject = "ARFIMAsim"),
		function(ob ject){
			model = ob ject@model
			modelinc = model$modelinc
			cat(paste("\n*-------------------------------------*", sep = ""))
			cat(paste("\n*       ARFIMA Model Simulation       *", sep = ""))
			cat(paste("\n*-------------------------------------*", sep = ""))
			sim = ob ject@simulation
			dates = ob ject@model$dates
			series = sim$seriesSim
			resids = sim$residSim
			m = dim(series)[2]
			N = dim(series)[1]
			cat(paste("\nHorizon: ",N))
			cat(paste("\nSimulations: ",m,"\n",sep=""))
			rx1 = apply(series, 2, FUN=function(x) mean(x))
			rx2 = apply(series, 2, FUN=function(x) range(x))
			T = ob ject@model$modeldata$T
			xspec = .model2spec(as.list(ob ject@model$pars[ob ject@model$pars[,3]==1,1]), ob ject@model, type = "ARFIMA")
			actual = c(0, mean(ob ject@model$modeldata$data[1:T]), 
					min(ob ject@model$modeldata$data[1:T]), max(ob ject@model$modeldata$data[1:T]))
			uncond = c(0, uncmean(xspec), NA, NA)
			dd = data.fr ame(Seed = ob ject@seed, Series.Mean = rx1, Series.Min = rx2[1,],
					Series.Max = rx2[2,])
			meansim = apply(dd, 2, FUN = function(x) mean(x))
			meansim[1] = 0
			dd = rbind(dd, meansim, actual, uncond)
			rownames(dd) = c(paste("sim", 1:m, sep = ""), "Mean(All)", "Actual", "Unconditional")
			print(dd,digits = 3)
			cat("\n\n")
			return(invisible(ob ject))
		})
		
# forecast show
setMethod("show",
		signature(ob ject = "ARFIMAforecast"),
		function(ob ject){
			cat(paste("\n*----------------------------------*", sep = ""))
			cat(paste("\n*        ARFIMA Model Forecast     *", sep = ""))
			cat(paste("\n*----------------------------------*", sep = ""))
			n.ahead = ob ject@forecast$n.ahead
			cat(paste("\n\nHorizon: ", n.ahead, sep = ""))
			cat(paste("\nRoll Steps: ",ob ject@forecast$n.roll, sep = ""))
			n.start = ob ject@forecast$n.start
			if(n.start>0) infor = ifelse(n.ahead>n.start, n.start, n.ahead) else infor = 0
			cat(paste("\nOut of Sample: ", infor, "\n", sep = ""))
			cat("\n0-roll forecast: \n")
			zz = ob ject@forecast$seriesFor[,1]
			print(zz, digits = 4)
			cat("\n\n")
			return(invisible(ob ject))
		})

# path show
setMethod("show",
		signature(ob ject = "ARFIMApath"),
		function(ob ject){
			model = ob ject@model
			modelinc = model$modelinc
			cat(paste("\n*--------.........------------------------*", sep = ""))
			cat(paste("\n*        ARFIMA Model Path Simulation     *", sep = ""))
			cat(paste("\n*-----------------------------------------*", sep = ""))
			sim = ob ject@path
			series = sim$seriesSim
			resids = sim$residSim
			m = dim(series)[2]
			N = dim(series)[1]
			cat(paste("\n\nHorizon: ", N))
			cat(paste("\nSimulations: ", m, "\n", sep = ""))
			T = ob ject@model$modeldata$T
			xspec = .model2spec(as.list(ob ject@model$pars[ob ject@model$pars[,3]==1,1]), ob ject@model, type = "ARFIMA")
			uncond = c(0, uncmean(xspec), NA, NA)
			rx1 = apply(series, 2, FUN = function(x) mean(x))
			rx2 = apply(series, 2, FUN = function(x) range(x))
			dd = data.fr ame(Seed = ob ject@seed, Series.Mean = rx1, Series.Min = rx2[1,], 
					Series.Max = rx2[2,])
			meansim = apply(dd, 2, FUN = function(x) mean(x))
			meansim[1] = 0			
			dd = rbind(dd, meansim, uncond)
			rownames(dd) = c(paste("sim", 1:m, sep = ""), "Mean(All)", "Unconditional")			
			print(dd, digits = 3)
			cat("\n\n")
			return(invisible(ob ject))
		})

setMethod("show",
		signature(ob ject = "ARFIMAroll"),
		function(ob ject){
			if(!is.null(ob ject@model$noncidx)){
				cat("\nob ject containts non-converged estimation windows. Use resume method to re-estimate.\n")
				return(invisible(ob ject))
			} else{
				cat(paste("\n*--------------------------------------*", sep = ""))
				cat(paste("\n*              ARFIMA Roll             *", sep = ""))
				cat(paste("\n*--------------------------------------*", sep = ""))
				N = ob ject@model$n.refits
				model = ob ject@model$spec@model
				modelinc = model$modelinc
				cat("\nNo.Refits\t\t:", N)
				cat("\nRefit Horizon\t:", ob ject@model$refit.every)
				cat("\nNo.Forecasts\t:", NROW(ob ject@forecast$density))
				cat("\nDistribution\t:", model$modeldesc$distribution,"\n")
				cat("\nForecast Density:\n")
				print(round(head(ob ject@forecast$density),4))
				cat("\n..........................\n")
				print(round(tail(ob ject@forecast$density),4))
				cat("\n\n")
				return(invisible(ob ject))
			}
		})
# distribution show
# distribution show
setMethod("show",
		signature(ob ject = "ARFIMAdistribution"),
		function(ob ject){
			cat(paste("\n*-------------------------------------*", sep = ""))
			cat(paste("\n*    ARFIMA Parameter Distribution    *", sep = ""))
			cat(paste("\n*-------------------------------------*", sep = ""))
			cat(paste("\nNo. Paths (m.sim) : ", ob ject@dist$details$m.sim, sep = ""))
			cat(paste("\nLength of Paths (n.sim) : ", ob ject@dist$details$n.sim, sep = ""))
			cat(paste("\nRecursive : ", ob ject@dist$details$recursive, sep = ""))
			if(ob ject@dist$details$recursive){
				cat(paste("\nRecursive Length : ", ob ject@dist$details$recursive.length, sep = ""))
				cat(paste("\nRecursive Window : ", ob ject@dist$details$recursive.window, sep = ""))
			}
			cat("\n\n")
			cat("Coefficients: True vs Simulation Mean (Window-n)\n")
			nwindows = ob ject@dist$details$nwindows
			nm = ob ject@dist$details$n.sim + (0:(nwindows-1))*ob ject@dist$details$recursive.window
			ns = matrix(0, ncol = dim(ob ject@truecoef)[1], nrow = nwindows)
			for(i in 1:nwindows){
				ns[i,] = apply(as.data.fr ame(ob ject, window = i), 2, FUN = function(x) mean(x, na.rm = T))
			}
			ns = rbind(ob ject@truecoef[,1], ns)
			colnames(ns) = rownames(ob ject@truecoef)
			rownames(ns) = c("true-coef",paste("window-", nm, sep=""))
			print(as.data.fr ame(ns), digits=5)
			for(i in 1:nwindows){
				if(any(ob ject@dist[[i]]$convergence==1)) n = length(which(ob ject@dist[[i]]$convergence==1)) else n = 0
				if(n>0) cat(paste("\nwindow-",nm[i]," no. of non-converged fits: ", n, "\n",sep=""))
			}
			cat("\n\n")
			return(invisible(ob ject))
		})

#-------------------------------------------------------------------------
# multi-methods
setMethod("show",
		signature(ob ject = "ARFIMAmultispec"),
		function(ob ject){
			cat(paste("\n*---------------------------------*", sep = ""))
			cat(paste("\n*        ARFIMA Multi-Spec        *", sep = ""))
			cat(paste("\n*---------------------------------*", sep = ""))
			N = length(ob ject@spec)
			cat(paste("\n\nMultiple Specifications\t: ", N, sep=""))
			cat(paste("\nMulti-Spec Type\t\t\t: ", ob ject@type, sep=""))
			cat("\n\n")
			return(invisible(ob ject))
		})		

setMethod("show",
		signature(ob ject = "ARFIMAmultifit"),
		function(ob ject){
			cat(paste("\n*--------------------------------*", sep = ""))
			cat(paste("\n*       ARFIMA Multi-Fit         *", sep = ""))
			cat(paste("\n*--------------------------------*", sep = ""))
			cat(paste("\n\nNo. Assets :", length(ob ject@fit), sep=""))
			asset.names = ob ject@desc$asset.names
			if(ob ject@desc$type == "equal"){
				cat(paste("\nMulti-Spec Type : Equal",sep=""))
				cat(paste("\n\nModel Spec",sep=""))
				cat(paste("\n-------------------------------\n",sep=""))
				cat("\nInclude Mean\t: ", as.logical( ob ject@fit[[1]]@model$modelinc[1] ) )
				cat(paste("\nAR(FI)MA Model  : (",ob ject@fit[[1]]@model$modelinc[2],",",
								ifelse(ob ject@fit[[1]]@model$modelinc[4]>0, 1, "d"),
								",",ob ject@fit[[1]]@model$modelinc[3],")",sep=""))
				if(ob ject@fit[[1]]@model$modelinc[6]>0){
					cat("\nExogenous Regressors : ", ob ject@fit[[1]]@model$modelinc[6])
				} else{
					cat("\nExogenous Regressors : none")
				}
				cat(paste("\nConditional Distribution: ",ob ject@fit[[1]]@model$modeldesc$distribution,"\n", sep=""))
				cv = sapply(ob ject@fit, FUN = function(x) x@fit$convergence)
				if(any(cv != 0)){
					ncv = which(cv != 0)
					nncv = length(ncv)
					cat("\nNo. of non converged fits: ", ncv,"\n")
					if(ncv>0) cat("\nNon converged fits: ", nncv,"\n")
					
				} else{
					cat(paste("\nModel Fit", sep = ""))
					cat(paste("\n-------------------------------\n",sep=""))
					cat("\n")
					ll = t(likelihood(ob ject))
					rownames(ll) = "Log-Lik"
					cf = coef(ob ject)
					colnames(cf) = asset.names
					print(round(rbind(cf, ll), digits = 5))
					cat("\n")
				}
			} else{
				cat(paste("\nARFIMA Model Fit", sep = ""))
				cat(paste("\n-------------------------------\n",sep=""))
				cat(paste("\nModel Fit", sep = ""))
				cat(paste("\n-------------------------------\n",sep=""))
				cat("\n")
				print(coef(ob ject), digits = 5)
			}
			cat("\n\n")
			return(invisible(ob ject))
		})

setMethod("show",
		signature(ob ject = "ARFIMAmultifilter"),
		function(ob ject){
			cat(paste("\n*--------------------------------*", sep = ""))
			cat(paste("\n*       ARFIMA Multi-Filter         *", sep = ""))
			cat(paste("\n*--------------------------------*", sep = ""))
			cat(paste("\n\nNo. Assets :", length(ob ject@filter), sep=""))
			asset.names = ob ject@desc$asset.names
			if(ob ject@desc$type == "equal"){
				cat(paste("\nMulti-Spec Type : Equal",sep=""))
				cat(paste("\n\nModel Spec",sep=""))
				cat(paste("\n-------------------------------\n",sep=""))
				cat("\nInclude Mean\t: ", as.logical( ob ject@filter[[1]]@model$modelinc[1] ) )
				cat(paste("\nAR(FI)MA Model : (",ob ject@filter[[1]]@model$modelinc[2],",",
								ifelse(ob ject@filter[[1]]@model$modelinc[4]>0, 1, "d"),
								",",ob ject@filter[[1]]@model$modelinc[3],")",sep=""))
				if(ob ject@filter[[1]]@model$modelinc[6]>0){
					cat("\nExogenous Regressors in mean equation: ", ob ject@filter[[1]]@model$modelinc[6])
				} else{
					cat("\nExogenous Regressors in mean equation: none")
				}
				cat("\nConditional Distribution: ",ob ject@filter[[1]]@model$modeldesc$distribution,"\n")			
				cat(paste("\nModel Filter", sep = ""))
				cat(paste("\n-------------------------------\n",sep=""))
				cat("\n")
				ll = t(likelihood(ob ject))
				rownames(ll) = "Log-Lik"
				cf = coef(ob ject)
				colnames(cf) = asset.names
				print(round(rbind(cf, ll), digits = 5))
				cat("\n")
			} else{
				cat(paste("\nARFIMA Model Filter", sep = ""))
				cat(paste("\n-------------------------------\n",sep=""))
				cat(paste("\nModel Fit", sep = ""))
				cat(paste("\n-------------------------------\n",sep=""))
				cat("\n")
				print(coef(ob ject), digits = 5)
			}
			cat("\n\n")
			return(invisible(ob ject))
		})

setMethod("show",
		signature(ob ject = "ARFIMAmultiforecast"),
		function(ob ject){
			asset.names = ob ject@desc$asset.names
			cat(paste("\n*----------------------------------*", sep = ""))
			cat(paste("\n*       ARFIMA Multi-Forecast      *", sep = ""))
			cat(paste("\n*----------------------------------*", sep = ""))
			cat(paste("\n\nNo. Assets :", length(ob ject@forecast), sep=""))
			cat(paste("\n--------------------------\n",sep=""))
			cat("\n\n")
			return(invisible(ob ject))
		})

#----------------------------------------------------------------------------------
# univariate fit extractors
#----------------------------------------------------------------------------------
# coef methods
.arfimacoef = function(ob ject)
{
	switch(class(ob ject)[1],
			ARFIMAfit = ob ject@fit$coef,
			ARFIMAfilter = ob ject@model$pars[ob ject@model$pars[,2]==1, 1],
			ARFIMAmultifit = {
				if(ob ject@desc$type == "equal"){
					sapply(ob ject@fit, FUN = function(x) coef(x), simplify = TRUE)
				} else{
					lapply(ob ject@fit, FUN = function(x) coef(x))
				}
			},
			ARFIMAmultifilter = {
				if(ob ject@desc$type == "equal"){
					sapply(ob ject@filter, FUN = function(x) coef(x), simplify = TRUE)
				} else{
					lapply(ob ject@filter, FUN = function(x) coef(x))
				}
			},
			ARFIMAroll = {
				if(!is.null(ob ject@model$noncidx)) stop("\nob ject containts non-converged estimation windows.")
				ob ject@model$coef
			})
}

setMethod("coef", signature(ob ject = "ARFIMAfit"), .arfimacoef)
setMethod("coef", signature(ob ject = "ARFIMAfilter"), .arfimacoef)
setMethod("coef", signature(ob ject = "ARFIMAmultifit"), .arfimacoef)
setMethod("coef", signature(ob ject = "ARFIMAmultifilter"), .arfimacoef)
setMethod("coef", signature(ob ject = "ARFIMAroll"), .arfimacoef)
#----------------------------------------------------------------------------------
#----------------------------------------------------------------------------------
# Fitted method
.arfimafitted = function(ob ject)
{
	if(class(ob ject)[1] == "ARFIMAfit" | class(ob ject)[1] == "ARFIMAfilter"){
		D = ob ject@model$modeldata$index[1:ob ject@model$modeldata$T]
	}
	switch(class(ob ject)[1],
			ARFIMAfit = xts(ob ject@fit$fitted.values, D), 
			ARFIMAfilter = xts(ob ject@model$modeldata$data[1:ob ject@model$modeldata$T] - ob ject@filter$residuals, D),
			ARFIMAmultifilter = sapply(ob ject@filter, FUN = function(x) fitted(x), simplify = TRUE),
			ARFIMAmultifit = sapply(ob ject@fit, FUN = function(x) fitted(x), simplify = TRUE),
			ARFIMAsim = {
				ans = ob ject@simulation$seriesSim
				rownames(ans) = paste("T+",1:NROW(ob ject@simulation$seriesSim), sep="")
				return(ans)
			},
			ARFIMApath ={
				ans = ob ject@path$seriesSim
				rownames(ans) = paste("T+",1:NROW(ob ject@path$seriesSim), sep="")
				return(ans)
			},
			ARFIMAforecast = ob ject@forecast$seriesFor
	)
}
setMethod("fitted", signature(ob ject = "ARFIMAfit"), .arfimafitted)
setMethod("fitted", signature(ob ject = "ARFIMAfilter"), .arfimafitted)
setMethod("fitted", signature(ob ject = "ARFIMAmultifit"), .arfimafitted)
setMethod("fitted", signature(ob ject = "ARFIMAmultifilter"), .arfimafitted)
setMethod("fitted", signature(ob ject = "ARFIMAsim"), .arfimafitted)
setMethod("fitted", signature(ob ject = "ARFIMApath"), .arfimafitted)
setMethod("fitted", signature(ob ject = "ARFIMAforecast"), .arfimafitted)

.arfimafittedmf = function(ob ject)
{
	n.assets = length(ob ject@forecast)
	n.ahead = ob ject@forecast[[1]]@forecast$n.ahead
	n.roll = ob ject@forecast[[1]]@forecast$n.roll+1
	Z = array(NA, dim = c(n.ahead, n.roll, n.assets))
	for(i in 1:n.assets){
		Z[,,i] = fitted(ob ject@forecast[[i]])
	}
	return(Z)
}
setMethod("fitted", signature(ob ject = "ARFIMAmultiforecast"), .arfimafittedmf)

#----------------------------------------------------------------------------------
# as.data.fr ame method for distribution ob ject
.arfimadistdf = function(x, row.names = NULL, optional = FALSE, which = "coef", window = 1, ...)
{
	n = x@dist$details$nwindows
	if(window > n) stop("window size greater than actual available", call. = FALSE)
	
	if(which == "rmse"){
		ans = as.data.fr ame(t(x@dist[[window]]$rmse))
		colnames(ans) = rownames(x@truecoef)
	}
	
	if(which == "stats"){	
		llh = x@dist[[window]]$likelist
		uncmean = x@dist[[window]]$mlongrun
		maxret = x@dist[[window]]$simmaxdata[,1]
		minret = x@dist[[window]]$simmindata[,1]
		meanret = x@dist[[window]]$simmeandata[,1]
		kurtosis = x@dist[[window]]$simmomdata[,1]
		skewness = x@dist[[window]]$simmomdata[,2]
		ans = data.fr ame(llh = llh, uncmean = uncmean, maxret = maxret, minret = minret, 
				meanret = meanret, kurtosis = kurtosis, skewness  = skewness)
	}
	
	if(which == "coef"){
		cf = x@dist[[window]]$simcoef
		ans = data.fr ame(coef = cf)
		colnames(ans) = rownames(x@truecoef)
	}
	
	if(which == "coefse"){
		cfe = x@dist[[window]]$simcoefse
		ans = data.fr ame(coefse = cfe)
		colnames(ans) = rownames(x@truecoef)
	}
	
	ans
}

setMethod("as.data.fr ame", signature(x = "ARFIMAdistribution"), .arfimadistdf)
#----------------------------------------------------------------------------------
# as.data.fr ame method for bootstrap ob ject
.arfimabootdf = function(x, row.names = NULL, optional = FALSE, type = "raw", qtile = c(0.01, 0.099))
{
	n.ahead = x@model$n.ahead
	if(type == "raw"){
		series = x@fseries
		ans = data.fr ame(bootseries = series)
		colnames(ans) = paste("t+", 1:n.ahead, sep="")
	}
	if(type == "q"){
		if(all(is.numeric(qtile)) && (all(qtile<1.0) && all(qtile >0.0))){
			series = x@fseries
			ans = apply(series, 2, FUN = function(x) quantile(x, qtile))
			ans = as.data.fr ame(ans)
			colnames(ans) = paste("t+", 1:n.ahead, sep="")
			rownames(ans) = paste("q", qtile, sep = "")
		} else{
			stop("\nfor type q, the qtile value must be numeric and between (>)0 and 1(<)\n", call.  = FALSE)
		} 
	}
	if(type == "summary"){
		series = x@fseries
		ans = apply(series, 2, FUN = function(x) c(min(x), quantile(x, 0.25), mean(x), quantile(x, 0.75), max(x) ))
		ans = as.data.fr ame(ans)
		colnames(ans) = paste("t+", 1:n.ahead, sep="")
		rownames(ans) = c("min", "q.25", "mean", "q.75", "max")
	}
	ans
}
#setMethod("as.data.fr ame", signature(x = "ARFIMAboot"), .arfimabootdf)


#----------------------------------------------------------------------------------
# as.data.fr ame method for roll ob ject
.arfimarolldf = function(x, row.names = NULL, optional = FALSE, which = "density")
{
	if(!is.null(x@model$noncidx)) stop("\nob ject containts non-converged estimation windows.")
	if(which == "density") ans =  x@forecast$density else ans = x@forecast$VaR
	return(ans)
}
setMethod("as.data.fr ame", signature(x = "ARFIMAroll"), .arfimarolldf)

#----------------------------------------------------------------------------------
# residuals method
.arfimaresids = function(ob ject, standardize = FALSE)
{
	if(class(ob ject)[1] == "ARFIMAfit" | class(ob ject)[1] == "ARFIMAfilter"){
		D = ob ject@model$modeldata$index[1:ob ject@model$modeldata$T]
		s = ob ject@model$pars["sigma",1]
	}
	if(standardize){
		ans = switch(class(ob ject)[1],
				ARFIMAfit = xts(ob ject@fit$residuals/s, D),
				ARFIMAfilter = xts(ob ject@filter$residuals/s, D),
				ARFIMAmultifit = sapply(ob ject@fit, FUN = function(x) residuals(x, standardize = TRUE), simplify = TRUE),
				ARFIMAmultifilter = sapply(ob ject@filter, FUN = function(x) residuals(x, standardize = TRUE), simplify = TRUE))
	} else{
		ans = switch(class(ob ject)[1],
				ARFIMAfit = xts(ob ject@fit$residuals, D),
				ARFIMAfilter = xts(ob ject@filter$residuals, D),
				ARFIMAmultifit = sapply(ob ject@fit, FUN = function(x) residuals(x), simplify = TRUE),
				ARFIMAmultifilter = sapply(ob ject@filter, FUN = function(x) residuals(x), simplify = TRUE))
	}
	return(ans)
}

setMethod("residuals", signature(ob ject = "ARFIMAfit"), .arfimaresids)
setMethod("residuals", signature(ob ject = "ARFIMAfilter"), .arfimaresids)
setMethod("residuals", signature(ob ject = "ARFIMAmultifit"), .arfimaresids)
setMethod("residuals", signature(ob ject = "ARFIMAmultifilter"), .arfimaresids)

#----------------------------------------------------------------------------------
# Likelihood method
.arfimaLikelihood = function(ob ject)
{
	switch(class(ob ject)[1],
			ARFIMAfit = ob ject@fit$LLH,
			ARFIMAfilter = ob ject@filter$LLH,
			ARFIMAmultifilter = sapply(ob ject@filter, FUN = function(x) likelihood(x), simplify = TRUE),
			ARFIMAmultifit = sapply(ob ject@fit, FUN = function(x) likelihood(x), simplify = TRUE))
}

setMethod("likelihood", signature(ob ject = "ARFIMAfit"), .arfimaLikelihood)
setMethod("likelihood", signature(ob ject = "ARFIMAfilter"), .arfimaLikelihood)
setMethod("likelihood", signature(ob ject = "ARFIMAmultifilter"), .arfimaLikelihood)
setMethod("likelihood", signature(ob ject = "ARFIMAmultifit"), .arfimaLikelihood)
#----------------------------------------------------------------------------------
# Info Criteria method
.arfimainfocriteria = function(ob ject)
{
	if(is(ob ject, "ARFIMAfit")){
		np = sum(ob ject@fit$ipars[,4])
	} else{
		np = length(coef(ob ject))
	}
	itest = .information.test(likelihood(ob ject), nObs = NROW(fitted(ob ject)), 
			nPars = np)
	itestm = matrix(0, ncol = 1, nrow = 4)
	itestm[1,1] = itest$AIC
	itestm[2,1] = itest$BIC
	itestm[3,1] = itest$SIC
	itestm[4,1] = itest$HQIC
	colnames(itestm) = ""
	rownames(itestm) = c("Akaike", "Bayes", "Shibata", "Hannan-Quinn")
	return(itestm)
}

setMethod("infocriteria", signature(ob ject = "ARFIMAfit"), .arfimainfocriteria)
setMethod("infocriteria", signature(ob ject = "ARFIMAfilter"), .arfimainfocriteria)


#----------------------------------------------------------------------------------
# The mult- methods
#----------------------------------------------------------------------------------
.multispecarfima = function( speclist )
{
	# first create a spec which goes through validation process
	tp = 1
	ans = new("ARFIMAmultispec", 
			spec = speclist,
			type = "equal")
	# then check type
	n = length(speclist)
	for(i in 2:n){
		modelnames1 = rownames( speclist[[i]]@model$pars[speclist[[i]]@model$pars[,3]==1, ] )
		modelnames2 = rownames( speclist[[i-1]]@model$pars[speclist[[i-1]]@model$pars[,3]==1, ] )
		if(length(modelnames1) != length(modelnames2)){
			tp  = 0
			break()
		} else{
			if(!all(modelnames1 == modelnames2))
			{
				tp  = 0
				break()
			}
		}
	}
	if(tp) type = "equal" else type = "unequal"
	ans = new("ARFIMAmultispec",
			spec = speclist,
			type = type)
	return(ans)
}

setMethod("multifit", signature(multispec = "ARFIMAmultispec"),  definition = .multifitarfima)
setMethod("multifilter", signature(multifitORspec = "ARFIMAmultifit"),  definition = .multifilterarfima1)
setMethod("multifilter", signature(multifitORspec = "ARFIMAmultispec"),  definition = .multifilterarfima2)
setMethod("multiforecast", signature(multifitORspec = "ARFIMAmultifit"),  definition = .multiforecastarfima1)
setMethod("multiforecast", signature(multifitORspec = "ARFIMAmultispec"),  definition = .multiforecastarfima2)
# Unconditional Mean
.unconditionalmean11 = function(ob ject, method = c("analytical", "simulation"), n.sim = 20000, rseed = NA)
{
	method = method[1]
	N = ob ject@model$modeldata$T
	if(is(ob ject, "ARFIMAfit")) pars = ob ject@fit$ipars[,1] else pars = ob ject@filter$ipars[,1]
	if(method == "analytical"){
		modelinc = ob ject@model$modelinc
		idx = ob ject@model$pidx
		if(modelinc[6]>0){
			mxreg = pars[idx["mxreg",1]:idx["mxreg",2]]
			mexdata = matrix(ob ject@model$modeldata$mexdata[1:N, ], ncol = modelinc[6])
			meanmex = apply(mexdata, 2, "mean")
			umeanmex = sum(mxreg*meanmex)
		} else{
			umeanmex = 0
		}
		if(modelinc[1]>0) mu = pars[idx["mu",1]] else mu=0
		umean = (mu + umeanmex)
		return(umean)
	} else{
		if(is(ob ject, "ARFIMAfit")){
			sim = arfimasim(ob ject, n.sim = n.sim, n.start = 1000, startMethod = "sample", rseed = rseed)
			umean = mean(as.vector(sim@simulation$seriesSim))
			return(umean)
		} else{
			stop("\nuncmean by simulation not available for ARFIMAfilter class ob ject (used spec instead).")
		}
	}
}

.unconditionalmean21 = function(ob ject, method = c("analytical", "simulation"), n.sim = 20000, rseed = NA)
{
	method = method[1]
	if(is.null(ob ject@model$fixed.pars)) stop("uncmean with ARFIMAspec requires fixed.pars list", call. = FALSE)
	if(method == "analytical"){
		model = ob ject@model
		pars = unlist(model$fixed.pars)
		parnames = names(pars)
		modelnames = .checkallfixed(ob ject)
		if(is.na(all(match(modelnames, parnames), 1:length(modelnames)))) {
			cat("\nuncmean-->error: parameters names do not match specification\n")
			cat("Expected Parameters are: ")
			cat(paste(modelnames))
			cat("\n")
			stop("Exiting", call. = FALSE)
		}
		# once more into the spec
		setfixed(ob ject)<-as.list(pars)
		model = ob ject@model
		idx = model$pidx
		modelinc = model$modelinc
		pars = ob ject@model$pars[,1]
		if(modelinc[6]>0){
			mxreg = pars[idx["mxreg",1]:idx["mxreg",2]]
			meanmex = apply(ob ject@model$modeldata$mexdata, 2, "mean")
			umeanmex = sum(mxreg*meanmex)
		} else{
			umeanmex = 0
		}
		if(modelinc[1]>0) mu = pars[idx["mu",1]] else mu=0
		umean = (mu + umeanmex)
		return(umean)
	}  else{
		sim = arfimapath(ob ject, n.sim = n.sim, n.start = 1000, rseed = rseed)
		umean = mean(as.vector(sim@path$seriesSim))
		return(umean)
	}
}
setMethod("uncmean", signature(ob ject = "ARFIMAfit"),    definition = .unconditionalmean11)
setMethod("uncmean", signature(ob ject = "ARFIMAfilter"), definition = .unconditionalmean11)
setMethod("uncmean", signature(ob ject = "ARFIMAspec"),   definition = .unconditionalmean21)

# forecast performance measures
.arfimarollreport = function(ob ject, type = "VaR", VaR.alpha = 0.01, conf.level = 0.95)
{
	if(!is.null(ob ject@model$noncidx)) stop("\nob ject containts non-converged estimation windows.")
	switch(type,
			VaR = .rollVaRreport2(ob ject, VaR.alpha, conf.level),
			fpm = .rollfpmreport2(ob ject))
	invisible(ob ject)
}

setMethod("report", signature(ob ject = "ARFIMAroll"), .arfimarollreport)

.rollfpmreport2 = function(ob ject)
{
	vmodel = ob ject@model$spec@model$modeldesc$vmodel
	vsubmodel = ob ject@model$spec@model$modeldesc$vsubmodel
	cat(paste("\nARFIMA Roll Mean Forecast Performance Measures", sep = ""))
	cat(paste("\n---------------------------------------------", sep = ""))
	cat(paste("\nNo.Refits\t: ", ob ject@model$n.refits, sep = ""))
	cat(paste("\nNo.Forecasts: ", NROW(ob ject@forecast$density), sep = ""))
	cat("\n\n")
	tmp = fpm(ob ject)
	print(signif(tmp, 4))
	cat("\n\n")
}

.rollVaRreport2 = function(ob ject, VaR.alpha = 0.01, conf.level = 0.95)
{
	VaR.alpha = VaR.alpha[1]
	v.a = ob ject@model$VaR.alpha
	if(!ob ject@model$calculate.VaR) stop("\nplot-->error: VaR was not calculated for this ob ject\n", call.=FALSE)
	if(!any(v.a==VaR.alpha[1])) stop("\nplot-->error: VaR.alpha chosen is invalid for the ob ject\n", call.=FALSE)
	dvar = ob ject@forecast$VaR
	m = NROW(dvar)
	idx = match(VaR.alpha, v.a)
	.VaRreport(if(is.null(ob ject@model$datanames)) "" else ob ject@model$datanames, "ARFIMA", 
			ob ject@model$spec@model$modeldesc$distribution, 
			p = VaR.alpha, actual = as.numeric(dvar[,"realized"]), 
			VaR = dvar[, idx], 
			conf.level = conf.level)
	invisible(ob ject)
}

.getspec2 = function(ob ject)
{
	spec = arfimaspec(
			mean.model = list(armaOrder = c(ob ject@model$modelinc[2],ob ject@model$modelinc[3]),
					include.mean = ob ject@model$modelinc[1],
					arfima = ob ject@model$modelinc[4], external.regressors = ob ject@model$modeldata$mexdata),
			distribution.model = ob ject@model$modeldesc$distribution, fixed.pars = ob ject@model$fixed.pars)
	# should custom bounds be propagated?
	#idx = which(is.na(tmp@model$pars[,"LB"]))
	#tmp@model$pars[idx,"LB"] = ob ject@model$pars[idx,"LB"]
	#idx = which(is.na(tmp@model$pars[,"UB"]))
	#tmp@model$pars[idx,"UB"] = ob ject@model$pars[idx,"UB"]
	return(spec)
}

setMethod(f = "getspec", signature(ob ject = "ARFIMAfit"), definition = .getspec2)

#######################
setMethod("convergence", signature(ob ject = "ARFIMAfit"),  definition = .convergence)
setMethod("vcov", signature(ob ject = "ARFIMAfit"),  definition = .vcov)

setMethod("fpm", signature(ob ject = "ARFIMAforecast"),  definition = .fpm1)
setMethod("fpm", signature(ob ject = "ARFIMAroll"),  definition = .fpm2)

setMethod("reduce", signature(ob ject = "ARFIMAfit"), .reduce)
二维码

扫码加我 拉你入群

请注明：姓名-公司-职位

以便审核进群资格，未注明则拒绝

分享0
关键词：package Pack PAC Age R语言

相关帖子

已有 1 人评分论坛币 收起 理由
cheetahfly + 20 精彩帖子

总评分: 论坛币 + 20   查看全部评分

劳动经济学

使用道具

返回列表
高级模式
B Color Image Link Quote Code Smilies
您需要登录后才可以回帖 登录 | 我要注册

本版微信群
加好友,备注cda
拉您进交流群
  • 手机版  |
  • 意见反馈  |
  • 帮助  |
  • 新手入门  |
  • 用户手册  |
  • 友情链接  |

    • 如有投资本站、合作意向或投放广告，请联系：13661292478（刘老师）

    联系客服

    邮箱：service@pinggu.org 投诉或不良信息处理：（010-68466864）

    010-68466864

    京ICP备16021002-2号 京B2-20170662号 京公网安备 11010802022788号 论坛法律顾问：王进律师 知识产权保护声明   免责及隐私声明

    GMT+8, 2024-4-26 21:50