R/edrGraphicalTools-internal.R

.Random.seed <-
c(403L, 10L, 261025702L, 289862591L, -2032470099L, -969345675L, 
218922824L, 898421253L, 1088880458L, 2095178249L, 1915537138L, 
-34262436L, -2074149849L, 1587168077L, 1094533438L, -1260011689L, 
-367402728L, -1240988856L, -421147579L, -2082217909L, -809577010L, 
-1826560611L, 2087409956L, -1512009195L, -1257746814L, -157513453L, 
-1117918508L, 1597413543L, 1180028768L, 676026176L, -2114638982L, 
529416193L, -1181795057L, -403222518L, -1374591430L, 944760013L, 
371533789L, -1303540560L, -1413658872L, -1903551180L, -1318210820L, 
558094398L, 1673309494L, 1461374600L, -1664336743L, -728560658L, 
-1807106109L, -982934567L, 15010142L, 113524255L, -374658264L, 
1111428413L, 908625695L, -1682973429L, -1284143718L, -391356361L, 
1062170516L, 1572187698L, -1777462488L, 707701797L, -1368028324L, 
-2131925080L, -699137996L, 1341212723L, -2060111865L, -1125483534L, 
-692588359L, -387141549L, -1352739619L, 1552202296L, -337783339L, 
-425077555L, -1761486664L, -695854673L, 1675531616L, 1513410786L, 
-398160183L, -402091917L, -343709212L, -269232436L, 337816123L, 
529389161L, -70058520L, 1572190979L, 1443539110L, 1862438069L, 
2014994504L, -793841917L, 2016879305L, 1480762345L, -953403303L, 
680052484L, 201925213L, -2064372169L, 219034283L, -958932294L, 
899655185L, 807568787L, 91224045L, 133779057L, -1921129766L, 
1977589552L, 1816062277L, 1616791381L, -1436105036L, -1184723457L, 
-1716626056L, 1150494427L, -74395870L, -1837031774L, -1707016035L, 
-2014617057L, -1365619616L, -1386740873L, -273409481L, -2006890362L, 
-295422264L, -203990583L, -93423597L, 897981577L, -1077955042L, 
2119044314L, 1729646099L, -65004110L, -1463172432L, -2090314586L, 
1128254326L, 909625403L, 1164068300L, 2034557123L, -948775992L, 
489501383L, 1528810370L, -1130187903L, -1497614745L, 1657048383L, 
-974688462L, 788119424L, -587324742L, -1352424135L, -1874002628L, 
-1407246182L, -7470164L, 1593883313L, -646054197L, 1740268991L, 
-331084171L, 2021716429L, -479199966L, -259423041L, -1554644022L, 
-1543128453L, -777695074L, -1237159429L, 546685084L, 1389916042L, 
-1373162946L, 1378751538L, 472369967L, 111997210L, 805713742L, 
-1977980759L, 1159807352L, 865543618L, -2077486621L, 725262687L, 
611507712L, -2066352787L, -752971650L, -428317913L, -1350429924L, 
1802569525L, -1602251750L, 249676863L, -571345536L, 224095408L, 
-503276979L, -687511465L, -1131730149L, 1251368577L, -706775298L, 
1088008131L, -297626253L, -326993689L, 867415813L, 318957619L, 
373255611L, 1232203885L, 1474053096L, -793904327L, -1976396151L, 
-1668187968L, 1325532606L, 1149047268L, -107557281L, -467459437L, 
-1673078997L, -21416486L, 660597683L, 1369253547L, 933166695L, 
1921750321L, -1607106047L, 1608620602L, 1456655223L, 534131766L, 
-1442253969L, -860627815L, 1684219997L, 1492988429L, 587824389L, 
848526437L, 115122461L, 1078697284L, 1248725981L, 923294768L, 
974946524L, 1982198071L, 130699278L, -1564433822L, -1886817806L, 
-1152486349L, 631706925L, 37717561L, 750425936L, -211366132L, 
-1650784797L, 1306370729L, 1886914609L, 377534699L, -365196542L, 
-523555386L, -920005016L, -1783210185L, 2085667431L, -313268634L, 
621641753L, 1722606910L, 456227837L, -502548382L, 2047068645L, 
-2064386824L, -655443047L, -1109290241L, -254983324L, 1387459483L, 
1769513021L, -548734941L, 1416415904L, 662793649L, -548359525L, 
396371446L, 1827045276L, 1937750481L, -954889574L, -252960853L, 
1454065210L, 1925964437L, -394565711L, 1501465503L, 1980107160L, 
-564788151L, 27748900L, 1417239627L, 547068971L, 203444082L, 
-1541036661L, 677397324L, 764319518L, 1147756195L, 1153442147L, 
797002705L, -424495262L, 2034201016L, 2137691802L, -1807866803L, 
-1787757243L, -977100844L, -557408812L, 932773001L, 1196804144L, 
1354024465L, 1272287745L, -1883139472L, 1211460201L, -1335434651L, 
-249256480L, -280069764L, 312236898L, -185359290L, -881609556L, 
-796230350L, -1848426347L, 38764728L, -1307585322L, -1854026157L, 
-1264759564L, -1297021516L, 841722296L, -891093250L, 1787357879L, 
-1056488416L, -1850678488L, -102453987L, -1596995964L, 824859006L, 
-2008516832L, 28306493L, 908399607L, -497619325L, 294123294L, 
1665306482L, -1828708456L, -694566450L, 1817010388L, -1268708095L, 
-1899121055L, 23401279L, -667258059L, 940777761L, 1085098445L, 
1478325683L, 490973309L, 1576735715L, -835672086L, -1640804511L, 
185682679L, -1498629076L, -205656326L, 1727043388L, 864559491L, 
1626730708L, 2017909586L, -920071906L, -458505001L, -576197549L, 
-1275856239L, 301080158L, -1268613688L, -893760882L, 1872141773L, 
1560017693L, 1222543704L, -866963776L, -109996280L, -1436862077L, 
-204995528L, -1835874368L, 2058016381L, -838318912L, 2024339548L, 
1314096955L, 522957151L, 1883613811L, 1172445869L, 1992090669L, 
-325427245L, 560639117L, -1769650889L, -13194113L, -963298782L, 
-1132717360L, -1169031183L, 1280728342L, 2084697567L, -794310211L, 
-183767548L, -924932978L, -816603685L, -489280219L, -359537314L, 
-1467697027L, -1923875999L, -130105058L, 1988390951L, -524121095L, 
70270725L, 1341870218L, -1438369346L, -1935495626L, 1650477738L, 
-926560915L, 1279859935L, 1357846L, 1417516730L, -690247353L, 
1711351506L, 1841764686L, 1189905562L, 1971020134L, 1356223045L, 
-1335790407L, 889627645L, 416069972L, -1716174196L, 1172636800L, 
124356321L, 1571117712L, 1732628206L, 820532347L, 825669380L, 
669186749L, -575652433L, -522171824L, -1116733920L, -1604781852L, 
2099509575L, 370201329L, -851761350L, 314312112L, -417132323L, 
590956564L, 1395233608L, 636919143L, -788437744L, -1542939006L, 
312760646L, -546048085L, 5253699L, 2137640562L, 373435597L, 411452784L, 
1940791187L, 35716524L, -700173054L, -1243186307L, -783643557L, 
1969580004L, -835514357L, 1787153078L, -649930879L, -1769606318L, 
-319049330L, -1526099419L, -487910242L, 1433148020L, -1019072440L, 
1646247031L, -1305182466L, 1454259460L, 968010255L, -987831854L, 
1047843983L, -925241415L, -1916153184L, 361853585L, -1340481581L, 
1902090398L, -1395096751L, -1179234623L, 1808183993L, -1956554204L, 
553118532L, -422857180L, 848904050L, 788786135L, -1382130726L, 
-468976041L, -1336838805L, -36659333L, 1930449939L, 1218169994L, 
1866179137L, 222744263L, 1550034081L, -159922508L, 441577041L, 
-1247153796L, 2084235290L, 1561567358L, -720069644L, -1033278254L, 
-585333614L, -676843165L, 1870300146L, -15192235L, -307973132L, 
1875124043L, -1681495003L, -1386096102L, 1732145691L, 16873648L, 
-1453112375L, -508928882L, -395482355L, -84369978L, -2079094290L, 
-1740978697L, -1254223946L, 1605479631L, -1486697262L, 1905741497L, 
-749729229L, 1080543012L, 58082979L, -1059624254L, 380290295L, 
1088946085L, 681578037L, 1904745722L, -68812145L, 26997511L, 
-1917953821L, -648827076L, 1891926291L, 1319740729L, -1219611526L, 
-1201570193L, -2138183842L, -496026893L, -210747666L, -821195965L, 
1734912420L, 1702637819L, -1116604370L, 606308735L, 1601682909L, 
2059468683L, -763440114L, -1183374448L, -1060614220L, -1516211268L, 
2090637109L, -1629246520L, -1696439648L, 1002050500L, -1677289250L, 
-516840213L, 1516942276L, 134165525L, -2032347971L, -1860414033L, 
-1667717866L, -2026549490L, 474977498L, 807347543L, -1943473233L, 
-737597275L, -895065416L, -2142232704L, 604883446L, 148932989L, 
-246439021L, 1040582259L, 880563067L, -406313219L, 1982029143L, 
-1343213419L, 1213459294L, 1338024357L, -220540365L, -2131457744L, 
-1944103253L, 692878522L, 518663933L, -1939852884L, 1513810648L, 
-1607341010L, 813773465L, 1066836799L, -1337970350L, 824899494L, 
2234648L, 1973390706L, -516213377L, 406510569L, -93177253L, -1353887474L, 
-560013807L, -1391577198L, 457924772L, -355146330L, 1974491208L, 
-99037008L, -1479144692L, 1738682737L, 1735829900L, -1443382826L, 
-235352617L, 349168941L, 1085835171L, -455847728L, -316957299L, 
-1134729150L, -1737469692L, 1673607014L, -1849362253L, -1350609127L, 
1611447514L, -706395178L, 4693765L, -1081553568L, 243912221L, 
-1525690300L, 1375649083L, 604927988L, -1428393253L, 1913900167L, 
1641995238L, -580119972L, -345651381L, -822455605L, -1158095513L, 
1613424776L, 1793219292L, 2109790764L, 446197814L, 939223572L, 
756177463L, -1703504500L, 780260928L, -1396308957L, -1175344883L, 
192310717L, -1167578569L, 279121769L, -1803170571L, -898908176L, 
-861970050L, 885932108L, -1723642835L, -1197409083L, 989509206L, 
1530831801L, 44490977L, 545438013L)
.required <-
c("rgl", "mvtnorm")

#Vérifie que les variables nécessaires à l'exécution d'une méthode de réduction
#de dimension sont correctement entrées
.check.param <- function(Y, X, H, K, method){

	if(!is.matrix(X) | any(dim(X) == 1)) {
		stop("X should be a matrix with at least 2 rows and 2 columns.")
	}
	if(all(!is.vector(Y),  dim(Y)[2]!=1)){
		stop("Y should be a vector or a matrix with a single column.")
	}
	if((any(is.na(X))==T)|(any(is.na(Y))==T))
		stop("The data should not contained missing value")
	if(length(Y)!=dim(X)[1]) 
		stop("Y and X should have the same number of row")
	n<-length(Y)
	p<-ncol(X)
	if(missing(H))
		stop("The number of slices should be specified")
	if(missing(K))
		stop("The dimension of the reduction should be specified ")
	if(missing(method))
		stop("the method should be specified")
	if(!(method %in% c("SIR-I","SIR-II","SAVE")))
		stop("the method should be specified by SIR-I or SIR-II or SAVE")
	
	list(n=n,p=p)
}

# R implementation of the DGGEV LAPACK function 
# See http://www.netlib.org/lapack/double/dggev.f
# Raphaël Coudret, 8 juin 2013
# Contributions from Jonathan A. Greenberg and Berend Hasselman.
.Rdggev <- function(A,B,jobVL=FALSE,jobVR=TRUE) {
  
 
	#Testing imputs
	if(!is.matrix(A)) stop("Argument A should be a matrix.")
  if(!is.matrix(B)) stop("Argument B should be a matrix.")
	p <- nrow(A)
  if(diff(dim(A)) != 0) stop("A must be a square matrix.")
  if(diff(dim(B)) != 0) stop("B must be a square matrix.")
  if(p!=nrow(B)) stop("A and B must have the same dimensions.")
  if( is.complex(A) ) stop("A may not be complex.")
  if( is.complex(B) ) stop("B may not be complex.")
 
	result <- .Call("Cdggev", A, B, jobVL, jobVR, PACKAGE="edrGraphicalTools")
	if (jobVL) {
		result$vl <- matrix(result$vl, nrow=p)
	}
	if (jobVR) {
		result$vr <- matrix(result$vr, nrow=p)
	}

	# simplistic calculation of eigenvalues 
	#(see caveat in http://www.netlib.org/lapack/double/dggev.f)
  if( all(result$alphai==0) ) {
    result$lambda <- result$alphar/result$beta
  } else { 
    result$lambda <- complex(real=result$alphar, 
			imaginary=result$alphai)/result$beta
  }
  return(result)
}

#Calcul des directions EDR pour une matrice de variance-covariance Sigma donnée
#et les normalise à la manière de Zhong et al.
.edrNorm <- function(M, Sigma, K) {
	
	tol <- 1e-6		

	temp <- .Rdggev(M, Sigma)
	index <- sort(temp$lambda, index.return=TRUE, decreasing=TRUE)$ix
	#Dans la version initiale de P. Zeng, on avait l'équivalent de
	# matEDR <- temp$vr[,index[1:p]]
	#Toutefois Rdggev ne renvoie pas toujours p vecteurs propres.
	matEDR <- as.matrix(temp$vr[,index[1:K]])
	normalize <- t(matEDR) %*% Sigma %*% matEDR
	normalize <- diag(as.matrix(normalize))
	cache <- abs(normalize) < tol
	normalize[!cache] <- 1/normalize[!cache]
	normalize <- diag(sqrt(normalize[!cache]),sum(!cache))
	matEDR[,!cache] <- matEDR[,!cache] %*% normalize
	eigVal <- temp$lambda[index[1:K]]		

	list(matEDR=matEDR, eigVal=eigVal)
}

Try the edrGraphicalTools package in your browser

Any scripts or data that you put into this service are public.

edrGraphicalTools documentation built on May 2, 2019, 3:44 a.m.