
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% "Heavy-Tail Phenomena"RvOɂ%
%@@2019.8.20                                 %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Sidney ResnicḱuHeavy-Tail Phenomenav(Springer)11͂RvO %
% ܂܂ĂBRvOۂɓɂ̓eLXgt@CKvł %
% ŁAŃeLXgEt@CfBȂɊ܂܂ĂAɂ@%
% Ă͈ꕔĂ邱Ƃf肵ĂB    (2019.8.20)               %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%
% _(Appendices) %
%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% 11́F\tgEGA(Software) %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
{߂ł͐̏dz̓vfpăf[^𕪐͂ۂɖɗ
Otc[\tgEGAɂĈʓIȃRgqׂB

SplusR̓f[^̃Ot͂LqI͂ɓKĂBł͐d
z̃f[^͂sWI葱qׂ邪ARSplusŎs
悤ɃvOĂBĂł͂̏d
zɂƂÂZ~pgbN͂̔ẅӖB

ɒl͂ɂĂ͊Lpȃ\tgEGA݂BAlexander McNeil
http://www.math.ethz.ch/~mcneil/software.html
͋ɒl͂ɂăvISplus\tgEGAJĂ邪Ad
z͂̕ɖ𗧂ĂB\tgEGA Finmetrics̈ꕔƂĂ̔
Ă邪AMcNeilWebTCgEVISƂ(T|[g͂Ȃ)pbP
[WƂėp\łBAlec StephensonɂRŏꂽEVIS
http://cran.r-project.org/src/contrib/Descriptions/evir.html
ŗp\łB
{Ă鎞_łMcNeilWebłQRMlibƌĂ΂pbP[W
ɒl܂ރXN͂ŐĂ邪A̗pɂĂ
Mcneil, Frey and Embrechts (2005) ƗǂB

Stuart Coles͎SplusvO_ł
http://homes.stat.unipd.it/coles/public_html/ismev/summary.html
ŌJĂ.
Coles̃vO͋ɒl_ɂĂ̋[ coles (2001)ŗp
ĂB܂R. Reiss and M. ThomasXTREMESƌĂ΂郁j[v
ZłpbP[W Thomas (2001) ƂƂɌJĂ邪Aڂ
htpp://www.xtremes.math.uni-siegen.de
QƂꂽB

%%%%%%%%%%%%
% ӎ %
%%%%%%%%%%%%
ww̍AݐЂĂQueens Collegeɂ͂܂Ƃ
vZ@Ȃ̂ŎႢ납瓝vvZɐʂĂƂ킯ł
ȂBcOȂ玄̃XL͂Ȃ茴nIłB̐߂Őv
OȂĂƂA҂łPaul Feigin, 
Catalin St\u{a}ric\u{a}, Krishanu Maulik, Jan Heffernan Ȃǂɕ
낪łB

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% 11.1: ꎟ(dimension) %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

%%%%%%%%%%%%%%%%%%%%
% 11.1.1: Hill %
%%%%%%%%%%%%%%%%%%%%
3̃vbgAHillvbg, altHillvbgAsmoothed Hillv
bg^ĂBk(ɗpʏvʂ̐)Î͍
Ȃ̂ŁAvbgɂ͐MԂĂȂ,Ⴆΐʂ̑QߐK
ɂƂÂ\邱Ƃ͉\łBႦΖ9.3(283y[W),
Dehaan and Ferreira(2006), Drees(1998a), Csorgo and Vviharos(1995),
Csorgo and Mason (1985), Davis and Resnick(1984), Hall(1982), Hausler
and Teugels (1985) ȂǂQƂꂽBŌyvOEpb
P[W̑ł͑QߐKɂƂÂMԂ^邪AXTREMES͂
ɃpgbNEu[gXgbvM(parametric bootstrap
confidence intervals)vZĂB

%%%%%%%%%%%%%
% Hillalpha %
%%%%%%%%%%%%%
֐Hillalpha(x) ł͂̓f[^EZbgx\alpha𐄒肷邽߂
Hillvbg^ĂB

Hillalpha<-function(x)
{
	ordered <- rev(sort(x))
	ordered <- ordered[ordered[] > 0]
	n <- length(ordered)
	loggs <- log(ordered)
	hill <- cumsum(loggs[1:(n - 1)])/(1:(n - 1)) - loggs[2:n]
	hill <- 1/(hill)
	plot(1:length(hill), hill, type = "l", 
        xlab = "number of order statistics", 
        ylab = "Hill estimate of alpha", main="Hill plot")
}

%%%%%%%%%%%%%%%%
% AltHillalpha %
%%%%%%%%%%%%%%%%
֐altHillalpha(x,theta1,theta2)͂f[^EZbgxƂ,@
\alpha𐄒肷邽߂ɑΐXP[Hillvbg^ĂB
̃vbgł͓_
[log i/log n], H_{i,n} ; n^{theta1} < i < n^{theta2}
^Ă邪Aꐔ theta1  theta2p邱ƂŁA
̏vʁA邢͑ʂ̏vʂɂ
c̃XP[Ə̘c݂ĂB

altHillalpha<-function(x,theta1, theta2)
{
        ordered <- rev(sort(x))
        ordered <- ordered[ordered[] > 0.]
        n <- length(ordered)
        loggs <- log(ordered)
        hill <- cumsum(loggs[1.:(n - 1.)])/(1.:(n - 1.))
	                - loggs[2.:n]
        hill <- 1./hill
        s<-log((1:(n-1)))/log(n-1)      
        plot(s[n^theta1:n^theta2], hill[n^theta1:n^theta2], 
	             type ="l", xlab = "theta", 
             ylab = "Hill estimate of alpha", 
             main="altHill")
}

Rł邪AHillvbg͔r̂߂ɍ킹ĕ\
twoHillalpha ͈Ӗ.

twoHillalpha<-function(x,theta1,theta2)
{
        par(mfrow=c(1,2))       
        Hillalpha(x)
        altHillalpha(x,theta1,theta2)
        par(mfrow=c(1,1))
}

%%%%%%%%%%%%%%%%%
% SmooHillalpha %
%%%%%%%%%%%%%%%%%
̊֐(4.25)̐lsmooH_{k,n}vZA
1/smooH_{k,n}ɑΉxNgvbgB̊֐
x̓f[^Ar͓Kp镽smoothing̒xA(l,up) 
vbg𐧖񂷂鋫EłB

smooHillalpha<-function(x,r,l,up)
{
	ordered <- rev(sort(x))
	ordered <- ordered[ordered[] > 0]
	n <- length(ordered)
	loggs <- log(ordered)
	hill <- cumsum(loggs[1:(n - 1)])/(1:(n - 1)) - loggs[2:n]
	smoo<-hill[1]
	for(k in (1:floor(n/r))){smoo=c(smoo,mean(hill[k+1:r*k]))}
	plot((1:length(smoo))[l:up],1/smoo[l:up],type="l",xlab="", 
              ylab="smoo est of alpha", main="smooHill")
}

3̃vbgHillvbg, altHillvbgAsmooHillvbggݍ킹
֐͎ŗ^B

threeHillalpha<-function(x,theta1,theta2,r,l,up)
{
	par(mfrow=c(1,3))	
	Hillalpha(x)
	altHillalpha(x,theta1,theta2)
	smooHillalpha(x,r,l,up)
	par(mfrow=c(1,1))
}


%%%%%%%%%%%%%%%%%%%%%
% 11.1.2 QQvbg %
%%%%%%%%%%%%%%%%%%%%%
f[^ߎIɃp[g(Pareto)z̎l
ȂƂłꍇAΐϊăp[gzwzɕϊA
[U[߂鐔̏vʂpčŏ̌XvZA
ꐔ alpha̐l𓾂邱ƂłB
臒l傫ȃf[^p[gɂĂ邱Ƃ΁A臒l߂΂悢B

%%%%%%%%%%%%
% Pppareto %
%%%%%%%%%%%%
臒lȏオقڃp[gzɂƂIۂ߂ɂ́A
ΐϊf[^ׂ̂Ă̕ʓ_wx֐̗_Iʓ_Ɣr΂悢B
̏ꍇɂ̓vbg͂_͐`ɂȂ͂łB̂Ƃ
ŏtBbgƂ̏ʏvʂ𗘗p邩Ƃ
ւ̃qgi邢͓̂Ƃł邪APOT@𗘗pۂ臒l̑I)
BႦΐ}^A֐ ppparetopBx̓f[^łB


pppareto<-function(x)
{
	l <- length(x)
	s <- seq(1./(l + 1.), l/(l + 1.), length = l)
	y <-  - log(1. - s)
	plot(y, log(sort(x)), pch = ".", xlab = "quantiles of exponential",
		ylab = "log sorted data")
}

%%%%%%%%%%
% Parfit %
%%%%%%%%%%
R֐ Parfit̓p[gzɂقڂf[^ɓKpƁAΐϊ
ɂp[gzwzɕϊA[U[w肷鐔̏v
pčŏ̌XvZA alpha̐l^ĂB
pppareto g΃[U[p鏇vʂ̐߂ۂ
ƂȂB̊֐𗘗pĐ}4.12쐬B֐̓CvbgƂ
xif[^)Ak(vʂ̐)Aŏ撼tBbg̃vbgƌXvZĂBo͂ alpha̐l(X̋t)ƐؕЂ܂łB
Parfit̗^ĂB


parfit<-function(x, k)
{
l <- length(x)
s <- seq(1/(l + 1), l/(l + 1), length = l)
y <-  - log(1 - s)
plot(y[(l - k + 1):l], log(sort(x)[(l - k + 1):l]), pch ="*", 
    xlab = "quantiles of exponential", ylab = "log sorted data")
coeffs <- lsfit(y[(l - k + 1):l], log(sort(x)[(l - k + 1):l]))$coef
abline(coeffs[1], coeffs[2])
names(coeffs) <- NULL
list(logxl = coeffs[1], alpha = 1/coeffs[2], 
bn = exp(coeffs[1] + log(l) * coeffs[2])) 
}

%%%%%%%%%%%%%%%%%%
% QQvbg %
%%%%%%%%%%%%%%%%%%
4.6.6߂ŐQQł$k$̏vʂɂƂÂalpha
lvZB̗ʂparfitɂX̋tƂ
\łBk̑Iɑ΂銴x(sensitivity)]邽߁A
$k$̊֐ƂĐlvbgAl̈萫𒲂ׂ邱ƂǂB
̍Ƃ qqestɂsƂł邪AʂɂHillvbg
芊炩ȃvbgɂȂB

qqest<-function(y, list = F)
{
        n <- length(y)
        x <-  - log((1.:n))
        z <- rev(sort(log(y)))
        sumx <- cumsum(x)
        sumz <- cumsum(z)
        sumxz <- cumsum(x * z)
        sumxx <- cumsum(x^2.)
        alphainv <- ((1.:n) * sumxz - sumx * sumz)/
	         ((1.:n) * sumxx - (sumx)^2.)
        alpha <- 1./alphainv
        plot((5:n),alpha[5:n],type="l",
                 xlab="number of order statistics",
                 ylab="qq est of alpha",
                 main="QQ estimator")
        if(list) {
                alpha[50.:n]
        }
}


HillvbgƂ̔r qqHillɂȒPɉ\łB

qqHill<-function(x)
{
        par(mfrow = c(1., 2.))
        Hillalpha(x)
        qqest(x)
        par(mfrow = c(1., 1.))
}

%%%%%%%%%%%%%%%%%%%%%%%%%%%
% 11.1.3 ɒl_̐ %
%%%%%%%%%%%%%%%%%%%%%%%%%%%
4.5߂ŋc_悤ɁAɒl_ɊÂʂɂ萞̏dz
̓vfÓłȂƂƂɂLłB
̌oł͓ɓ̕@APickands
(\cite{pickands:1975, drees:1998, dekkers:dehaan:1989, peng:1998})
yѐϗ(moment)(\cite{dekkers:einmahl:dehaan:1989,resnick:starica:1998a,
dekkers:dehaan:1989,dekkers:dehaan:1993,dehaan:ferreira:2006}
of Dekkers, Einmahl and de HaanLłB

%%%%%%%%%%%%%%%%%%
% Pickands %
%%%%%%%%%%%%%%%%%%
4.5߂ŐPickandsvbgR̊֐ Pickandsɂ蓾A
gamma =1/alpha^Ă邪Ax̓Cvbg̃f[^łBB

pickands<-function(x)
{
	ordered <- rev(sort(x))
	n <- length(ordered)
	ordered2k <- ordered[seq(2, (n/4), by = 2)]
	ordered4k <- ordered[seq(4, (n/4), by = 4)]
	l <- length(ordered4k)
	gammak <- (1/log(2)) * log((ordered[1:l] - ordered2k[1:l])/(
		ordered2k[1:l] - ordered4k[1:l]))
	plot(1:length(gammak), gammak, type = "l", xlab = 
		"number of order statistics", ylab = 
		"Pickands estimate of gamma")
}


%%%%%%%%%%%%%%%%%%%%%%
% ϗ(moment) %
%%%%%%%%%%%%%%%%%%%%%%
%ʒuƃXP[ƁAɒlz(\cite{resnick:1987, dehaan:1970,
%leadbetter:lindgren:rootzen:1983, castillo:1988})1ꐔzƂĕ\łA
%$$
% G_\gamma (x) =\exp\{ -(1+\gamma x)^{-\gamma^{-1}} \},
%\quad \gamma \in \mathbb{R},\ 1+\gamma
%x>0.
%$$
%ƂȂB
ϗ(moment) gammaMoment 
(\cite{dekkers:dehaan:1989, dekkers:dehaan:1993,dekkers:einmahl:dehaan:1989})
ɒlz
G_\gamma̋z悩̃_W{ɑ΂ gamma
𐄒肷悤ɍlĂĂBgamma >0ł΁Agamma =1/alpha𐄒肷邱ƂƓłBwzAKzAΐKzAK}z
₻̑̎wIɐmLEƂȂ閧x֐D(G_0)Oxz
$G_0(x)=\exp\{-e^{-x} \},$ $x\in \mathbb{R}$
̋złB
ł镪z̏dzۂ߂ꍇA̐ʂɂ萞dۂ߂̕@ƂȂB$\hat \gamma$ łA[ɔɋ߂΁Ȁdz̓v͂sƂ͋^킵ƂɂȂB
ϗ(moment)ʂ͎
悤ɒ߂B
 $X_1,\dots,X_n$ W{A$X_{(1)}\geq X_{(2)} \geq \dots \geq X_{(n)} $
vʂƂB$r=1,2$ɑ΂
$$
H_{k,n}^{(r)}
=\frac 1k \sum_{i=1}^k \left(\log \frac{X_{(i)}}{X_{(k+1)}}\right)^r
$$
ƂƁA$H_{k,n}^{(1)}$ HillʂƂȂB
\begin{equation}
\gammaMoment_n =H_{k,n}^{(1)} + 1 -
\frac{1/2} {1- \frac{(H_{k,n}^{(1)})^2}{H_{k,n}^{(2)}} }.
\end{equation}
ɂ`B
̂Ƃ$F\in D(G_\gamma)$肷ƁAv
%$$\hat \gamma_n \stackrel{P}{\to} \gamma,$$
%($n \to \infty $ $k/n \to 0$Ƃ).
ɒǉIȉ$k$ɐۂ
$$\sqrt k (\hat \gamma -\gamma ) \Rightarrow N,
$$
Ƃ邪A$N$ ͕0,U
$$
\sigma (\gamma) =\begin{cases}
1+\gamma^2,& \text{ if } \gamma \geq 0,\\ (1-\gamma)^2 (1-2\gamma)
\left(4-8\frac{1-2\gamma}{1-3\gamma}+
\frac{(5-11\gamma)(1-2\gamma)}{(1-3\gamma)(1-4\gamma)} \right),& \text{ if
}\gamma <0. \end{cases} 
$$
̐KzłB gamma > 0̂ƂAϗ
QߕUHillʂ̑QߕU傫̂ŁAQߕŮϓ_͂̕@𗘗p闝R͂ȂBȂAϗʂHillʂyʂ
̂ŁAgamma leq 0ۂȀdz͂̕Ół邩ׂۂ
LpƂȂB
ϗʂ͗pʏvʂ̐̊֐ƂăvbgłB
HillvbgPicklandsvbgƔr\ƂȂ邪ARvO
f[^CvbgƂĂ̌vZsĂBo͂͐ɗpʏvʂk̊֐Ƃ gamma̐lvbgĂB
 gamma>0Ȃ gamma =1/\alphał.

moment<-function(x)
{
	ordered <- rev(sort(x))
	ordered <- ordered[ordered[] > 0]
	n <- length(ordered)
	loggs <- log(ordered)
	sqloggs <- ((loggs)^2)
	hill <- cumsum(loggs[1:(n - 1)])/(1:(n - 1)) - loggs[2:n]
	one <- cumsum(sqloggs[1:(n - 1)])/(1:(n - 1))
	two <- (2 * loggs[2:n] * cumsum(loggs[1:(n - 1)]))/(1:(n - 
		1))
	three <- sqloggs[2:n]
	square <- one - two + three
	gammahat <- hill[2:(n - 1)] + 1 - (0.5)/(1 - ((hill[2:(n - 
		1)])^2)/square[2:(n - 1)])
	plot(5:length(gammahat), gammahat[5:length(gammahat)],
                type = "l",
                xlab = "number of order statistics",
                ylab = "Moment estimate of gamma",
                main= "Moment")
}

̃vbgsmooHillalphaƓlɕ(smoothed)邱ƂłB
Ⴆ\cite{resnick:starica:1998a}QƂꂽ. 


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% 11.2 ̕ (heavy tails) %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
f[^͎͂ӕz̕ꐔ肷邽߂1͂܂łB]\
͕W`ɕϊɊpx\index{angular measure}𐄒肷邱ƂŎsB

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% pz(angular distribution)̐ %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
x $\nu_*$𓾂邽߂ɕW`ɕϊɁApz$S$ 𐄒A
邢$S$ x֐ƂĖx֐sB


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% ʕϊ (Rank transform) %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
ʁX̃Tu[`AƂāA9.2.3(@y[W)̕ϊs
vOłB(9.45)k͏ȗĂB


ranktransform<-function (x)
{
tr<-(length(x)-rank(x)+1)^(-1)
#invisible(list(tr=tr))
}


%%%%%%%%%%%%%%%%%%%%%%%%%%
% ʂɂpx̐ %
%%%%%%%%%%%%%%%%%%%%%%%%%%
px𐄒肷邽߂ɓ̃vO(routines)ĂBŏ
vOł̓NϊłmƂ$L_2$-mpĂB

angulardensityrank<-function(x, y, k) 
{
	#x <- x-vector
	#y <- y-vextor
	#k <- no of upper order statistics to be used
	n <- min(length(x), length(y))
	rx <- n - rank(x[1:n])+1 #compute anti ranks
	ry <- n - rank(y[1:n])+1
	theta <- atan2(rx, ry)
	rad <- k * sqrt((rx)^(-2) + (ry)^(-2))
	plot(density(theta[rad > 1]), type = "b", 
             xlab = "theta", ylab = "angular measure density")  
	abline(v = pi/4.)
}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% xLϊppx (power transforms) %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
̃vOł͕W`9.2.3(  y[W)ɂ邽߂Ɋevf̃xLϊ@
𗘗pĂBCvbg()2f[^xNgA$k$̑IA$\alpha$
lłB

angulardensityEstAlpha<-function(x, y, k, alpha1, alpha2)
{
	n <- min(length(x), length(y))
	x <- (x/(rev(sort(x)))[k])^(alpha1)
	y <- (y/(rev(sort(y)))[k])^(alpha2)
	r <- sqrt(x^2. + y^2.)
	theta <- atan(x, y)
	plot(density(theta[r > 1.]), type = "b", 
		xlab = "theta", ylab = "angular measure density") 
	abline(v = pi/4.)
}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% ʕϊppx (rank transform) %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
x݂̑^킵΁Az֐Ƃ $S[0,\theta]$̐肪\łB

angularDF<-function(x, y, k)
{
	#x <- x-vector
	#y <- y-vector
	#k <- no of upper order statistics to be used
	if((n <- length(x)) != length(y)) {
		stop("The lengths of the data vectors do not match")
	}
	rx <- n - rank(x)
	ry <- n - rank(y)
	theta <- atan2(rx, ry)
	ord <- order(theta)
	l <- rx[ord] < k | ry[ord] < k
	stheta <- theta[ord]
	cl <- cumsum(l)
	sl <- sum(l)
	plot(stheta[l], cl[l]/sl, xlim = c(0., pi/2.), 
	        ylim = c(0., 1.), type = "l",
		xlab = "theta\n\t\t", ylab = "S(theta)", 
		main = "Spectral Distribution Function", 
		sub = paste(
		"number of upper order statistics used", 
			as.character(k)), font.sub = 3.) 
	abline(h = 0.5, lty = 3.)
	points(stheta[l], rep(0.5, sl), pch = "+")
}


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% X^bc(Starica)vbg %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
ɂSplus֐͕z$F$̐WIȐϓꍇA񎟌
xNg$(\bx, \by) = \{(x_i, y_i), 1 \leq i \leq n\}$߂A
xLϊɂW`ɕϊ(9.2.3, y[W)āApxxNgvZA
炩ߒ߂Ă$k$ɑ΂ăX^bc(\Starica)vbgvZB
vbg(1,1)ʂ悤ɉEc𒲐A10ȉɐĂB
̕@ɂĂ\9.2.4߂ɐ邪Ap҂$L_1$ $L_2$
m𗘗płB

%%%%%%%%%%
% m %
%%%%%%%%%%

L1norm<-function (x) 
{
    sum(x)
}

L2norm<-function (x) 
{
    sqrt(sum(x^2))
}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% xLϊ𗘗pX^bc(Starica)vbg %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

Starica2dPlot<-function (x, y, k, PlotIt = TRUE, norm = L1norm) 
{
    if (length(x) != length(y)) {
        stop("x and y different lengths\n")
    }
    n <- length(x)
    alpha1 <- 1/EstimateEtaHills(k = k, data = x)
    alpha2 <- 1/EstimateEtaHills(k = k, data = y)
    x <- (x/rev(sort(x))[k])^(alpha1)
    y <- (y/rev(sort(y))[k])^(alpha2)
    r <- apply(cbind(x, y), 1, norm)
    u <- rev(sort(r))
    ratio <- (u * (0:(n - 1)))/(length(r[r > 1]))
    if (PlotIt) {
        plot(u[u < 10], ratio[u < 10], xlim = c(0.1, 10), 
	    type = "l", 
            xlab = "scaling constant", ylab = "scaling ratio", 
            col = "blue")
        abline(h = 1, col = "red")
        abline(v = 1, lty = 2, lwd = 0.5, col = "red")
        title(paste("k =", k))
    }
    invisible(list(r = u, ratio = ratio, k = k, norm = norm))
}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% ʕϊ𗘗pX^bc(Starica)vbg %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
̊֐̓N@𗘗pĂBCvbgƂē񎟌f[^ (x,y)
 k̒lAo͂\Starica vbgłB

Starica2dplotrank<-function (x, y, k, PlotIt=TRUE,
         norm=L1norm) 
{
    if (length(x) != length(y)) {
        stop("x and y different lengths\n")
    }
    n <- length(x)
rx<-ranktransform(x)
ry<-ranktransform(y)
R <- apply(cbind(k*rx, k*ry), 1, norm)
u <- rev(sort(R))
    ratio <- (u * (1:n))/(length(R[R > 1]))
    if (PlotIt) {
        plot(u[u < 5], ratio[u < 5], xlim = c(0.1, 5), 
	    type = "l", 
            xlab = "scaling constant", ylab = "scaling ratio", 
            col = "blue")
        abline(h = 1, col = "red")
        abline(v = 1, lty = 2, lwd = 0.5, col = "red")
        title(paste("k =", k))
    }
    invisible(list(r = u, ratio = ratio, k = k, norm = norm))
}


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% X^bc(Starica)vbgɂk̑I %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
̃vO̓NϊsAe_牡ւ̋vZĂB
e$k$ɂČJԂAŏɂ$k$IԁB̓l
(Lower,Upper)̋vZBAX͏肭炩
sK؂$k$^Ă܂ƂB

ChooseKrank<-function (x, y, PlotIt = TRUE,  norm = L2norm, 
Lower,Upper)
{
    if (length(x) != length(y)) {
        stop("x and y different lengths\n")
    }
    n <- length(x)
rx<-ranktransform(x)
ry<-ranktransform(y)
R<-apply(cbind(rx,ry),1,norm) #norms of pairs 
                              #after rank transform
R <- rev(sort(R)) #ordered norms; biggest first
nk <- min(c(500, ceiling(.5*n)))
Kseq <- (1:nk) #round(exp(seq(log(10), log(n/2), len = nk)))
dist<-rep(0,nk) #vector of length nk of zeros
for (i in 1:nk) {
dist[i]<-L2norm(       
(  i*(1:n)*R/length(i*R[i*R>=1])  )*(i*R>Lower & i*R <=Upper)-
(i*R>Lower & i*R <=Upper) 
)
}
 k <- (Kseq[dist == min(dist)])
if (PlotIt) {
 u <- k*R
  ratio <- k*R*(1:n)/length(k*R[k*R>=1])
 plot(u[u <= Upper & u>Lower], ratio[u <= Upper & u>Lower], 
	type = "l", xlab = "scaling constant", ylab = "scaling ratio",
	col="blue")
    abline(h = 1,col="red")
    abline(v = 1,lty=2,lwd=0.5,col="red")
    title(paste("k =",k))
  }
k
}



