GPArotation/0000755000176000001440000000000012435031140012462 5ustar ripleyusersGPArotation/inst/0000755000176000001440000000000012267353521013454 5ustar ripleyusersGPArotation/inst/CITATION0000644000176000001440000000145212267353521014613 0ustar ripleyuserscitHeader("To cite package 'GPArotation' in publications use:") citEntry(entry="article", author = personList(as.person("Coen A. Bernaards"), as.person("Robert I.Jennrich")), year = 2005, title = "Gradient Projection Algorithms and Software for Arbitrary Rotation Criteria in Factor Analysis", journal = "Educational and Psychological Measurement", volume = "65", pages = "676--696", textVersion = paste("Bernaards, Coen A. and Jennrich, Robert I. (2005) ", "Gradient Projection Algorithms and Software for Arbitrary", "Rotation Criteria in Factor Analysis, ", "Educational and Psychological Measurement: 65, 676-696. ", "", sep="") ) GPArotation/inst/doc/0000755000176000001440000000000012434664410014217 5ustar ripleyusersGPArotation/inst/doc/Guide.Stex0000644000176000001440000000224412434664410016123 0ustar ripleyusers\documentclass[english]{article} \begin{document} %\VignetteIndexEntry{gpa Guide} \SweaveOpts{eval=TRUE,echo=TRUE,results=hide,fig=FALSE} \begin{Scode}{echo=FALSE,results=hide} options(continue=" ") \end{Scode} \section{GPArotation Functions} In R, the functions in this package are made available with \begin{Scode} library("GPArotation") \end{Scode} The most complete reference for the software is: Bernaards, C.A. and Jennrich, R.I. (in press) Gradient Projection Algorithms and Software for Arbitrary Rotation Criteria in Factor Analysis. Educational and Psychological Measurement. Addition material is also available at . Rotations are computed using the Gradient Projection Algorithm code, which can be called directly. Examples of this are available in the help pages for \emph{GPForth} and \emph{GPFoblq}. In R it may be most convenient to pass the rotation name to the factanal program. An example of this is \begin{Scode} data(ability.cov) z <- factanal(factors = 2, covmat = ability.cov, rotation="oblimin") loadings(z) \end{Scode} Other examples are available in the help page for \emph{rotations}. \end{document} GPArotation/inst/doc/Guide.pdf0000644000176000001440000016433012434664410015756 0ustar ripleyusers%PDF-1.5 % 3 0 obj << /Length 1220 /Filter /FlateDecode >> stream xڕWK60zZ6wb]l}Kz%W8,k,zEmM ꧼ riO4Ô|y#3G_l  4!@m=Y)h?B]߄fY #}p\[qɱb {E >q;0ƺK3J3cP"iu ś$%A?TLX&&Hԫ52 &"\\bI?mfw7]8(0!ȱrDϕD~e t IuKf^(*qW&4u¤_+ɄC,\ZnY#, {|*]vk~Qȅ٤+R+R> stream xڍP6 ҍtt7ݹ, , 4HtwJ7")%-3suu>3@.ihssspUy\\\\< W{_vt]0W4 t}]UE7{7/[@[P %W#L tXT8P : bm_&3[XXw:@ P "hrA^)$j$tppY3< 6M  P:ƁжrrG=.@w0` ,(?`? #Gq~=<*jO#TВgN))GO;?/+ o:rA{qSL 3+:> `G\\!_Uɹ3 ^F܏Cj m'1H`CuN_H )p}#aA'$ B܏DzC{_n>'_˿_qnroߺ}l_{A 硶աWcb6R}`mn?Q+2W`IݸKL/|jQ"jޚ%hNnOߓD`~{dߡȐ&I޳HVm{ki\w3$Ȯ씨,xG8X~^x-q$'5$D8|#H921RRdvxƮeITp?dd}{12qڡA$0W>M)M2N<FDZOB!`hua7XǚsQp~[KgbxMOCIwPuk")6ҴĉKWJze F{Wlsa7Jؾ JU7,MqLԀBnstiIC#5Rg471o/T/ iqq:(˪*떳"GZ$2S(y ?TG-[ ZʥSך1Ḁx=op.QC{;F*D]CiEd ̃\m˂Yn„R `3A!Hw:zQĚYKtA[äBv6?̐[%+ͺ ~B4lK p6NF?\9T$[e9sH|+a3q~r/đRSQ6Q޶R y蠲*#]=%g{_nq^G)޲?30q|6;Y(tr UkC:dz7*YǃeQuuCxxd:dz+fkb6fL}^W(LdĖy|%H-4qGȕTpMs Hj3nYGE ()/oj kϯKZ,ӸߏpXӰ-bkړ4bgױhS?rf]x5X ~i Y 1Te櫴eUs7{O64ɑ^Hm>SOxy 3)p}IxEOH6?쓓&.6;ZKPLi ckcඑsFC!*ǻYi.7 KmJ6INyӲ/O5O+Pb{*Yh6Ȯؖ؏aA9jhwTl_ISu8oi#û&yώ1grޑu-*>?Rd5v@P$ #ŏuEVLuvl<|$q@b~#8p+S,Q.s)?Xʸib jAn=e 7̪3^+B2SJ5W^,Z~y]`<Cu(6wM /,njcbf_$D 01] kܔ͓UKi?c \n| *99nL!NADDJ ` NONeCۂnmPG ! A^2*O_iĴμYG$m,2n)}*06߰ =bYߧ|M0u DRzZרü 6 'j)HhᴐD eP`[zAD+СL?m!04u@qZΞHqge`D*N7VZo|u eDWڊF"Hcda[%"UUY*U VVrӜp#c#fQ%u&mHˉi0{;{D*?f2<&'TNss`A1巌 §%K~ی鋹qNS'qS99ˁKrW*j2.͵?B|PnڴxuIU]VboNpBm^|c[;ފ ;uUJY}n{'gL HgTQ?c ĭ5~>GcvP6HۂgJ/pYA!ߊv?Sd½*jpiH/;_~Jy}m6D;:Z0ތ%ղUhnrarZLur:qzՖEѼWH-.w*0?(`"a͠בLz&׹)|,@G9{A7s14V@mvEfRҸbmc&<*R8V4_Jނ`9GT @HKK)V^s]XrC֯/ӿ_LCv=,t2 g##>0.lyKL/-lngf˵/Yhoҍj9S|ښԾW0/jt.qpntYO y9Wox葁{W'=5t٩'?Zb)qq/t5AxV[* ]P)ݣk %G9.Kx Y҇e+>yӑR7L>="Kiu&`ņy aPЌaU +X^@>:>jw;l@"/|쾉D `9YllKH$YA$!d\5c:j}p'=KڛotXד>u~Qbt3x"YN IcL.Ѿycjg/]}Ӽ@qO<כT#PM* $?5tn/^(Ȗ` )5)Nf>dûf$M8lF~KXTyX~l oB?a`ӗcdU/8A BA|vi#x(7{GXdcf~~K%&"eðrOl %oC*q&5_pXiH}D߀T eOƟRwlPjȖ} `Ef~tp3r2vb7ƤKxLY[b egIc8)zhoU-E^YPQP1OiOO("HTB FVT'g^S޵n@ϿM.f: Tŝ.fFZuG^v zy@GsZzveGYFna}S k܉VCS #V(7y΍Mk/07l+*PY+L"My IJZ +0wJQ"&KєJ*Fn3Ir\utHlsZm04kנ4,!'BQK8nfᄃscR?;`AW5}V{~0U\G!oIrT[\\Vv&rdOL.G:g҈6̓FڹOpL25G( p?c!Zmר˿% bcGIoNw E^ 6^vl މi/3OvɾѮGjMEe 7ԕB[@EKG@rOL-Uy=r(qtTI3&&3ŒSbxYKlۡ[,mQ~H iہv< ve#RIx 0;;|K/2 C( _TEHGWa .T\5lnPD=]Q'ylFX|Z%.]҂x\S$XIhǦh& VUnѲ ]ːDrʂi;رB(llq{Yd[QgIpA؋U2qC'OjaIA8}VvM:o\Md-kifYVxY|# N$3PU]p:Ij w2@f@Zi1*Exxlo[D5gjݝU 6T퀥A|yl\U~XXl'^_XFN&w:*ѲאgeE8REU I3VJ;@܁wC]#3υ};t| X˪=[D., ^&) q cIZ9Y=@KB}VvPL*\#/ kr oaE@@.iآ\χM1`(. {yU5@Bkd#e:F]*{iV(u"_ c?3Qi~ p~n=u#otLQ(@S@촚u"Rדauԓ(FHχ$_PM@prwFG LV<]#GNZ&|'4?layiQmhCRPGyj+!4 :oMVo;MVªv<^6(%5L,a#Ϫ֛ɛwվe59Nf;3Q`M;c0!tJOEaVJW15'l }FԎHɏs>1ʠǵ'TdSbVICpФD5l`>KOɺA9]i>\ÔҨJwkү)M ָ|3)y;+kJZS SN$x ,M)!ɔ=vq ZNVlg \qm_Yoݏw&JeIXbH{b{ ob]o 8! xz5iy O~ۜůnTvI[E:R%o0ŸT^Ѷ&p6qb=SAfB<t<7w{\f,7^zA{OMH؝aҜ4x|akHj;))"J\JB1e`pxMx%C&Ę mAXy7ܳ~j._t#]\8poUbR^KbaSWpae?=b{-mYzЃ(۫{vn ou,!TW1-'# W_M8fUy*R]z]4ATqwNhΣe׀*Mt)t Wum敢\f^!tS1whqxCᫀT>zQ! \$~9q9[Hq10r>ܵg]eߙt}mrC=i $oE6 =9'', 'Ho6pYLF3]^? xlIF%ߵ}]3 I@NUN`P10+YqsH 7Be8R\hiqT]0T I AW}WBq )+)k/V#&YVĶ\3->g7$R1T8AG\Q1##$XP) S͛p*RY/gb\'-V+% ~ #R$ X XV< B0'CɌޠHP åǠvHSFT#JFfp=H/JK+<;m*{v\]; HS];f+Z;3P} }}]љafc0ݔCtwNYbR0-basuiܤ^R ^r.\(SNCs6Vx,f .3ۑ 8O>tt? Pؗ4':`2C} j{Ůπ'8A ɝہ-kR HusELDY><ͷ<[݋nY<6'u=бJ;w%Ki{?}{y׵rOeѻS7s }?U|^OE.8yׇ?olM~tFD+PTYNo]՜98㎡%8WJ(juL!:V|//kkV޽XW-*-][OPXMQ_|t_ڎݧl*x JԱ="8tE:8oM7|1j9/O֩nZPV_PxbR*x櫯44ƵF9zoG!c9yAgPnxaT(R-%umLjP;xM2e${STTwrشO.ͦY`P###9@o~8˅ >kձQ^ Oײ2JʒWF*sT&s\w0! WA_$*ѵb}ʺ.b}c&`BR/Eоw㶭cC(s'}גr~M,=jUFQ n7Ne3Vw".] aO&gLBWXjD{=z-@|>#BdϺa F^2]i5jyhgҲ:l nxW<*ܠ30mD/pvDˀUrlCh) ^3O/bL8CZ*[ih>A qT5!9mq3"qGk̍_:]86C3>x̄2e? ]ҢiKF/s2! z܉&,wUh(ӛeBUaAor}S $&JzJQ^,'yO'jؖ3v7>42UZ]G`ҳ $b0l7H'"s3/QHAg~C6f W~pXT沝O8uy')`󗖊LScba]xCT?Mgփ{sl%n=? v! endstream endobj 18 0 obj << /Length1 1438 /Length2 6052 /Length3 0 /Length 7022 /Filter /FlateDecode >> stream xڍwT}?RPIf*p)c m#TRDBR@ABBExz?s?9{v|=q޼kįh!X~H A aHi Ǻ8Mah e4 T X.z  bR`q)(IDKU p{P aH7 %% *p(ԅ``nP+ ðH-Ţ=== n$Qu00xq&;1 FH' p( <@@|uPCvpp`HG @H7 G80 {A_8B\1H|<w~)!xah8 ]/0 ^*^C`1Thނ@z"|{ P& o# I Ka@I𢀱7 P1(|0~O?% C@;#wv[ ZA=YfDz׈U2_F%%Ї_X/$ A"@q?FK{dD8 %.Po$gox,7-A ( ނ_!?_d_=pue!npW?xB?C_~o.X~IxE@"p f:&p#`wŃˆ= rgk2 jCE_줐FCxJ%Q0_ X|D.-&tǀ7ցM\(Q Ʒ&V]0 @B[+=WdHͅ ɰݪ6 FYS&jmzJ9sv|kkE&/'ܚl$xb&U&EN.omIWuDO.5qʒ,zI/ Mv}+ ~r ZH˸-zHZb x#K*Ǣ"rt鵟4>v /yR7nr';&9DXQ3tJiH0v^ig:\\'VmΑS5-{&Ȟ.|JWe *}φC}q3! 4csjarku{/=imUrBDjf|3 oBӫqn^V:nB2\ׅԏR@gm1 ʦJ J^ҿA . 97=S)ָiz0h_>@^iq!夨ԝcPXޙ i>4.cr;pqӐ6WGm`i觯ye>:\~lɥourS˵y =3al-6yD+Kk~ya)Aͷݱ ~4#I<Fc7hd0B-ATWbMC|cJ+)!W@C~OP7?8ыED^T)3صE^Ph'C] KT*u7)NNzw*ӆr?4F68.%H7bTdbn`>>i܋!yEϑy+ӎ&wE+]{mݹ+ۅbYq_lT(}wfY7q4yU59wgJ&( ҇u.5 (ӟ!GqGEC 1hȯi-6!G.<8Ǹ&sU]y3ZrT#y`=X  :˩TT4n׉k?|oZ s=6`CygvLzzbBg"!CV Uf\S^9W2S{B]$t楍a5\GQkGAmB"b^ yހjOG5v.?Uy#;Kʯ6zFd]ǃ!ߜcH툔gAtH I;k(KKC/ǮWU .$au]/2V# r 47GXmxTa@EU^TzQyۦY[!P'kCת wʣAD^D4|&ȳhɖO9J"UgD _^ĢI(7F9 S F}jTN} Pg?Yal ɾ͉U"ߕO]Z^6.f+wU)PkCv;0rq 3nɽYzҷHGJZQ-Ջ$˭|5+ ԾM]q`vYJ؀3"Nc1fˏ;JS2+w9PDe=랝>x@xNq+{!~O*+>pXҕtR'̭ç|RaSeidxrSr>OPӈq#1W LR7\gr8\n*KH3k]/>nTd6%07C(7B3G}sXR3iywd+pT_-FV>$ \'Pۊ\zjN3F~e9]ћO'0Gb3JxyE{U&HQ;.Oة't?PSSYOr~-˲[bUdq=~ Eb_)~'t*Fc(B^ےhMpeWU*5Rܬr5{?< s3ZQ8br'O;1 t6AԜ%`J/R]E9Y]ڇId4ppmYVgԎm-(zqո|FM#{<3:ְ**Pje*yU-V[ Y>#[x{F??($o'8sr"3O>ʣ }CPB:5fAX15(`YfPr))*c%<|]{!f͵ިuT46pVhmtUb P#"BsgML㦴7RGJ{n2pd69)nJu T 1^HW+^$QM>;]̚};X]/g$*=ulӭqVͅ.M'UޠB+48j7G'_3fo_- #N? LO>8n21 tY ÿG0xb~wLWy>[1'f:1]dzHV fjE|' nwL=$rƢ>rEW@,|UeVW3t ١n qx_i'煐w9I;(|+:TԹp}ԄY:Le|r#6dx_H? 6Zz={uF'<1v+h;DM7ȵa-Fƴٓ> stream xڌP[ upwIpwwwg=@ ;A܂Cpwr9畜{*ղv3P3Z8A`fv6>;ZlZ jG f0):rnvN;{>66]6E#D-bce ~;?tv^LD.6 )v=@ :k0؉ÃJ a].@ _J)cAhX۸ˮh 0u 6@[x;.Pv&{`ga/ݿ"ljnd Y,me)' ` +--MR7jbveqK"_4o]Y;:8A`Wꓰq݋_7krXڀ,,aĪ qvJ;̈́fr5_^N89:,Dl,o|\M݁矎EH s0 heBfZ ]'@mlxY8}*ZjR_' `k޿}_6?0ʂ,ּpX{e{,tF߀;6 )7{tܦ6^xe7Z(:-jʊ@ 7(mqZ؀ͭ5C7z{P毇 m(ow O{$z!]mo)7y~KGn*_*AVlV?*qXe .Ʃq*}xT8jƩ_i}Ao'qߚ _??6?[YouYY!k57?[mߤk&|}0=lX.p?\h ce_[_[No)u|'M?8onoBߊ9ފ|o?`V9۞B=Hs!!m5D;c;i>.nY]nEW$nDȞ}ZU[>ǫM"-L 3k>;jA7Cuvu+YWmv+\<#q4gGìjk'> $~޼OIJg@ٗwL+,6jƞo#۹ɀZ~o.8խƑXov@Kն[.KT%ީW;].ΫCwR[ [y3HZG,e–G:LK`MC|>^=o}!>l8Wؘ4 ~ Qz5z~^H`)i./SsZ,*-a&|EԋL!a{bKVggj(ࣗo˩Vfkw*q$~CРXph/my΁yGP/!y;t*KFBm Qh;4Ƣik>nv?y0JP-*..H~i mW@B_]4njԺx!#R׸ϧހ號"9Ec_i𕫷 mOC>q.HbѴ!ZD-s~<8#F Ɇ-4v,(,ZS(b~Ḵy$mr5]þ-4ԅZxpϒ\ e 77ȻpWNNzνR;r)sgɶלU?G_*=(~euYO3@|qʠ$N֘ҕgY?b“1 iG"%ZCá6Z#BEeౢ9oCh8:y?@@ ?2OAmdVv'7BXы斐6ÐP]+u$\szw έ+iKb{4<wۨr- ě2 ǖoE9 ^]p/BL}wsq"x<2*85_FIʶ1c̜? Urki/䵍OìRfQٰaj|4SA  Gy{ z~Dbl\Ue8s/py$1J@B|kbU>trRr~NHFܒU+8_WS~ґ7bM|pcrcdM$Pb{o0.P4 .NQ">Q-}Xߥ(iPDm(nA7LiL RS2%|Z>sM&AROUd MvqL]թ_B)z @vfٴFKz:+ -@"Ts"AG^a}.lt{bP]`lZyҲϕx͞F zꚌu [fHo,v9w6CF '3G`~|FˆB0s rUIb4ɤQpلfYae7;؀W{0/Z1/9gnzt M ?: ,[y,#!ܿߑBR7^`(6wPHN!euTrT?彊'WLh.!S=46.5/r}{sn{2'!rbW Ч߭K=qTPBUF]Ԩx yim"܇loK"zČHLyfr+~Y=]>NJiDk (j[ѷGftz$AM8X=L'um,[Xن08˲K|!)wIA7>u#P~*2+D .[a'4GLȋ{wU7! %PuDX0M{CC%k4?:-Q 6F!gy]$0X β3TL@my:@3ha-l Ξ %LEru* ގfWg$.Pa'As"s˥(. $]L7P!TwXCj?#|{L#dR*7ܢ5~\ak&&B<@"L!7/n:&)(8"kH~nFW`]˼_˔+]:;O MlS: *>IGt/8$!cs%i[hib:o.jɾ&R`o)Go9-i8(%k!.C" ۖp tA| ʖHlʴR˫mb;ǜ6ٸ_~)G?(KS0*h-]'gt5nt{gmGe:"e^FcȌGՎ]o5P"Q-—-ӊ[ q ?IF0dN 0t` YHw rd~clkNReB+k|)fZ{')N:Lpt9hH$4s eUs#w?l#}1&S%d8~׆O2C9wt@"<+Tᶿ,;8'4SFπ:V}݄Oh/@%ͦU:Gmr Ӝ!w$6[2"+qAvMj,G7,[#^OdqQto*WKqKg7,FF lDl#mp}^ 7-!ǸkYfkMEXi(r``4,-]W1p -|&Zi)q]ƭ"{u}x SD/6zɂ^z( @9b.c¦l1-+j՟+@ѫ!_jCa5]9X3y F.[kly5i'U&xwGn4cs^xa_E`'۽/L1J~}F)kozWØBM{NȜ&i ~CɛLKMROW l72x̐3:D2qc-$Ǒ1z&bաըvL[Td@ΣjSY#CԠ+awWLh~eQׄб6+M(!a1}U (.R=Ł'5VbNqo;^Y˂ҬIߌX:_SYwNP0-G\%F އ=]~GB3(/Xs S&E)oǽVPC32~B+=Lq㻞)< -i9&=\W #֦R[H>= R 3#˾₈-ɶb[|Ы/ƉܬojKWqA~A}dKg$?~6iʱxFTG=;DhBhdtNC5Aw2n3<}i٪fM1dWd#|ef'M`xxV<,nOÚf6!ͳ/] ܎{yRLJ4%X6ߔTd/efF':5ND^uVپ TзZohsY6KI4Z.,i@N2<$q&!u` 3mSH'//Mb3=5s|#iuBE4yd CVnC 2ȲN7P, qj.y_ mKeYB,ި Kƅ@YA_unyo–z'y(sH<-J_Չ0ݲޥoG^zu"@˲Yݢgssu OrY+uėKOhp?{./8UU/#rLdZkqqYHiO!+k]:|0o7!(s~.ˡͪ8h[62+C[eDyUDD%na+Tz }sI'2a Cb@xDyȒ"d g&_.RQ- ]yī"!A vOHw\FĺH3E(G^ho7AF 'օ4?>B2)5> er".apyӆzw_ "ss^bj4U*xۈܥ7JlJM8P+ٽZ˪W NTyPd>EA]QԦO<(Rꢳ{Q5;ï]?I4$T> #S --GN2Zyμ T00ޗQ*|u4Za_@Ao1pj? q\dR"6s_-&L+YfqIۻG(M?[/AG&Em\Qy>bDr2ӱ_DAhZ,.xrn p&]5K1FIt>*zqo3Bo೒M 8k*MS}B0:ʘ3[|or$ AxF3DH(I.3q-]KRBo%7S7$<_N oCT|fI 2uU2 ''(ٳ~9L^sۈ=m'q׈z.VhB״? M\1~CL3ZwU=qdM"ewZ}JRC:*>Х(.:Vcᘀ)-$Q߼)0*Y5 gҗ:E8NművaSSgxs8:ح>jVəm;n@ĽAhZN(OW ҽ9O)ΖG4h숀+E@v-!3"%-" 9}-ii)/^?>d ;sR*VQzCOp"EAnBd=RՅ:6ҏssd\ |46+sq&谎9UrfpL:#Mµ4KTeߐ$sl\J|IʹL;lΌfY|gFh"t iʧPkBf.a`[Y-.a1?)ܥ:C-9C<>HI;NBk$HjlLuna IG`P$*.xp^`3Hj.u,Zo9g*̮^:$YŎ=VyO'zxteH&p9&Yq7/L'Y[[%](~@iH*or&!`BJF }$ϑ=*p;F[eXH}L즂~x|}Z.b<и:sк+Em~r'ʨ^VpEH=no:jڒQ3tZ;ׄu0jeNQ|k~uy^bD:$҇!$_lHdV aibCxO|>pIS3d8aDbp80&,xe3|d'Y?`782ؽ'9DǨ[8%\O ns[+-|)^6)?RPΦOv*ȷMTMճ=r S8p5wӘ2IϏ44#ƕ31k{$K_Z jj \HYŐžâLtxPjT_՟npXhC#[n@-0?.ܯ"BSX@.GS$(,',!"'2~g0R'6:6zwiMRVDBu 2~:Q"C*nȦL^녃P>zwvr0ئ/7ZM85_bݭʅVT*T,cQXGk">/0We9e볅"&Kmzvȷ UڴJz jv~^"cIlE4jiF{EA_8&g\F4 4H92sdHZsJvӐ4 HPNYб7n0" jPsVoԐvԄ~~t5'JaN!k eJj>&'J04K$l`e2Z;RYfaRя;gbE<9څfC`kV̓I]vV3 jPszxTS.#hda*BE,h< q̬- 。Ni$qx4zXONF$XS‰g.Cw_pjO,` S$s.)K _u<آI+*OCL0,oJ߇n),K'Q*܍ֽa!.,USDaa0O^Y .ѝ?<0x[b6!GøRhowp{+`ν?Q- |AyT"feݷ}M0 (,jp^Uu]h#oӾ!X&iH^bdB?x*k6}%.7\rXXGU1Ąr4̚ų4B)Gqr(.IBh]^P&fX,l"Nj &(;pJozxZGIp$1*ʖ&X?g/8;O%yƥ\=c_#vq'sxS\6zuQ3E' )Gw-1_ ,I=*| I']/J$Q++kuZUb_q0MHh%.Sio%\Y_*U _r0K~<+b| +4!Yr:lAy. ou?b k>8KU#+C@ h+Z[{Yo %:xExɟѝ6&5|O&L^jum[_ Uk81.[)-q/?"U%[u>KιnyD ƍjuvd >thJ* eETPףM]Kfv X_QRZ}tP+,t>.ᾰ  #v1X[y o}N 9լ*h5fPxsĵ%(x*6d&K‘騏 |̭TŐW>!|'ݒLu2㒀,M\nP̻W.B[jWA _hJ10e D;9]Llv1cv`$Z=b:iR-J9MέXю.mOԀF\ӗptxTi'Z[ݷo5V-Yt7!pgaoխJ%Ħфe]@Q|ʍYNh?&QYϛJ8t]6cR;fSȠ}48=:@5J`Rc\[\ -وzXsnq#b+eTec6sO|ӒwJzF5"U ۮuzc~.%0ξR#=xJUŚ"rxG53D;Rtyߟ2H=rY :DG,%܎9nT\,)hTrd\?0ŒS|&Zi/9DcXJZ&M"!G%؂fQ_aZ/ڿgE6rjFAu ?c")nW<ྀx|бpPzN}BI ;\r0yfJ^MoKS"Pb*]tm9SF(R %iȲ5))yıaRygR)O)<ŪR730js^"i4K!&wʔB)!7Xa>~?jLUx=ZkB6a1u[J Njh0_renԑoeߘ TVoEZmq:WD8o?2FlW!A)": (Bk^K2'l851h uĭ\2u6a+y-{ᖹ>D6ql'(g쟾хNKmJA8hZ~=pvB v6rY@ŘCeyۥVko585^ ><5(3G ,7G0&wz|m,k&f{ rhO`TќP^JᏙE"njO[Zx_ E^Q (3bq9 ^Ò]č]ljyTڇv=2y |7P<6T'"Q?|HΫk;cN`jՊADXBʅZ> ఎR_g!6#hx렱$ſ"ȩy֖Y-ሮ3W֭FZ2b_H6H2dWw/iˣV>U _CKms~O$dv&v?[-ʐa6A\((j΍`LvnKD~2m5HRYB&D-6 bUM?J^2ɹ?@`8i9T6q\ID nq3~$"1UcyGJzʻ<곪-V¼c^gЮgRrjoE|FU*)(u6k9|zj2HT[jPry!mhXmAEc6q_?r ڍeF4,n0>$! )W0Smxu0G5fpE dZ9qHr/kXnF~.I ,q݆$ ˘l4(ib@nÝ$ż<p0{<7AytyU[mg`> *Hr,>r1SF[Ʈ5f?bezqӦ'rKݥ25^,1+ oˍs!?D~< xEb⣅H,rۭ?>!u֯_Pu|pdDHi)7h(MFG}i9 )xxk5ּU&LNY[0xEjim1"؎GN*%~}%:5/uORJTp_ODn!~s%F(;3Y[ISa>UQ7n>2Ҙ(%P#U(n P=6CEgs>i_Gxn/k*lt~u`2Sܮ_weQؘ3B[B^Jgz?ƓC]^Vj &nyD?EVSN,OxX4Ib+Ϣ:dk@bUTrS?cE1$PSϛeTFUz1YHRJo>o@dy2+x flMX'M]|P]"N5)- +6zߍ12#κpi_>6zh]gU1t#ԛz$a4Va@ \\NἺ( $B"a0{J┛`ܙ8OHLi!j4sF$e/8r _]K";3o~N'I0')ڽ}^q_ }q$>0ԡFd<ȭrGX{XˆU~!dRjNmH1gt͞Ցl32Mg7_cUH,'JC3LwC 5EQd(_J6~mVJ (X5jשKr}"V;y3cdj2XQL-< QQU.>719C &`kTT7f^|\#!ÖٟEmJabZEh$&!}ಏ׫Wɹ: A ;i]4.c크|T#"" m!K =2`ţU,Rd{C|m n FN-/Ykؐ],f 9p?: qY%*ꎊvqoAt 6D-pAvЏ(%Oji5! )|ԑ|xG7zru{Kf2[7R C(^`40"rAGbDQ4;6{WK_N2 - .<" MnfU=/>6~r |O`ENtV^Ma_ؤ_cP]7FYӯ)S(kW M=r%fLzHwAv}iA)HSMݽ{)i%C Ya!![(&+gRl=-!/KWwr9[X"axCϼ_􁥕V Ud:kaWW? )q+;>x۽S!ђV1 :^ҾwI:&׌)t)`_BM_H55U?)rNhXD&>NBv> stream xڍeTj6LKKw % Ctw0 C7C#ҍR-%%]t79ב? &9w{L {9vDMՇG۪ w۫"h[xv!^ml 6P_q28B4l~?@vL`;#_.L`Ud[|+[5n>>/L:|trE=Z~>o_H )85ABN$4// 3N ?, 6?n &OXְG)_V_?j?&)ɘO::C,\[afؒ;iv'.NPY]a>.X?Aa t֞ _vg>+\_҆-_8:EBmBۮk$=ٷxu/ܩyc78ؕ]h [U!"‡#jxEvQRM'*),!$w M(vaή: 9UyA%,m𱺂0ʷmpDRg !F~e;l_pythOsrRN[ve/lEwيUE]4Z_?rPU7q*mXZ9$&v/ҪP}HЪ8{S un5MU?d!ge 8+sFeb,IFŬʁmrUezWޕI75+BnI#)M܍h KO4t`G$dLBE-|l>IG%i8D++(dsMQ΢>}5Gdiȩzdb Fۣҧs6lDz.>ԏ1nt鮢yƖ#o]F-;?? bc9 &W9-䣒 1bCK < =HqcE';cHjf]'5ɜ4q\vc< M5$5[L0$3x,2*bW@ޢϻ *\h_<7~.Cbp^8<[xK*ri-]}5؋4#`uxGl!!]nn8ї퓲UEX +j񅇒%k%9úOzH.o04/psԤyQMR=5l<\ J廼{9::#jr˗%hxT|2y޹"2[-GWnJ 0Vsf1U(8hu;&.<2Ҵx/iNfN_4)m&?=>sy@|^sN=y| KePl_~_z}kYCi|6gq#I=c׃ V5.NӦD-0 rQ&{yիKɂwKɢyܜ2>/YdmȢ ' n6F?UeYŞx>N@lz#3jq{B)_b-aC tϛج uls$^ F֯M] ;S[-}Lkt\#üT"X 9:w>/zf+\9kԜ+*#x9>OB:jkh,bZTִ2LDAL|F%< !Dc8e!Kٌq2 \s=ZCb+In\ C ^w%X_zՄ;ټ;((F=ѳz:C\e$j׆ᎃq3P;shxq爢s@ς#EDϵ5d)#$G\%~v޶^̠wz(]xt\ AZmT 39 {lR7s[bqsvoHq/m$鄳o~(Ԅ]5.m"bmZ]OFΛ _49}vY߭n"Zi/68nJP S'RZus/5/'̞"ob8~s[N{2󢣸',ߓi>6 z}N8]p.(xL'qL|?|c`{L y@tt KΣrEHt)gr^KQtt3MuY)b1L$nB={hpO#!v1S%Ji5E+pH3Fg~ lAnwDӦ"^eB~]QG ɼMP7N)QWB8gPGWTBe܇7K \|>I돷Dtqn67bg1&l9 cvN#2XD=+%V@~(Pq3i 6=cX- y@vfZHLJ/3Xֹ&`b +Of"(y/B|)$[ĭ]U"mn"BսUr֨q@su[L;a 8wB."- 6yN]ZC 6`>o*[C{MSn3*Ьm^Q fəɒd"GqЂŒA;W-%C<@)V]>\΋~@v v0? Nna{|ȹ7 2]37zWKV)$'6|81(=%8ĮdI@Y/̱HYP"P,/MOHGyWrw%qL@+B);q^zQ5Bz\i= \TY‰+]8m6u.gݙB9G`%\)l+EV:dhcV]SEe&rMTYidq^D. Vc=&:Q! N ) YNoIz/ [sjcvv> -J0%3,&鉮(wuזwIzzlg |\z~Ե kYC%|k:%jb*Zy$*+e’I_%Z2p5)<4)jW1xUR/1!A*d*)mhH+ė\`HbA¸Ⓞ&"GGlGT5 R|QMТPC\d7*"P,MϘe'#.4I*-oc(ZoPrOF8+u6SLۗH̸ }rz ,JZlEׄ׭4>A\Wθu. TRu7OAXͩ{֒J!IhcjKP9 ]{E4&b> ~t1ApN'RK&K7KepHŸ%ݧdFFytv_K/Пd5$5}cWqׅۛzl,mROgtWEw0)t. };/ɯ 9yS2ڭ*1Q/w%sjN=z:HrX+#l_Y8dzRO8a'ml] t*2L1,\JZ).wy_W%'?oDAn/ա~o[j EصT\emz6uڵ DKA*E#%Waoeħ-&MQ?!%]R Q%ON9*h]Ͽ6P gwv" G@>0~QӤfԼi<晓Lk9ed+URBڪg 740Ks5*^b}Q!blk  7AꜬ6 +¢<`_=ki, Gk?Ѯ1 mAޘ15£uc22%}}[;@= V"GySg ג1TMwRƭ%; "ǜݑQ<G-FBNZdvT@aIM*m2Ql47w1wJL[RȒ QI!xt(!6MvQe,*vUi8Snuw]!%|Dǧ-adZ?(,ۓt#3i攤{b&^I-[m*f72D0K ڸ]ypkjo)M?N(}y`g;CT931*}g5K;<&O\҂[Z\*_UvmjTԺtON&@<npYirVdtoŖ/4JL e~p{(Uy(Ϗ (ڶ/T{qs:A%6dџZYE]U kƫa.5_[+ `2ODwlfv4!h%o~VA=VJ|T2HE)ZSN-A<ɘ[ACiд:2J-/| Va;*StA{Y.͓z]Ohư=ɱ^Ce<"›(7}ΚQs`i^kl"T μ /mu:FWK* aԸ~ۻ*a^@l2ܪ0s뚻s^5Cv"т !>lp11D.;t69 %"73AZƕ>nGm9Le$^~CwJDYp~6x}˃C>B7i_AhWjT,KS$Kn!R4 d J6fxJ9Yo*qT+XؿJZni">-&4F8gyDeS12^*sK˫/! J*|9PbՑ=,{0k^b3EA+eLՑߌCBG)ģ1TW&Zx:;I^*&NEbRR14~do2jW^>.v8t.!^V!*P!aitӵ̑4uTa6{sj쨩>J$_"!Z(\Yv{)hvkyun%gMlZ['Yly$fl\$*sl<,8[Cٍ\UDEYo2W$,_sM:&/p}|Tt* #&q: 5PwȮ֚%ĮXqK-guE603Ðtc/i[ȏq/,,zndbu~rھbQ8aN}5ͷHD8"A,=rtKjnBe1 .%:̔^j^_g2뺙.C?h^ʁ@Xe2 c*CE}=]YE#NXX_fMR,+[?VGd/":՗jLJ]W^t|^X z$0Fyq_* |\>o&aʕkT}x<42`*v7Am]Sn-L[[8thwg5;OgR1ce܂ p;%E9/Sw<î?Sp\TZ>lOig{'mF\71 ~\ f;< ϧ;0fS4|'Xb)F4blc7Ut̛Q-Ԥpz=6@$i!jՅ#^_i Zj#ّZc(A;zSTS`0b52~lz7kAo.^cvmVͰDU7_ VSA55~kWа Ǻ.ɣt`Dc,8cId+asl{Al;Y1-T.ؾ'F)F7Tښ8n~~ha Sfy/b ]Rl_*V :)/_(Fgz%z7{F0eȍQM,@|Bs O)$QB;l+'D*D9ErND~$40|g 8 ?FQ={/67b7ؒ?~jBٜٜ׭:gg#BDv| endstream endobj 24 0 obj << /Length1 1608 /Length2 9730 /Length3 0 /Length 10778 /Filter /FlateDecode >> stream xڍP-wwBeEv5Xp,5w xUV>==szji8eV E(#Wsa02a W70"/+d=5#+$+,u[z\U((uvYd@`%a 9=UZ:@0_)X$`0g1nnOOO.K'7.+ @ kNZ`ہtAm`  AܞB! WSu:@'xxIWD`@  l : X&Z:A-=,VO?n PX>uWn@W3̍ GiYb-urA`n'vݛu@=!#0w/ `w_'l @GOrvܿ {;p6? u<ۀ~0|,=@;ߎFk0ق!dx$?^?+'YC!qJZs_'?-;?'wX-_U 6PM<ߍx Ɔ4OzX#AY);:g[:b<4Ч /@kNUY>͈,I眼\<n`/6SK_S G0 u~wxx4z@p&*@P#'(tuxR>ͪ5 PSG  DnȓO$* p[x >!og?'_)?I"?7_/T_)ۿ>%(<\ 8ׄ^WRzr~?:G3R 9/^}NW`D`-FX׊lc7A yC؂bmKrԤ\fl殒SS'#T憟\XcѨd""XmmϫegUNe)ޤ ~_*oSa;gIPL3nu+ݽe >o }b6'M/5q|kۤ<ؗ(x]6ˊ8[|"~Ar%BIEttɟ5\9j~Ճfn)YE zg@80g!pٱ=ʘQ'wT~B#J<ⴑ;Vf/pՇ=ַ9޳^hs9jK,u:gKDTΒb|7Ӗ _r҉Y*!~n`_͛ToLCk%"|3R ÞI,s5r|L8ZR)`H=1h`俧1XIއ[A;-/T^_2/k skCǏc?3=h ^` iT$`dlk#|z-9Hp[IG¦jB346z;Lmr/qV@d/Ts喥fҞM2Ե~U {Nh>:;yݮڳ41E6QnESEG[1@K,)YN n7߃@x=nikXh, U}jyݳ'1/-PmYvLps^&*Ѧ4{Dg]{Y;u>ekPw 2"stεN zF|LU:|kw~)Ty?V[S|&#>γ"7q9eYr`{Ә$9lS}:$ $ iMv Fg9Jؒ ܝt _@'(™:f;%: ,ʣadeZY/ BMq:"ΨwAVᔣuKUkyc.? 屸}nYڍ xn+ĕ7L!*'G+T*YńvlͥC䪞|Ks*%|sJLca $Jm!}DꦽY?U읏p.\"3Żx=I'eU{Ƥiͬ/Shpuc ۣ+CMX&;CG-yՑ<Fa_??^rZJRVجb'((޽!e+@)m1ӻDph'^3圩ou]$ى?gRq>tS\ @h>y|g`;7!w7XWߛ6Aۄc0loÙhĨ_v(;&ϑԔ`Fj4sx%E}g#ōh;eE:^}jz[ڂȣF~4JW??]7C@?`w3Y |e撜-mtEߐUQ<ńUt)Q@)e ԣK^s[úq5Mq}$˯rsm>UKE#5Лo~R}O~^1,|pmyTfi=̮IsP&ޙX.Z=kG98['K@(n0] d;9'im46gxo49p}!c$9n"^tU٣9Մ꯸bm$֜0u=hF '7p;ʊ:P8#k Np\(^2dHwь͐0?ٲ(3"pr '%񐏜 DxK¾PvnP1tƶ;٦Gڥֳ%6o<{`BD吠;w7}>Ȩ?>T2Ҧ 6TՆ9-u]yK6]eް`e5b6ux>G|g;pmͮ_\ӮIE'c nݟ$t (QuLJr(ƴ>&D=|kn:+g& KtR~px<c bX찎Hbprз0 ݯX /ux<~S"9Y~\|n'}% {]Ťd!ηsMLFq3Eyq2!aW39Ue>_ZI|@Wh@I ˭eY K^[\uE%Lnfɡ1w*A6>DT2{ouL3KYlh+s·on劌2f I:i=e~R:|dאћ hs!/o.96]ݡa-,!mfq0j~Z]O[[Q+kd?-\w8 XFe^Ym~hEQy&24М.l~N-~/HӗruqZͯkg +Olo$Hˬ u CbE։:} o^M/7W}ӮF5*e,Q|kHk>8]RZqs6cAC,`.Dr g:Q8~.Pqg,F%mQ6; ݉Wu/ՄMG (Z&ov"U.mq@(Z _M htaޅ{aE᣻rz#@- ~>š͑o8R-K_!gަ65q_$"sӱR>šPJJ;i3^|W'>a5Wo:t%%ne=񞶽RY5t+NBF3R%4^JodZabviV::&le^. nSLv4ߘ3XW "sY9vYŁ*;؝ ټ+s;cKq2]Q\*tHd +Um" H݀xCWw~vAϗ+5m/ќhu 4 f^Hg|!eWg]Uu fj w/wq ,VX)ۮdq^-}o5aTm!U nN bgv1 gaHkf3/ٗZ' U?$Ruj#1H 1ˡkQW!Md<֒B^Lu&  Rl !? .ivυjwbkT>&j @R-9*}؎uMG vh~~Ctq6Jnhs]dv&Vc+t*-~EQ@`vkB+_ktCTRl3Je䛾r G#sP\:ӷ|39R,l8,np/xZ5j$[ m q~6ƨEx@?&?v{>7r|+a %4kt&/ne/b*>iVfFH}O*7n K!/"T0#OĔR., fpL`mrW6:巨YEQrr-٧g Kx+SGzzcpP U$z{T}IŻ /}}4ї ri6ŗW,RYh孺.ШF2PJ(&_uJ=͈&Ӟ%(xz)ѣ!=aU0|"gdEU:(w$礜NP/1)gyF޷w5$Vv b;wISXf-ix3!&aҘ@DV(9YXÎ2IJ({&r3\b)7̜d38-7K*,#̓TȠ۶ULD.Is,q $hFF}^G~~HwR 8Va68&-6}YQò#a!ωkwLI;޾'H/^pH}ň6N - D6{=O vuBH H]QFݏ5}Trw] HZxQD\w{ΆcG->QN/|o](6Q4~Ms{ zȾ?U`ݥB{ ?+ه@=-\}?/3'IXpySb7DŽw>{Y$"4R~ !Eޝ?R  Z8Mq ӭgw Jyф)T8bo{~b[C0$>!7| 啜55΃"X7|,W$xy)-` -K$Q]Bdq[S\dƋRepp3)]bR<MvQDQl VNȼ̺UeJR4 (c:/FKZx{OA ypLnY]4}G/u<$#$_%;|v?硚GaDL+d ,(SmUB敆y=t+~+;xѬ3n^X?ô˲2.Xר?'^8N=O 3kilw'W,Oq$H&8E7|i}rUfl>&yyNs4xLaBKpH֊Sr06-}|~*g޾zLP¡APs+vrIp`~ +il?kCafO+%ΣQ܁l,">9v0=0%1XcMO<@,K D-cb p='v)B]0Gxk#!,nS ~ ƈ7E;4)lYvБUM8[ .:#Sv{],j/tyFw~w]RMΧr-k&y ɾ%\X'xT%z-w LSVR" >k1wu7<]h~C~h\B'* =5dOm8#*Xe?a,IE&EV.\,=zOF hO ֐h8RJ^;A3I `VfI77|['8c7x `D7⁻E8SoD^aYgYk׷VW&Rg9l0RVGza78XlF ~6I]{"&>uض8Zaȕ˔*dvX9̈XגQ~EyQ]*e8NΗߟ")(x0j"FmDuYh5c7f[I[g<^qg؟pA- ?hy Cs_Z _} 8dah&;jצql<֭}:&Xu?rOGTxW<5ŽFY$ }YvX: BH eӻNik]K\.'Zy;~S%tdݧ7FO E'ӈJb8ra>4`s,] R)uborPbu/kD)܅.v" Z$ULG>݉.%hc/ y[PMuv8 hec6i/?1(x0\jR%3BD#P7vD>DMHMǁ?S:leL SȽPl=bxJ JXV6NOϊý ǛL? 㹈ӱп,."2ؓa2u}/֖yo>V񜩬b&sV(ZN\^QGR}^ l‘nK9HJ}InQ XtqYht(&ϧKiKęWM:ëܔ+fʻKhPd{{W2K #2VFzHSRBE$-w:^dVbI߆jڀQF^_`"8`sj gsr^.$k#^1RĢko5tbKHK_vu:#;31立ʖ?$ZHbxuzT/Q׷Zrt4U>sv/'6tw6ŝ"m—cN l#Ti+MKLj/ ubiD:POWHbޙcH~eG'q%$&\Q= {,"€gu_HVt l"̹YAg* g9Kj9O,?є(9yZ1ix?L)y9ʱYQg9wy0ߞ~WeoRP:bAd4Y던Ʈ Z %M;:%ZNx,[Ryb*눸䧫PL^E-;s 複9`6h]InoT:)GJD+Zp;x@xXG׍rRx;R[JWGד)9ى"7d߅X;GˋxMΣƳ4RD!-hDSXP (wH}LGu)gB_c%kE)2fti?3Y)3aLnJR&"Šp&$fy,4XE!u4&cInvq ck<О˷H/ ]4䠾7m2 > endobj 9 0 obj << /Type /ObjStm /N 19 /First 136 /Length 1279 /Filter /FlateDecode >> stream xWKSGﯘcR)~TQB` R)"֒K Ydl+Nn9lk_wh$LD0-YPJɄfDP&I-IiE&&a2p4SB昒3Ô Y3eqMp.Jd{! y>*28,gu1+ .|\ ~w'vÑaom؛7Qs}= J =zF2wi0f:KCTr/jv ݒe\#&=mqZus\ust,s0BdVIBj 9!4ZYIy՘Jm,%˫A ) NEVN-4XCK45  4R@K𦱖>ۇDz.MWKZNٻSnzwRwY*t%t6@̇Zǻ:NyUֹ u;7YT544o&B &7O aӸ-Vlmo9릥؊mZH@n jӼk[oqY˹]Z ] /Length 89 /Filter /FlateDecode >> stream xɽ@@]!-@C*P 2/xEj%3I$$$8]֜aNk}nw endstream endobj startxref 59269 %%EOF GPArotation/tests/0000755000176000001440000000000012267353521013641 5ustar ripleyusersGPArotation/tests/WansbeekMeijer.R0000644000176000001440000000606312267353521016664 0ustar ripleyusers Sys.getenv("R_LIBS") library() require("GPArotation") search() Sys.info() fuzz <- 1e-6 all.ok <- TRUE data(WansbeekMeijer, package="GPArotation") fa.none <- factanal(factors=2, covmat=NetherlandsTV, rotation="none") tst <- t(matrix(c( 0.6972803, -0.3736554, 0.7774628, -0.3184149, 0.6832300, -0.3620428, 0.6612198, 0.2361132, 0.6972393, 0.3026050, 0.7100285, 0.4059509, 0.6353584, 0.3526947 ), 2, 7)) if( fuzz < max(abs(fa.none$loadings - tst))) { cat("Calculated value is not the same as test value in test WansbeekMeijer 1. Value:\n") print(fa.none$loadings, digits=18) cat("difference:\n") print(fa.none$loadings - tst, digits=18) all.ok <- FALSE } fa.varimax <- GPFoblq(fa.none$loadings, method="varimax", normalize=TRUE) # with eps=1e-8 # tst <- t(matrix(c( # 0.229695829694226694, -0.757005882905721683, # 0.325474298411086493, -0.774533969509160203, # 0.227951538606475851, -0.738861531224136225, # 0.634850649690308022, -0.299876110481063607, # 0.707312661165822032, -0.278246783076943283, # 0.789359884149245072, -0.214120439603779994, # 0.698885205896135120, -0.199081171877497243 # ), 2, 7)) # with eps=1e-5 tst <- t(matrix(c( 0.229698038368303409, -0.757005212686898243, 0.325476558225504142, -0.774533019824047542, 0.227953694341768043, -0.738860866094951829, 0.634851524619887475, -0.299874258087383661, 0.707313472988376213, -0.278244719250824557, 0.789360508873491518, -0.214118136377292989, 0.698885786741510029, -0.199079132641678647 ), 2, 7)) if( fuzz < max(abs(fa.varimax$loadings - tst))) { cat("Calculated value is not the same as test value in test WansbeekMeijer 2. Value:\n") print(fa.varimax$loadings, digits=18) cat("difference:\n") print(fa.varimax$loadings - tst, digits=18) all.ok <- FALSE } fa.oblimin <- GPFoblq(fa.none$loadings, method="oblimin", normalize=TRUE) # with eps=1e-8 # tst <- t(matrix(c( # -0.0244898894997362740, -0.8055076884898763057, # 0.0821776433220552660, -0.7883517482514345032, # -0.0194442483441249758, -0.7847120136813017233, # 0.6350106056917923514, -0.1038114236654337219, # 0.7293893902400611085, -0.0495156037400738894, # 0.8517915457391848078, 0.0588983480418694277, # 0.7504355940804637859, 0.0408946221245683056 # ), 2, 7)) # with eps=1e-5 tst <- t(matrix(c( -0.0244886312423446446, -0.8055069385602275922, 0.0821788889356081659, -0.7883509906546982693, -0.0194430219824419312, -0.7847112821295906260, 0.6350108529538124325, -0.1038111848933331444, 0.7293895650539216069, -0.0495153948664520185, 0.8517915670863017708, 0.0588984825074335624, 0.7504356301074717184, 0.0408947509009953206 ), 2, 7)) if( fuzz < max(abs(fa.oblimin$loadings - tst))) { cat("Calculated value is not the same as test value in test WansbeekMeijer 3. Value:\n") print(fa.oblimin$loadings, digits=18) cat("difference:\n") print(fa.oblimin$loadings - tst, digits=18) all.ok <- FALSE } cat("tests completed.\n") if (! all.ok) stop("some tests FAILED") GPArotation/tests/MASSoblimin.R0000644000176000001440000000447612267353521016114 0ustar ripleyusers Sys.getenv("R_LIBS") library() require("GPArotation") search() Sys.info() #require("stats") fuzz <- 1e-6 all.ok <- TRUE # test MASS 4th ed. p 322-324 data(ability.cov) ability.cov ability.FA <- factanal(factors = 1, covmat=ability.cov) (ability.FA <- update(ability.FA, factors = 2)) # ability.FA2 <- factanal(factors = 2, covmat = ability.cov) # max(abs(ability.FA2$loadings - ability.FA$loadings)) # summary(ability.FA) MASS ed.4 p 323 seems to be print not summary in R 2.0.1 ability.FA # this is default varimax rotation. There are 3rd+ digit differences with MASS tst <- t(matrix(c( 0.499437829039896530, 0.54344904693111962, 0.156070079431279873, 0.62153798991197484, 0.205786989958578748, 0.85992588538426895, 0.108530754440558652, 0.46776101732283504, 0.956242470279811574, 0.18209631992182243, 0.784768183877880943, 0.22482213687364205 ), 2, 6)) if( fuzz < max(abs(loadings(ability.FA) - tst))) { cat("Calculated value is not the same as test value in test 1. Value:\n") #print(loadings(ability.FA), digits=18) this truncates print(unclass(ability.FA$loadings), digits=18) cat("difference:\n") print(unclass(ability.FA$loadings) - tst, digits=18) all.ok <- FALSE } # differences with MASS here are a bit more than might be expected, # but there is already a difference before rotation. (oblirot <- oblimin(loadings(ability.FA))) obli2 <- factanal(factors = 2, covmat = ability.cov, rotation="oblimin") max(abs(loadings(oblirot) - loadings(obli2))) # factanal(factors = 2, covmat = ability.cov, scores = Bartlett, rotation="oblimin") tst <- t(matrix(c( 0.3863637969729337152, 0.4745113977203344047, -0.0110032278171669998, 0.6458708261423832253, -0.0262888675561207576, 0.8961123879025085781, -0.0180180060207963122, 0.4882918937716873575, 0.9900948712271664398, -0.0370729040114848238, 0.7905663749272058283, 0.0526099352008769991 ), 2, 6)) if( fuzz < max(abs(loadings(oblirot) - tst ))) { cat("Calculated value is not the same as test value in test 2. Value:\n") print(loadings(oblirot), digits=18) cat("difference:\n") print(loadings(oblirot) - tst, digits=18) all.ok <- FALSE } cat("tests completed.\n") if (! all.ok) stop("some tests FAILED") GPArotation/tests/Jennrich2002.R0000644000176000001440000001046212267353521016033 0ustar ripleyusers# test by William Revelle # from Jennrich, Psychometrika, 2002, solution for the Thurstone 20 box problem. # Specifying 27 elements to be 0 as discussed in that article (Table 1 at # page 12) and using vgQ.target as revised or vgQ.pst with a W matrix # and Target as specified does not yield the reported solution. # The solution is almost identical for the high loadings but differs slightly # for the small loadings. The two models have a factor congruence of .99 for # all three factors, but do not agree completely. # Jennrich (2002) apparently was using the oblique rotation option. # When running TargetQ the results are fine, or when running # the vgQ.pst function with GPFoblq. # This a good test case for both TargetQ # (It could also be adapted for pst but there is already a test for it.) require("GPArotation") data(Thurstone) #the 20 box problem #solution reported in Jennrich 2002 browne <- t(matrix(c( 0.013, 0.994, 0.007, 0.991, 0.012, 0.001, 0.018, 0.003, 0.986, 0.772, 0.477, 0.002, 0.003, 0.393, 0.874, 0.409, 0.003, 0.816, 0.548, 0.730, -0.020, 0.023, 0.870, 0.405, 0.799, -0.024, 0.453, 0.664, 0.621, -0.005, -0.058, 0.915, 0.512, 0.639, -0.018, 0.644, 0.046, 0.980, -0.003, 0.971, -0.038, 0.060, -0.026, 0.025, 0.965, 0.380, 0.281, 0.726, 0.490, 0.652, 0.286, -0.025, 0.971, 0.019, 0.957, 0.061, -0.045, 0.028, 0.000, 0.976), 3,20,dimnames = list(c("B1", "B2", "B3"), NULL))) #a simplified target matrix, with NAs for ? and 0 for 0s. # (compare to pst appproach) Target <- t(matrix(c( 0, NA, 0, NA, 0, 0, 0, 0, NA, NA, NA, 0, 0, NA, NA, NA, 0, NA, NA, NA, 0, 0, NA, NA, NA, 0, NA, NA, NA, 0, 0, NA, NA, NA, 0, NA, 0, NA, 0, NA, 0, 0, 0, 0, NA, NA, NA, NA, NA, NA, NA, 0, NA, 0, NA, 0, 0, 0, 0, NA), 3, 20, dimnames = list(c("T1", "T2", "T3"), NULL))) v <- targetQ(box20,Target=Target)$loadings all.ok <- TRUE #slightly larger fuzz for comparison with published value. # note max(abs(v) - abs(browne))rather than max(abs(v - browne)) # as sign change is possible if( 10e-4 < max(abs(v) - abs(browne))) { cat("Calculated value is not the same as test value in Jennrich2002. Value:\n") print(v, digits=18) cat("difference:\n") print(v - browne, digits=18) all.ok <- FALSE } good <- t(matrix(c( 0.01324194563970146343, -0.99360765277094842407, 0.007265459960371034587, 0.99121314541487770544, -0.01178320700232154961, 0.000654586020267855506, 0.01798447315534307256, -0.00266076852016330911, 0.985581004768931734361, 0.77198435084052174915, -0.47723548341238952730, 0.001547735983967568618, 0.00334198654247502835, -0.39290416948063611180, 0.874043793719835537814, 0.40934347835281348349, -0.00274610551094590233, 0.815649888720176186041, 0.54757055519984310088, -0.72951044925148011977, -0.020211353947714422175, 0.02292379053779741716, -0.87011712730189194609, 0.404542252780873523577, 0.79911058029224457666, 0.02416810475294199623, 0.452727043944761764482, 0.66393502364020362538, -0.62149665012300570055, -0.005186928343372421146, -0.05839790682548451350, -0.91517931889838155524, 0.511521949806932663130, 0.63924406199386740735, 0.01841750353525576159, 0.643544196342115570886, 0.04597086497418309547, -0.97980801598321454193, -0.002918643110053173451, 0.97103389549392915558, 0.03847065084578840666, 0.060066450372699808913, -0.02622776344285615568, -0.02482060086975104718, 0.965272709232911085842, 0.37998105522582992233, -0.28073835673932595602, 0.726047993725112084107, 0.48985182554738604388, -0.65226812910595410866, 0.285738966726349907788, -0.02451057644240206557, -0.97122042802717223342, 0.019132901654980147277, 0.95708220223038309449, -0.06086293722346142188, -0.045050942196376064786, 0.02797903728304645954, 0.00036458752733534161, 0.976083771686937051726), 3,20,dimnames = list(c("B1", "B2", "B3"), NULL))) #tighter fuzz for numerical comparison with previous test value if( 10e-12 < max(abs(v - good))) { cat("Calculated value is not the same as previous test value. Value:\n") print(v, digits=18) cat("difference:\n") print(v - good, digits=18) all.ok <- FALSE } cat("tests completed.\n") if (! all.ok) stop("some tests FAILED") GPArotation/tests/Thurstone.R0000644000176000001440000003353112267353521015764 0ustar ripleyusers#Example from: Gradient Projection Algorithms and Software for # Arbitrary Rotation Criteria in Factor Analysis. # by Coen A. Bernaards and Robert I. Jennrich # Website: http://www.stat.ucla.edu/research Sys.getenv("R_LIBS") library() require("GPArotation") search() Sys.info() data("Thurstone", package="GPArotation") if (!exists("box20")) stop("Test data not found. Testing stopped.") fuzz <- 1e-5 all.ok <- TRUE # Thurstone's box problem. (1947, p. 136) # The matrix box20 is the initial loading matrix from Thurstone's box problem. # This takes a lot of iterations to converge at a higher tolerance qbox20 <- quartimax(box20, eps=1e-5) qbox20G <- GPForth(box20, Tmat=diag(1,3), method="quartimax", eps=1e-5) if( fuzz < max(abs(qbox20$loadings - qbox20G$loadings))) { cat("Calculated value is not the same as test value in test Thurstone 1. Value:\n") print(qbox20$loadings - qbox20G$loadings, digits=18) cat("difference:\n") print(qbox20$loadings - tst, digits=18) all.ok <- FALSE } #qbox20$Th - qbox20G$Th # These values compare with those in: # http://www.stat.ucla.edu/research/web.pdf tst <- t(matrix(c( 0.0104916072210123716, -0.993396087928394733, -0.089861775335686706, 0.1584646383898045685, -0.167305085570175344, -0.967087879524061056, 0.9822741057703969769, -0.094961339079248266, -0.081938545344928893, 0.1249962020162782989, -0.597065497283680413, -0.789290657131387352, 0.8695614167874907707, -0.471622450093366785, -0.090438968384549553, 0.8757114893176747294, -0.141012080768234127, -0.452333925937943637, 0.0679423211019681700, -0.811411071716238719, -0.588554936857709099, 0.4066768108416509708, -0.907862149146695163, -0.115673202040957226, 0.5770808894249742638, -0.142370726163931066, -0.806527261406603468, 0.1012712863762783577, -0.723336747696182614, -0.694640249329106285, 0.5000928657774492692, -0.949746569049947253, -0.046846346456817907, 0.7412589798326677526, -0.140350561965914555, -0.663578062154924320, 0.0055655501003109590, -0.983847100401775698, -0.120037109608235590, 0.2142330103903098415, -0.119429100752156334, -0.947421187831809397, 0.9550804066106526324, -0.108275659756619305, -0.039227521113362487, 0.7823218737697450464, -0.405437596810190704, -0.439275358874331168, 0.3626971102221024923, -0.753122462957226402, -0.546281394544768872, 0.0162483298780003657, -0.966230359337758582, -0.052114148464710915, 0.1076692386876715729, -0.206734953950642314, -0.934620775424686911, 0.9744239420161749932, -0.092650552854598708, -0.090828719474599584 ), 3, 20)) if( fuzz < max(abs(qbox20$loadings - tst ))) { cat("Calculated value is not the same as test value in test Thurstone 2. Value:\n") print(qbox20$loadings, digits=18) cat("difference:\n") print(qbox20$loadings - tst, digits=18) all.ok <- FALSE } tst <- t(matrix(c( 0.57232345894276127, -0.60751194947821441, -0.55079496147384377, 0.60249460283341838, 0.76716797198365361, -0.22012168525406509, 0.55627880770383020, -0.20587018726291534, 0.80509089803322043 ), 3, 3)) if( fuzz < max(abs(qbox20$Th - tst ))) { cat("Calculated value is not the same as test value in test Thurstone 3. Value:\n") print(qbox20$Th, digits=18) cat("difference:\n") print(qbox20$Th - tst, digits=18) all.ok <- FALSE } # sorted absolute loading plots. sal <- abs(c(loadings(qbox20)))[order(abs(c(loadings(qbox20))))] plot(seq(length(sal)), sal) #compare quartimax rotation of the initial loading matrix box20. if( fuzz < max(abs(loadings(qbox20) - box20 %*% qbox20$Th ))) { cat("Calculated value is not the same as test value in test Thurstone 4. Value:\n") print(loadings(qbox20), digits=18) cat("difference:\n") print(loadings(qbox20) - box20 %*% qbox20$Th, digits=18) all.ok <- FALSE } qminbox20G <- GPFoblq(box20, Tmat=diag(1,3), method="quartimin", eps=1e-5) qminbox20 <- quartimin(box20, eps=1e-5) if( fuzz < max(abs(loadings(qminbox20) - qminbox20G$loadings))) { cat("Calculated value is not the same as test value in test Thurstone 5. Value:\n") print(qminbox20G$loadings , digits=18) cat("difference:\n") print(loadings(qminbox20) - qminbox20G$loadings, digits=18) all.ok <- FALSE } #qminbox20$Th - quartimin(box20)$Th # These values compare with those in: # http://www.stat.ucla.edu/research/web.pdf tst <- t(matrix(c( -0.099561899210599963, -1.0236437309424475384, 0.017110338313848200, -0.007103778102200991, 0.0427848301281630802, -1.009962780073245581, 1.012864497258948226, 0.0331727792925069487, 0.050367710973030555, -0.054843850612513692, -0.4493155290974688021, -0.772334543778026350, 0.856287122381722998, -0.3740197232441037078, 0.069350368268248391, 0.835580575619599641, 0.0487450425576793633, -0.360381644212301344, -0.102893671454670210, -0.7226715938020771279, -0.537456650126404090, 0.322103633211960838, -0.8816846447967544576, 0.031159743715387874, 0.462799683447739529, 0.0852338438217692257, -0.783762970578423479, -0.076585435689138226, -0.6043060025891554554, -0.658295846696152820, 0.427772530893690217, -0.9288687512327726825, 0.122866182561916254, 0.659408232467282085, 0.0772080094990600374, -0.607348040513722709, -0.108761719100651882, -1.0079608432113262850, -0.017378089000366713, 0.059518597564186392, 0.0955950614351480238, -0.986779686330629513, 0.989890866913205381, 0.0071520817823045348, 0.094691644950703049, 0.713733277219835149, -0.2427293600063723522, -0.328268187306521242, 0.220344503737931546, -0.6353746612195683152, -0.459661643730432223, -0.084703580704062989, -1.0022284232457450148, 0.055740317456252478, -0.059151779416785115, -0.0113377397453605679, -0.976867596293413132, 1.003360458549731771, 0.0365098037316876067, 0.039427150580815938 ), 3, 20)) if( fuzz < max(abs(qminbox20G$loadings - tst ))) { cat("Calculated value is not the same as test value in test Thurstone 6. Value:\n") print(qminbox20G$loadings, digits=18) cat("difference:\n") print(qminbox20G$loadings - tst, digits=18) all.ok <- FALSE } tst <- t(matrix(c( 1.00000000000000000, -0.25676300454795098, -0.32155119431295237, -0.25676300454795098, 1.00000000000000000, 0.33656790396842257, -0.32155119431295237, 0.33656790396842257, 1.00000000000000000 ), 3, 3)) if( fuzz < max(abs(qminbox20G$Phi - tst ))) { cat("Calculated value is not the same as test value in test Thurstone 7. Value:\n") print(qminbox20G$Phi, digits=18) cat("difference:\n") print(qminbox20G$Phi - tst, digits=18) all.ok <- FALSE } #To fuzz precision the rotated loading matrix and the factor cor- #relation matrix phi are identical to those produced using the oblique GP #algorithm with exact derivatives. if( fuzz < max(abs(qminbox20G$Phi - t(qminbox20G$Th )%*% qminbox20G$Th ))) { cat("Calculated value is not the same as test value in test Thurstone 8. Value:\n") print(qminbox20G$Phi, digits=18) cat("difference:\n") print(qminbox20G$Phi - t(qminbox20G$Th )%*% qminbox20G$Th, digits=18) all.ok <- FALSE } #compare quartimin rotation of the initial loading matrix box20. if( fuzz < max(abs(qminbox20G$loadings - box20 %*% solve(t(qminbox20G$Th))))) { cat("Calculated value is not the same as test value in test Thurstone 9. Value:\n") print(qminbox20G$loadings, digits=18) cat("difference:\n") print(qminbox20G$loadings - box20 %*% solve(t(qminbox20G$Th)), digits=18) all.ok <- FALSE } data("box26", package="GPArotation") if (!exists("box26")) stop("Test data box26 not found. Testing stopped.") qbox26 <- GPForth(box26, Tmat=diag(1,3), method="quartimax", eps=1e-5) tst <- t(matrix(c( 0.6245197355925140581, -0.2708954695931116152, 0.7151983951389878635, 0.7386116884036847408, 0.6266342260884526505, -0.0617439911892987553, 0.7803093788467402314, -0.3830982859243221017, -0.4578886072022986253, 0.8540550453155928423, 0.2886436985992582027, 0.4062915145925659610, 0.8810593765418006651, -0.4428658074662961130, 0.1233946983666596581, 0.9084731768740617053, 0.1540526132602804965, -0.3723026715563940159, 0.8150592858039771293, 0.0441965358534676597, 0.5600768044145943980, 0.8466584455973064083, 0.4551177395514792168, 0.1889929089788950356, 0.8156808837280125069, -0.4090629943132625956, 0.3690652552112651530, 0.9629492340906220527, -0.4781483041690369196, -0.0866081507974762743, 0.8731366884896356595, 0.3451069860590937899, -0.2914969834947889749, 0.8921854600753849063, -0.0276323108621970258, -0.4257376659710629951, -0.0938760381595044741, -0.7873218033841372643, 0.6012450975895150540, 0.0938760381595044741, 0.7873218033841372643, -0.6012450975895150540, -0.0986092863860908303, 0.1513605567468480073, 0.9692559984337008050, 0.0986092863860908303, -0.1513605567468480073, -0.9692559984337008050, -0.0189573629854957251, 0.9527983290277913797, 0.2944078167958268377, 0.0189573629854957251, -0.9527983290277913797, -0.2944078167958268377, 0.8394181189595459891, 0.3631767908642606346, 0.3398717995655929913, 0.8703065201362156778, -0.4691145408161159214, 0.0770980453920554615, 0.9141063746617547059, 0.1583184861345137973, -0.3535658252020681958, 0.8348118627305495254, 0.3535663452183119837, 0.3271666140872500073, 0.8541352373790773722, -0.4476738735312740247, 0.0569042988261160704, 0.9034738474019414767, 0.1663655738425987851, -0.3227406124130587362, 0.9861758757457432800, 0.0103496363116840455, 0.0635926656567585569, 0.9643516568468981642, 0.0660181478622221818, -0.0304218028637989850 ), 3, 26)) if( fuzz < max(abs(qbox26$loadings - tst ))) { cat("Calculated value is not the same as test value in test Thurstone 10. Value:\n") print(qbox26$loadings, digits=18) cat("difference:\n") print(qbox26$loadings - tst, digits=18) all.ok <- FALSE } tst <- t(matrix(c( 0.9996572020207266096, 0.0216275672176080257, 0.0147555679097727491, -0.0158190757965277796, 0.9480178905874908635, -0.3178235925273457108, -0.0208622934749700742, 0.3174812237948764770, 0.9480350400953921897 ), 3, 3)) if( fuzz < max(abs(qbox26$Th - tst ))) { cat("Calculated value is not the same as test value in test Thurstone 11. Value:\n") print(qbox26$Th, digits=18) cat("difference:\n") print(qbox26$Th - tst, digits=18) all.ok <- FALSE } qminbox26 <- GPFoblq(box26, Tmat=diag(1,3), method="quartimin", eps=1e-5) tst <- t(matrix(c( 0.6088436426802223966, -0.2567107018725688361, 0.7213648290819488773, 0.7318447535507376367, 0.6298398026581654152, -0.0549983771960348838, 0.7973321695017724364, -0.3855960314746548212, -0.4504478973568259437, 0.8392144987741166906, 0.2994932968625432235, 0.4143558581243267924, 0.8833452352200144020, -0.4361046712803113290, 0.1319331147095905710, 0.9161366872228343672, 0.1535557844336666034, -0.3638337328539109072, 0.7993355454002614158, 0.0571270784641514026, 0.5678963531379384033, 0.8354288250614068101, 0.4626764152757318893, 0.1968789749765105790, 0.8109923806202916641, -0.3989909333845649830, 0.3770226870580207779, 0.9712737747877250305, -0.4740722765307348041, -0.0773243882106463137, 0.8761501947960563808, 0.3456235893514668089, -0.2834183138879167174, 0.9036601763684347643, -0.0290211959776035672, -0.4173652812159966974, -0.0995525797764766768, -0.7788574612781464790, 0.6007791331268093060, 0.0995525797764766768, 0.7788574612781464790, -0.6007791331268093060, -0.1264036712449473909, 0.1653130238928011975, 0.9684661160120416890, 0.1264036712449473909, -0.1653130238928011975, -0.9684661160120416890, -0.0392946742598458687, 0.9571059478962877787, 0.2939285303852590125, 0.0392946742598458687, -0.9571059478962877787, -0.2939285303852590125, 0.8253744379910458173, 0.3729516010405902748, 0.3477554718030251846, 0.8741734789142978634, -0.4631063486451737488, 0.0855349365396926159, 0.9212130243051569467, 0.1581334796580046720, -0.3450412531516501846, 0.8212340853954427367, 0.3631252613622908965, 0.3350076577679809153, 0.8582635618771776720, -0.4420579024138228674, 0.0651757040961165046, 0.9096561314838297330, 0.1665824736284239604, -0.3143133889989875307, 0.9840845767693481294, 0.0168070160966761091, 0.0729425956763933708, 0.9640420478016114014, 0.0709475796833391181, -0.0213192081807395371 ), 3, 26)) if( fuzz < max(abs(qminbox26$loadings - tst ))) { cat("Calculated value is not the same as test value in test Thurstone 12. Value:\n") print(qminbox26$loadings, digits=18) cat("difference:\n") print(qminbox26$loadings - tst, digits=18) all.ok <- FALSE } tst <- t(matrix(c( 1.000000000000000 , 0.00767934084449363279, 0.0170654511973979163, 0.00767934084449363279, 1.000000000000000 , -0.0144994900961642244, 0.01706545119739791630, -0.01449949009616422445, 1.000000000000000 ), 3, 3)) if( fuzz < max(abs(qminbox26$Phi - tst ))) { cat("Calculated value is not the same as test value in test Thurstone 13. Value:\n") print(qminbox26$Phi, digits=18) cat("difference:\n") print(qminbox26$Phi - tst, digits=18) all.ok <- FALSE } tst <- t(matrix(c( 0.9993401424148040668, 0.0347479564402226465, 0.0408645923859655008, -0.0179660947915933414, 0.9476477730670300748, -0.3324117322929439067, -0.0315673755054017430, 0.3174212937474846785, 0.9422486536594960604 ), 3, 3)) if( fuzz < max(abs(qminbox26$Th - tst ))) { cat("Calculated value is not the same as test value in test Thurstone 14. Value:\n") print(qminbox26$Th, digits=18) cat("difference:\n") print(qminbox26$Th - tst, digits=18) all.ok <- FALSE } cat("tests completed.\n") if (! all.ok) stop("some tests FAILED") cat("tests completed.\n") if (! all.ok) stop("some tests FAILED") GPArotation/tests/Revelle.R0000644000176000001440000000072212267353521015363 0ustar ripleyusers# This tests fix for an error caused by an exact initial setting. # (from William Revelle) require("GPArotation") f3 <- structure(c(0, 0, 1, 0, 0, 1, 0, 1, 0, 0, 1, 0, 1, 0, 0, 1, 0,0), .Dim = c(6L, 3L), .Dimnames = list(NULL, c("PC1", "PC2", "PC3"))) f3 # PC1 PC2 PC3 #[1,] 0 0 1 #[2,] 0 1 0 #[3,] 1 0 0 #[4,] 0 0 1 #[5,] 0 1 0 #[6,] 1 0 0 # These previously gave object 'VgQt' not found GPForth(f3) Varimax(f3) GPArotation/tests/rotations.R0000644000176000001440000003771012267353521016016 0ustar ripleyusers# Tests here only compare against values computed previously with this code, # to ensure there was no accidental change. It would be better to have # comparisons with known correct values. # Test for oblimax is commented out as it appears to be unstable. Sys.getenv("R_LIBS") library() require("GPArotation") search() Sys.info() require("stats") require("GPArotation") fuzz <- 1e-6 all.ok <- TRUE data(ability.cov) L <- loadings(factanal(factors = 2, covmat=ability.cov)) if( 0.001 < max(abs(varimax(L, normalize=FALSE)$loadings - Varimax(L, normalize=FALSE)$loadings))) { cat("Calculated difference exceeds tolerance\n") cat("difference:\n") print(varimax(L, normalize=FALSE)$loadings - Varimax(L, normalize=FALSE)$loadings, digits=18) all.ok <- FALSE } if( 0.01 < max(abs(varimax(L, normalize=TRUE)$loadings - Varimax(L, normalize=TRUE, eps=1e-5)$loadings))) { cat("Calculated difference exceeds tolerance\n") cat("difference:\n") print(varimax(L, normalize=TRUE)$loadings - Varimax(L, normalize=TRUE, eps=1e-5)$loadings, digits=18) all.ok <- FALSE } v <- oblimin(L, eps=1e-8)$loadings tst <- t(matrix(c( 0.3863615904740822504, 0.4745127741495974161, -0.0110059418769087539, 0.6458720769633764514, -0.0262926272350604423, 0.8961141105684561348, -0.0180200526810754824, 0.4882928281695405048, 0.9900944939102318543, -0.0370718282544326011, 0.7905657274265397438, 0.0526109550054999417 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 1. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- quartimin(L, eps=1e-8)$loadings tst <- t(matrix(c( 0.3863615904740822504, 0.4745127741495974161, -0.0110059418769087539, 0.6458720769633764514, -0.0262926272350604423, 0.8961141105684561348, -0.0180200526810754824, 0.4882928281695405048, 0.9900944939102318543, -0.0370718282544326011, 0.7905657274265397438, 0.0526109550054999417 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 2. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- targetT(L, Target=matrix(c(rep(1,3),rep(0,6),rep(1,3)), 6,2), eps=1e-5)$loadings tst <- t(matrix(c( 0.551529228817982942, 0.4905002767031292898, 0.217748645523411000, 0.6027046291262584399, 0.291173432863349457, 0.8348885228488550636, 0.154994397662456290, 0.4544843569140373241, 0.969702339393929247, 0.0850652965070581996, 0.803390575440818822, 0.1448091121037717866 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 3. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- targetQ(L, Target=matrix(c(rep(1,3),rep(0,6),rep(1,3)), 6,2), eps=1e-5)$loadings tst <- t(matrix(c( 0.735795682866631218, 0.565351705145453853, 0.433590223819374398, 0.664644550038417159, 0.589924557708411568, 0.920006940799857786, 0.317543426981046928, 0.500590650032113116, 1.021758247914384077, 0.155121528590726393, 0.872521244896209747, 0.208735706420634437 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 4. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } # Does not converge even with maxit=10000, but the loadings matrix is not # changing. Possibly the gradient is extremely large even very close to opt. v <- pstT(L, W = matrix(c(rep(.4,6),rep(.6,6)), 6,2), Target= matrix(c(rep(1,3),rep(0,6),rep(1,3)), 6,2), maxit=1000, eps=1e-5)$loadings tst <- t(matrix(c( 0.37067889993474656407, 0.638257130653133720, 0.01855112570739854416, 0.640564749523800270, 0.01576132191496706567, 0.884065831441111172, 0.00524531003824213384, 0.480158078874985073, 0.89458633399812259590, 0.383762977265515448, 0.71793428958051475064, 0.388556883222951677 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 5. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } # Does not converge even with maxit=10000, but the loadings matrix is not # changing. Possibly the gradient is extremely large even very close to opt. v <- pstQ(L, W = matrix(c(rep(.4,6),rep(.6,6)), 6,2), Target= matrix(c(rep(1,3),rep(0,6),rep(1,3)), 6,2), maxit=1000, eps=1e-5)$loadings tst <- t(matrix(c( 0.573125161748393785, 0.700868331877288475, 0.214899397066479453, 0.681727425525818886, 0.286558275327103040, 0.940272379393286339, 0.152257795885557295, 0.510481967637567036, 1.029289798076480578, 0.462598702071116141, 0.850691132520651205, 0.456859727346562328 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 6. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } # oblimax # this is test value on one computer # tst <- t(matrix(c( # -8111059.94622692652, 8111060.62253121007, # 1495036.43465861562, -1495035.79614594672, # 2331634.63904705830, -2331633.75893370388, # 1356735.91680212389, -1356735.43916810025, # -23187491.19758165255, 23187491.68068471923, # -18357040.58573083207, 18357041.05348757654 # ), 2, 6)) # # this is test value on another computer # tst <- t(matrix(c( # 2694770.06630349346, -2694769.38999920478, # -496701.45733913727, 496702.09585180727, # -774647.63529061736, 774648.51540397422, # -450753.43529273639, 450753.91292676108, # 7703672.48495316971, -7703672.00185009185, # 6098832.71036116872, -6098832.24260441773 # ), 2, 6)) # # this does not converge on all platforms and has large differences possible a mistake ??? # v <- oblimax(L, eps=1e-5)$loadings # if( fuzz < max(abs(v - tst))) { # cat("Calculated value is not the same as test value in test rotations 7. Value:\n") # print(v, digits=18) # cat("difference:\n") # print(v - tst, digits=18) # all.ok <- FALSE # } v <- entropy(L, maxit=3000, eps=1e-5)$loadings tst <- t(matrix(c( 0.528292107548243184, 0.515443945340967824, 0.189686511729033253, 0.612116304198454975, 0.252311894464850861, 0.847442931117894815, 0.133843268148035738, 0.461156452364903380, 0.964740133927989407, 0.129750551769587635, 0.795847094000000532, 0.181751199795689433 ), 2, 6)) if( 0.01 < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 8. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- quartimax(L, eps=1e-5)$loadings tst <- t(matrix(c( 0.534714740804540178, 0.508778102568043678, 0.197348140750149392, 0.609689309353509956, 0.262919828098457153, 0.844212045390758559, 0.139616102327241837, 0.459441658926639795, 0.966291466215733252, 0.117641548844535412, 0.798063848020893585, 0.171756193883937508 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 9. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- Varimax(L, eps=1e-8)$loadings tst <- t(matrix(c( 0.515866523962843160, 0.527879475961036904, 0.175054634278874244, 0.616460231981747930, 0.232057748479543163, 0.853211588623112749, 0.122822468397975171, 0.464213243286899446, 0.961376376417989453, 0.152689863976982837, 0.791292800869773050, 0.200653429940987366 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 10. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- simplimax(L, eps=1e-5)$loadings tst <- t(matrix(c( 0.3384175759313114429, 0.508414890494446547464, -0.0654601124161610648, 0.670992229004664153535, -0.1016231721735353366, 0.930535379393095940515, -0.0589933707274080121, 0.506904360351960181497, 0.9733094402675376289, 0.000234046050254643859, 0.7702037184085044341, 0.085651123319384916965 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 11. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- bentlerT(L, eps=1e-8)$loadings tst <- t(matrix(c( 0.523583611303327312, 0.520226117818945788, 0.184113022124463677, 0.613815719643687197, 0.244596116053327067, 0.849702038129718673, 0.129644684715025493, 0.462354355134084738, 0.963520501269179652, 0.138517057902201340, 0.794161628656258278, 0.188979901644201559 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 12. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- bentlerQ(L, eps=1e-8)$loadings tst <- t(matrix(c( 0.3801726240258240241, 0.4741208368044214638, -0.0223632969057368826, 0.6514196922540864687, -0.0421105927111659756, 0.9039359851665277334, -0.0266594447192576613, 0.4925968005718689424, 0.9961524457620027917, -0.0485973498906049697, 0.7939648477384558811, 0.0440983921679098251 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 13. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- tandemI(L, eps=1e-5)$loadings tst <- t(matrix(c( 0.615424480780047745, 0.4074649925368262759, 0.300894306348887419, 0.5658002819054848143, 0.406455233467338028, 0.7852483408305571677, 0.217785179074990981, 0.4279590047675180808, 0.971977129465111611, -0.0530960591067626969, 0.815800376450207976, 0.0295946184147908228 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 14. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- tandemII(L, eps=1e-5)$loadings tst <- t(matrix(c( 0.512160139332842212, 0.531476249107136312, 0.170736763115044710, 0.617670057812827134, 0.226081850628144149, 0.854814488884392154, 0.119571200821562001, 0.465061309851099225, 0.960284416460420398, 0.159413208985883820, 0.789869387186175276, 0.206185467095899383 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 15. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- geominT(L, eps=1e-5)$loadings tst <- t(matrix(c( 0.572197044101002361, 0.4662247895688098054, 0.243573415560656120, 0.5927388411683653935, 0.326956608263186954, 0.8215352639437966120, 0.174476792179181994, 0.4473668997335142894, 0.972471249855535680, 0.0431091626026945812, 0.808894688433769660, 0.1099794466209375043 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 16. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- geominQ(L, eps=1e-5)$loadings tst <- t(matrix(c( 0.39672053553904490508, 0.4713295988080449250, 0.00424452688463150020, 0.6389466007374070555, -0.00510976786312981532, 0.8864521406378518265, -0.00646959173137159373, 0.4830101828530461994, 0.98709860078485589518, -0.0318959930081098297, 0.79011178369962709045, 0.0558689642678330683 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 17. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- cfT(L, eps=1e-8)$loadings tst <- t(matrix(c( 0.534721263659975854, 0.508771247100584523, 0.197355957387199576, 0.609686779159006154, 0.262930651479430233, 0.844208674501022327, 0.139621992686633722, 0.459439868910532512, 0.966292974385164483, 0.117629160286744874, 0.798066049992627313, 0.171745962120156664 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 18. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- cfQ(L, eps=1e-8)$loadings tst <- t(matrix(c( 0.3863615904740822504, 0.4745127741495974161, -0.0110059418769087539, 0.6458720769633764514, -0.0262926272350604423, 0.8961141105684561348, -0.0180200526810754824, 0.4882928281695405048, 0.9900944939102318543, -0.0370718282544326011, 0.7905657274265397438, 0.0526109550054999417 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 19. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- infomaxT(L, eps=1e-5)$loadings tst <- t(matrix(c( 0.495330443338021176, 0.547195361446864537, 0.151384273205308784, 0.622695868320644275, 0.199304253086364791, 0.861451466010626055, 0.105004533733904976, 0.468565194910632365, 0.954843809781045660, 0.189293503899924942, 0.783052579543945471, 0.230726576980168713 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 20. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- infomaxQ(L, eps=1e-5)$loadings tst <- t(matrix(c( 0.39327554287862442894, 0.4693137508305071925, -0.00319802321222481794, 0.6422985517185823001, -0.01549245038490981718, 0.8912279460026399924, -0.01214605901641467763, 0.4856544522916727002, 0.99260028929193111491, -0.0433225495465055510, 0.79356458059567791530, 0.0471559021503157039 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 21. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } v <- mccammon(L, eps=1e-5)$loadings tst <- t(matrix(c( 0.4293472299617892007, 0.600363196582340275, 0.0790140496845253004, 0.635943490060206229, 0.0992523811009183854, 0.878618107277518656, 0.0506062164774049028, 0.477512622702450096, 0.9268544198491108776, 0.297488850382792269, 0.7514463663627769519, 0.318958389348199534 ), 2, 6)) if( fuzz < max(abs(v - tst))) { cat("Calculated value is not the same as test value in test rotations 22. Value:\n") print(v, digits=18) cat("difference:\n") print(v - tst, digits=18) all.ok <- FALSE } cat("tests completed.\n") if (! all.ok) stop("some tests FAILED") GPArotation/tests/Harman.R0000644000176000001440000001261512267353521015177 0ustar ripleyusers#Example from: Gradient Projection Algorithms and Software for # Arbitrary Rotation Criteria in Factor Analysis. # by Coen A. Bernaards and Robert I. Jennrich # Website: http://www.stat.ucla.edu/research Sys.getenv("R_LIBS") library() require("GPArotation") search() Sys.info() fuzz <- 1e-5 # using eps=1e-5 these tests do not do better than this all.ok <- TRUE # quartimax (orthogonal) rotation of Harman's 8 physical variables. data("Harman", package="GPArotation") qHarman <- GPForth(Harman8, Tmat=diag(2), method="quartimax") qHarman2 <- quartimax(Harman8) if( fuzz < max(abs(qHarman$loadings - qHarman2$loadings))) { cat("Calculated value is not the same as test value in test Harman 1. Value:\n") print(qHarman$loadings, digits=18) cat("difference:\n") print(qHarman$loadings - qHarman2$loadings, digits=18) all.ok <- FALSE } #qHarman$Th - qHarman2$Th # with eps=1e-8 # tst <- t(matrix(c( # 0.898754567491920398, 0.194823580226859222, # 0.933943406208487592, 0.129748657024604030, # 0.902131483644799892, 0.103864268239045668, # 0.876508251941102934, 0.171284220753554678, # 0.315572019798302239, 0.876476069451083251, # 0.251123191235179066, 0.773488941629975613, # 0.198007116064591759, 0.714678376605717203, # 0.307857241091366252, 0.659334451631046314 # ), 2, 8)) # with eps=1e-5 tst <- t(matrix(c( 0.898755404698461491, 0.194819718009510034, 0.933943963768413821, 0.129744643590955028, 0.902131929972106672, 0.103860391510923730, 0.876508987992224209, 0.171280454135453869, 0.315575786273609882, 0.876474713336210853, 0.251126515144778573, 0.773487862471829213, 0.198010187248201075, 0.714677525703678707, 0.307860074444663512, 0.659333128670876345 ), 2, 8)) if( fuzz < max(abs(qHarman$loadings - tst ))) { cat("Calculated value is not the same as test value in test Harman 2. Value:\n") print(qHarman$loadings, digits=18) cat("difference:\n") print(qHarman$loadings - tst, digits=18) all.ok <- FALSE } # with eps=1e-8 # tst <- t(matrix(c( # 0.790828307905322436, 0.612038060430562525, # -0.612038060430562525, 0.790828307905322214 # ), 2, 2)) # with eps=1e-5 tst <- t(matrix(c( 0.790830938007507367, 0.612034662000581764, -0.612034662000581764, 0.790830938007507145 ), 2, 2)) if( fuzz < max(abs(qHarman$Th - tst ))) { cat("Calculated value is not the same as test value in test Harman 3. Value:\n") print(qHarman$Th, digits=18) cat("difference:\n") print(qHarman$Th - tst, digits=18) all.ok <- FALSE } # quartimin (oblique) rotation of Harman's 8 physical variables. qminHarman <- GPFoblq(Harman8, Tmat=diag(2), method="quartimin") qminHarman2 <- quartimin(Harman8) if( fuzz < max(abs(qminHarman$loadings - qminHarman2$loadings))) { cat("Calculated value is not the same as test value in test Harman 4. Value:\n") print(qminHarman$loadings, digits=18) cat("difference:\n") print(qminHarman$loadings - qminHarman2$loadings, digits=18) all.ok <- FALSE } # with eps=1e-8 # tst <- t(matrix(c( # 0.8918217697289939627, 0.0560146456758183961, # 0.9536799985772628219, -0.0232460005406671701, # 0.9291498623396581280, -0.0465027396531852502, # 0.8766828510822184395, 0.0336582451338717017, # 0.0136988312985193428, 0.9250013826349388069, # -0.0172668087945964319, 0.8212535444941218010, # -0.0524468998178311899, 0.7649536381341245361, # 0.0858880630098148856, 0.6831160953442911854 # ),2, 8)) # with eps=1e-5 tst <- t(matrix(c( 0.8918219293548808047, 0.0560145122875230911, 0.9536799846795966928, -0.0232460559140742311, 0.9291497958388006406, -0.0465027685653178480, 0.8766829604751505967, 0.0336581364763500201, 0.0137008854716444972, 0.9250004106413580729, -0.0172649861805529957, 0.8212526839806429946, -0.0524452035885302342, 0.7649528396536503516, 0.0858895830186393733, 0.6831153711863455769 ),2, 8)) if( fuzz < max(abs(qminHarman$loadings - tst ))) { cat("Calculated value is not the same as test value in test Harman 5. Value:\n") print(qminHarman$loadings, digits=18) cat("difference:\n") print(qminHarman$loadings - tst, digits=18) all.ok <- FALSE } # with eps=1e-8 # tst <- t(matrix(c( # 1.000000000000000000, 0.472747617396915065, # 0.472747617396915065, 1.000000000000000000 # ),2, 2)) # with eps=1e-5 tst <- t(matrix(c( 1.000000000000000222, 0.472745958387102538, 0.472745958387102538, 1.000000000000000000 ),2, 2)) if( fuzz < max(abs(qminHarman$Phi - tst ))) { cat("Calculated value is not the same as test value in test Harman 6. Value:\n") print(qminHarman$Phi, digits=18) cat("difference:\n") print(qminHarman$Phi - tst, digits=18) all.ok <- FALSE } # with eps=1e-8 # tst <- t(matrix(c( # 0.878125245495924522, 0.836723841642554422, # -0.478430823863515542, 0.547625065922776710 # ),2, 2)) # with eps=1e-5 tst <- t(matrix(c( 0.878125280760480686, 0.836722770276292271, -0.478430759137962514, 0.547626702874473570 ),2, 2)) if( fuzz < max(abs(qminHarman$Th - tst ))) { cat("Calculated value is not the same as test value in test Harman 7. Value:\n") print(qminHarman$Th, digits=18) cat("difference:\n") print(qminHarman$Th - tst, digits=18) all.ok <- FALSE } cat("tests completed.\n") if (! all.ok) stop("some tests FAILED") GPArotation/NAMESPACE0000644000176000001440000000120012267353521013707 0ustar ripleyusersexport( "GPFoblq", "GPForth") export("Random.Start") export("oblimin") export("quartimin") export("targetT") export("targetQ") export("pstT") export("pstQ") export("oblimax") export("entropy") export("quartimax") export("Varimax") export("simplimax") export("bentlerT") export("bentlerQ") export("tandemI") export("tandemII") export("geominT") export("geominQ") export("cfT") export("cfQ") export("infomaxT") export("infomaxQ") export("mccammon") export("bifactorT") export("bifactorQ") export( "eiv", "echelon") S3method("print", "GPArotation") S3method("summary", "GPArotation") S3method("print", "summary.GPArotation") GPArotation/NEWS0000644000176000001440000000474712434664260013213 0ustar ripleyusersKnown problems o Very occassionally (about 1 in 1000 in monte carlo experiments) the algorithm gets stuck and does not improve (so does not converge). The workaround is to restart with a very slightly perturbed starting point. Changes in GPArotation version 2014.11-1 o Minor format and cleanup required by CRAN checks, no real changes. Changes in GPArotation version 2012.3-1 o no real changes, but bumping version for new CRAN suitability check. Changes in GPArotation version 2011.11-1 o updated maintainer email address. Changes in GPArotation version 2011.10-1 o Modification to vgQ.target to allow NA in target, which is replaced by 0.0 (from William Revelle). o Added bifactorT and bifactorQ (biquartimin) from William Revelle. Changes in GPArotation version 2010.07-1 o Fix an error caused by an exact initial setting (from William Revelle). Changes in GPArotation version 2009.02-2 o Standardized NEWS format for new function news(). Changes in GPArotation version 2009.02-1 o minor documentation corrections as found by a new R-devel. Changes in GPArotation version 2008.05-1 o added echelon rotation. o added gradient Gq to result list from GPForth and GPFoblq. o change license from "GPL-2" to "GPL-2 or later". Changes in GPArotation version 2007.06-1 o fixed a couple of lingering $Lh (in print and summary methods) that should have been changed to $loadings. Changes in GPArotation version 2007.04-1 o removed an extra comma in c() that caused a test failure with R-2.5.0 o added eiv rotation. o renamed $Lh in the result from GPForth and GPFoblq to $loadings. As a result, rotation methods calling these function no longer need to rename this element in order to work with factanal and other programs. (It is a good idea to use the extractor function loadings() rather than refer directly to object structure.) o changed rotation method functions to return all elements of GPFoblq and GFForth. o fixed the documentation file primary alias for all rotations (which was being called oblimin). Changes in GPArotation version 2006.2-2 o extra argument (...) to invisible in print.GPArotation was removed. Changes in GPArotation version 2006.2-1 o broken references in documentation were fixed and updated. Changes in GPArotation version 2005.10-1 o warning message about non-convergence expanded to indicate function. GPArotation version 2005.4-1 o First released version. GPArotation/data/0000755000176000001440000000000012434664410013406 5ustar ripleyusersGPArotation/data/WansbeekMeijer.rda0000644000176000001440000000054612434664410016776 0ustar ripleyusers r0b```b`fdb`b2Y# 'K-H-IK)  `j/+bUnGV 7|/}\}ۉWKW~ȦrW_18S'[,#>\'k=D\yN0:%JNVJBhcNR`00p@ GPArotation/data/Thurstone.rda0000644000176000001440000000142412434664410016072 0ustar ripleyusersmSiHTQ~&%%"aba%aff !!H+ 3 $"B"V"2Qhn3:F,к3х}ΞsC4bL$\47msfmb י&`,ɴ)O0VV *Sss'' ~ [XkHԂ CS [Tib0b|xwh.BwӇ .2B3jHzOtj:dx?{T')5%q% 5\ 45P ?4Gyd3{$6%^6#v貅}pc ttTJ~JL8C0/C~JTpJpƌkR:q}Us&ULX_uàQdvqTHߨOF3[GU0يVt26Gf8*eWQB^*EQfGi:SS{" [?5^:Rd!uyGLʯ%G qD\"G G'.c8(6IE鶁0_FcTm7~GPArotation/R/0000755000176000001440000000000012267353520012677 5ustar ripleyusersGPArotation/R/echelon.R0000644000176000001440000000201212267353520014432 0ustar ripleyusersechelon <- function(L, reference=seq(NCOL(L)), ...) { # Split L in reference part and the rest A1 <- L[reference,, drop=FALSE] #A2 is L[-reference,] # Compute the part of A Phi A' corresponding to the reference variables # Compute cholesky rot = rotated reference part # No check or error message for singularity. Exact singularity is rare in # practice but ill-conditioning is a real danger. # now assuming orthogonal (Phi=I) #newPhi <- if (is.null(Phi)) A1 %*% t(A1) else A1 %*% Phi %*% t(A1) #B1 <- t(chol(newPhi)) B1 <- t(chol(A1 %*% t(A1))) # Transformation matrix: B1 = A1 * Tmat # Rotated solution for non-reference part: B2 = A2 * Tmat Tmat <- solve(A1, B1) # Assemble rotated solution B <- matrix(0, NROW(L), NCOL(L)) B[reference,] <- B1 B[-reference,] <- L[-reference,, drop=FALSE] %*% Tmat dimnames(B) <- list(dimnames(L)[[1]], paste("factor", seq(NCOL(L)))) list(loadings=B, Th=Tmat, method="echelon", orthogonal=TRUE, convergence=TRUE) } GPArotation/R/eiv.R0000644000176000001440000000110112267353520013576 0ustar ripleyuserseiv <- function(L, identity=seq(NCOL(L)), ...){ A1 <- L[ identity, , drop=FALSE] g <- solve(A1) if(1e-14 < max(abs(diag(1, length(identity)) - A1 %*% g))) warning("Inverse is not well conditioned. Consider setting identity to select different rows.") B <- array(NA, dim(L)) B[identity, ] <- diag(1, length(identity)) B[-identity,] <- L[-identity,, drop=FALSE] %*% g dimnames(B) <- list(dimnames(L)[[1]], paste("factor", seq(NCOL(L)))) list(loadings=B, Th=t(A1), method="eiv", orthogonal=FALSE, convergence=TRUE, Phi= tcrossprod(A1)) } GPArotation/R/GPArotation.R0000644000176000001440000004216012267353520015214 0ustar ripleyusersRandom.Start <- function(k){ qr.Q(qr(matrix(rnorm(k*k),k))) } NormalizingWeight <- function(A, normalize=FALSE){ if ("function" == mode(normalize)) normalize <- normalize(A) if (is.logical(normalize)){ if (normalize) normalize <- sqrt(rowSums(A^2)) else return(array(1, dim(A))) } if (is.vector(normalize)) {if(nrow(A) != length(normalize)) stop("normalize length wrong in NormalizingWeight") return(array(normalize, dim(A))) } stop("normalize argument not recognized in NormalizingWeight") } print.GPArotation <- function (x, digits=3, Table=FALSE, ...){ cat(if(x$orthogonal)"Orthogonal" else "Oblique") cat(" rotation method", x$method) cat((if(!x$convergence)" NOT" ), "converged.\n") cat("Loadings:\n") print(x$loadings, digits=digits) cat("\nRotating matrix:\n") print(t(solve(x$Th)), digits=digits) if(!x$orthogonal){ cat("\nPhi:\n") print(x$Phi, digits=digits) } if(Table){ cat("\nIteration table:\n") print(x$Table, digits=digits) } invisible(x) } summary.GPArotation <- function (object, ...){ r <- list(loadings=object$loadings, method=object$method, orthogonal=object$orthogonal, convergence=object$convergence, iters=nrow(object$Table)) class(r) <- "summary.GPArotation" r } print.summary.GPArotation <- function (x, digits=3, ...){ cat(if(x$orthogonal)"Orthogonal" else "Oblique") cat(" rotation method", x$method) if(!x$convergence) cat(" NOT" ) cat(" converged in ", x$iter, " iterations.\n") cat("Loadings:\n") print(x$loadings, digits=digits) } GPForth <- function(A, Tmat=diag(ncol(A)), normalize=FALSE, eps=1e-5, maxit=1000, method="varimax", methodArgs=NULL){ if((!is.logical(normalize)) || normalize) { W <- NormalizingWeight(A, normalize=normalize) normalize <- TRUE A <- A/W } if(1 >= ncol(A)) stop("rotation does not make sense for single factor models.") al <- 1 L <- A %*% Tmat #Method <- get(paste("vgQ",method,sep=".")) #VgQ <- Method(L, ...) Method <- paste("vgQ",method,sep=".") VgQ <- do.call(Method, append(list(L), methodArgs)) G <- crossprod(A,VgQ$Gq) f <- VgQ$f Table <- NULL #set initial value for the unusual case of an exact initial solution VgQt <- do.call(Method, append(list(L), methodArgs)) for (iter in 0:maxit){ M <- crossprod(Tmat,G) S <- (M + t(M))/2 Gp <- G - Tmat %*% S s <- sqrt(sum(diag(crossprod(Gp)))) Table <- rbind(Table, c(iter, f, log10(s), al)) if (s < eps) break al <- 2*al for (i in 0:10){ X <- Tmat - al * Gp UDV <- svd(X) Tmatt <- UDV$u %*% t(UDV$v) L <- A %*% Tmatt #VgQt <- Method(L, ...) VgQt <- do.call(Method, append(list(L), methodArgs)) if (VgQt$f < (f - 0.5*s^2*al)) break al <- al/2 } Tmat <- Tmatt f <- VgQt$f G <- crossprod(A,VgQt$Gq) } convergence <- (s < eps) if ((iter == maxit) & !convergence) warning("convergence not obtained in GPForth. ", maxit, " iterations used.") if(normalize) L <- L * W dimnames(L) <- dimnames(A) r <- list(loadings=L, Th=Tmat, Table=Table, method=VgQ$Method, orthogonal=TRUE, convergence=convergence, Gq=VgQt$Gq) class(r) <- "GPArotation" r } GPFoblq <- function(A, Tmat=diag(ncol(A)), normalize=FALSE, eps=1e-5, maxit=1000, method="quartimin", methodArgs=NULL){ if(1 >= ncol(A)) stop("rotation does not make sense for single factor models.") if((!is.logical(normalize)) || normalize) { W <- NormalizingWeight(A, normalize=normalize) normalize <- TRUE A <- A/W } al <- 1 L <- A %*% t(solve(Tmat)) #Method <- get(paste("vgQ",method,sep=".")) #VgQ <- Method(L, ...) Method <- paste("vgQ",method,sep=".") VgQ <- do.call(Method, append(list(L), methodArgs)) G <- -t(t(L) %*% VgQ$Gq %*% solve(Tmat)) f <- VgQ$f Table <- NULL #Table <- c(-1,f,log10(sqrt(sum(diag(crossprod(G))))),al) #set initial value for the unusual case of an exact initial solution VgQt <- do.call(Method, append(list(L), methodArgs)) for (iter in 0:maxit){ Gp <- G - Tmat %*% diag(c(rep(1,nrow(G)) %*% (Tmat*G))) s <- sqrt(sum(diag(crossprod(Gp)))) Table <- rbind(Table,c(iter,f,log10(s),al)) if (s < eps) break al <- 2*al for (i in 0:10){ X <- Tmat - al*Gp v <- 1/sqrt(c(rep(1,nrow(X)) %*% X^2)) Tmatt <- X %*% diag(v) L <- A %*% t(solve(Tmatt)) #VgQt <- Method(L, ...) VgQt <- do.call(Method, append(list(L), methodArgs)) improvement <- f - VgQt$f if (improvement > 0.5*s^2*al) break al <- al/2 } Tmat <- Tmatt f <- VgQt$f G <- -t(t(L) %*% VgQt$Gq %*% solve(Tmatt)) } convergence <- (s < eps) if ((iter == maxit) & !convergence) warning("convergence not obtained in GPFoblq. ", maxit, " iterations used.") if(normalize) L <- L * W dimnames(L) <- dimnames(A) # N.B. renaming Lh to loadings in specificific rotations # uses fact that Lh is first. r <- list(loadings=L, Phi=t(Tmat) %*% Tmat, Th=Tmat, Table=Table, method=VgQ$Method, orthogonal=FALSE, convergence=convergence, Gq=VgQt$Gq) class(r) <- "GPArotation" r } ####################### oblimin <- function(L, Tmat=diag(ncol(L)), gam=0, normalize=FALSE, eps=1e-5, maxit=1000){ GPFoblq(L, Tmat=Tmat, normalize=normalize, eps=eps, maxit=maxit, method="oblimin", methodArgs=list(gam=gam)) } vgQ.oblimin <- function(L, gam=0){ X <- L^2 %*% (!diag(TRUE,ncol(L))) if (0 != gam) { p <- nrow(L) X <- (diag(1,p) - matrix(gam/p,p,p)) %*% X } list(Gq=L*X, f=sum(L^2 * X)/4, Method= if (gam == 0) "Oblimin Quartimin" else if (gam == .5) "Oblimin Biquartimin" else if (gam == 1) "Oblimin Covarimin" else paste("Oblimin g=", gam,sep="") ) } # original # vgQ.oblimin <- function(L, gam=0){ # Method <- paste("Oblimin g=",gam,sep="") # if (gam == 0) Method <- "Oblimin Quartimin" # if (gam == .5) Method <- "Oblimin Biquartimin" # if (gam == 1) Method <- "Oblimin Covarimin" # k <- ncol(L) # p <- nrow(L) # N <- matrix(1,k,k)-diag(k) # f <- sum(L^2 * (diag(p)-gam*matrix(1/p,p,p)) %*% L^2 %*% N)/4 # Gq <- L * ((diag(p)-gam*matrix(1/p,p,p)) %*% L^2 %*% N) # return(list(Gq=Gq,f=f,Method=Method)) # } ##vgQ.oblimin(FA2)$f - vgQ.origoblimin(FA2)$f #vgQ.oblimin(FA2)$Gq - vgQ.origoblimin(FA2)$Gq quartimin <- function(L, Tmat=diag(ncol(L)), normalize=FALSE, eps=1e-5, maxit=1000){ GPFoblq(L, Tmat=Tmat, method="quartimin", normalize=normalize, eps=eps, maxit=maxit) } vgQ.quartimin <- function(L){ X <- L^2 %*% (!diag(TRUE,ncol(L))) list(Gq= L*X, f= sum(L^2 * X)/4, Method= "Quartimin" ) } #original #vgQ.quartimin <- function(L){ # Method="Quartimin" # L2 <- L^2 # k <- ncol(L) # M <- matrix(1,k,k)-diag(k) # f <- sum(L2 * (L2 %*% M))/4 # Gq <- L * (L2 %*% M) # return(list(Gq=Gq,f=f,Method=Method)) #} targetT <- function(L, Tmat=diag(ncol(L)), Target=NULL, normalize=FALSE, eps=1e-5, maxit=1000) { if(is.null(Target)) stop("argument Target must be specified.") GPForth(L, Tmat=Tmat, normalize=normalize, eps=eps, maxit=maxit, method="target", methodArgs=list(Target=Target)) } targetQ <- function(L, Tmat=diag(ncol(L)), Target=NULL, normalize=FALSE, eps=1e-5, maxit=1000) { if(is.null(Target)) stop("argument Target must be specified.") GPFoblq(L, Tmat=Tmat, normalize=normalize, eps=eps, maxit=maxit, method="target", methodArgs=list(Target=Target)) } vgQ.target <- function(L, Target=NULL){ if(is.null(Target)) stop("argument Target must be specified.") # e.g. Target <- matrix(c(rep(NA,4),rep(0,8),rep(NA,4)),8) # approximates Michael Brown approach Gq <- 2 * (L - Target) Gq[is.na(Gq)] <- 0 #missing elements in target do not affect the first derivative list(Gq=Gq, f=sum((L-Target)^2, na.rm=TRUE), Method="Target rotation") #The target rotation ? option in Michael Browne's algorithm should be NA } pstT <- function(L, Tmat=diag(ncol(L)), W=NULL, Target=NULL, normalize=FALSE, eps=1e-5, maxit=1000) { if(is.null(W)) stop("argument W must be specified.") if(is.null(Target)) stop("argument Target must be specified.") GPForth(L, Tmat=Tmat, normalize=normalize, eps=eps, maxit=maxit, method="pst", methodArgs=list(W=W, Target=Target)) } pstQ <- function(L, Tmat=diag(ncol(L)), W=NULL, Target=NULL, normalize=FALSE, eps=1e-5, maxit=1000) { if(is.null(W)) stop("argument W must be specified.") if(is.null(Target)) stop("argument Target must be specified.") GPFoblq(L, Tmat=Tmat, normalize=normalize, eps=eps, maxit=maxit, method="pst", methodArgs=list(W=W, Target=Target)) } vgQ.pst <- function(L, W=NULL, Target=NULL){ if(is.null(W)) stop("argument W must be specified.") if(is.null(Target)) stop("argument Target must be specified.") # Needs weight matrix W with 1's at specified values, 0 otherwise # e.g. W = matrix(c(rep(1,4),rep(0,8),rep(1,4)),8). # When W has only 1's this is procrustes rotation # Needs a Target matrix Target with hypothesized factor loadings. # e.g. Target = matrix(0,8,2) Btilde <- W * Target list(Gq= 2*(W*L-Btilde), f = sum((W*L-Btilde)^2), Method="Partially specified target") } oblimax <- function(L, Tmat=diag(ncol(L)), normalize=FALSE, eps=1e-5, maxit=1000){ GPFoblq(L, Tmat=Tmat, normalize=normalize, eps=eps, maxit=maxit, method="oblimax") } vgQ.oblimax <- function(L){ list(Gq= -(4*L^3/(sum(L^4))-4*L/(sum(L^2))), f= -(log(sum(L^4))-2*log(sum(L^2))), Method="oblimax") } entropy <- function(L, Tmat=diag(ncol(L)), normalize=FALSE, eps=1e-5, maxit=1000) { GPForth(L, Tmat=Tmat, method="entropy", normalize=normalize, eps=eps, maxit=maxit) } vgQ.entropy <- function(L){ list(Gq= -(L*log(L^2 + (L^2==0)) + L), f= -sum(L^2*log(L^2 + (L^2==0)))/2, Method="Minimum entropy") } quartimax <- function(L, Tmat=diag(ncol(L)), normalize=FALSE, eps=1e-5, maxit=1000) { GPForth(L, Tmat=Tmat, method="quartimax", normalize=normalize, eps=eps, maxit=maxit) } vgQ.quartimax <- function(L){ list(Gq= -L^3, f= -sum(diag(crossprod(L^2)))/4, Method="Quartimax") } Varimax <- function(L, Tmat=diag(ncol(L)), normalize=FALSE, eps=1e-5, maxit=1000) { GPForth(L, Tmat=Tmat, method="varimax", normalize=normalize, eps=eps, maxit=maxit) } vgQ.varimax <- function(L){ QL <- sweep(L^2,2,colMeans(L^2),"-") list(Gq= -L * QL, f= -sqrt(sum(diag(crossprod(QL))))^2/4, Method="varimax") } simplimax <- function(L, Tmat=diag(ncol(L)), k=nrow(L), normalize=FALSE, eps=1e-5, maxit=1000) { GPFoblq(L, Tmat=Tmat, normalize=normalize, eps=eps, maxit=maxit, method="simplimax", methodArgs=list(k=k)) } vgQ.simplimax <- function(L, k=nrow(L)){ # k: Number of close to zero loadings Imat <- sign(L^2 <= sort(L^2)[k]) list(Gq= 2*Imat*L, f= sum(Imat*L^2), Method="Simplimax") } bentlerT <- function(L, Tmat=diag(ncol(L)), normalize=FALSE, eps=1e-5, maxit=1000) { GPForth(L, Tmat=Tmat, normalize=normalize, eps=eps, maxit=maxit, method="bentler") } bentlerQ <- function(L, Tmat=diag(ncol(L)), normalize=FALSE, eps=1e-5, maxit=1000) { GPFoblq(L, Tmat=Tmat, normalize=normalize, eps=eps, maxit=maxit, method="bentler") } vgQ.bentler <- function(L){ L2 <- L^2 M <- crossprod(L2) D <- diag(diag(M)) list(Gq= -L * (L2 %*% (solve(M)-solve(D))), f= -(log(det(M))-log(det(D)))/4, Method="Bentler's criterion") } tandemI <- function(L, Tmat=diag(ncol(L)), normalize=FALSE, eps=1e-5, maxit=1000) { GPForth(L, Tmat=Tmat, normalize=normalize, eps=eps, maxit=maxit, method="tandemI") } #vgQ.tandemI <- function(L){ # Tandem Criterion, Comrey, 1967. # Method <- "Tandem I" # LL <- (L %*% t(L)) # LL2 <- LL^2 # f <- -sum(diag(crossprod(L^2, LL2 %*% L^2))) # Gq1 <- 4 * L *(LL2 %*% L^2) # Gq2 <- 4 * (LL * (L^2 %*% t(L^2))) %*% L # Gq <- -Gq1 - Gq2 # return(list(Gq=Gq,f=f,Method=Method)) #} vgQ.tandemI <- function(L){ # Tandem Criterion, Comrey, 1967. LL <- (L %*% t(L)) LL2 <- LL^2 Gq1 <- 4 * L *(LL2 %*% L^2) Gq2 <- 4 * (LL * (L^2 %*% t(L^2))) %*% L Gq <- -Gq1 - Gq2 list(Gq=Gq, f= -sum(diag(crossprod(L^2, LL2 %*% L^2))), Method="Tandem I") } tandemII <- function(L, Tmat=diag(ncol(L)), normalize=FALSE, eps=1e-5, maxit=1000) { GPForth(L, Tmat=Tmat, method="tandemII", normalize=normalize, eps=eps, maxit=maxit) } vgQ.tandemII <- function(L){ # Tandem Criterion, Comrey, 1967. LL <- (L %*% t(L)) LL2 <- LL^2 f <- sum(diag(crossprod(L^2, (1-LL2) %*% L^2))) Gq1 <- 4 * L *((1-LL2) %*% L^2) Gq2 <- 4 * (LL * (L^2 %*% t(L^2))) %*% L Gq <- Gq1 - Gq2 list(Gq=Gq, f=f, Method="Tandem II") } geominT <- function(L, Tmat=diag(ncol(L)), delta=.01, normalize=FALSE, eps=1e-5, maxit=1000){ GPForth(L, Tmat=Tmat, normalize=normalize, eps=eps, maxit=maxit, method="geomin", methodArgs=list(delta=delta)) } geominQ <- function(L, Tmat=diag(ncol(L)), delta=.01, normalize=FALSE, eps=1e-5, maxit=1000){ GPFoblq(L, Tmat=Tmat, normalize=normalize, eps=eps, maxit=maxit, method="geomin", methodArgs=list(delta=delta)) } vgQ.geomin <- function(L, delta=.01){ k <- ncol(L) p <- nrow(L) L2 <- L^2 + delta pro <- exp(rowSums(log(L2))/k) list(Gq=(2/k)*(L/L2)*matrix(rep(pro,k),p), f= sum(pro), Method="Geomin") } cfT <- function(L, Tmat=diag(ncol(L)), kappa=0, normalize=FALSE, eps=1e-5, maxit=1000) { GPForth(L, Tmat=Tmat, normalize=normalize, eps=eps, maxit=maxit, method="cf", methodArgs=list(kappa=kappa)) } cfQ <- function(L, Tmat=diag(ncol(L)), kappa=0, normalize=FALSE, eps=1e-5, maxit=1000) { GPFoblq(L, Tmat=Tmat, normalize=normalize, eps=eps, maxit=maxit, method="cf", methodArgs=list(kappa=kappa)) } vgQ.cf <- function(L, kappa=0){ k <- ncol(L) p <- nrow(L) # kappa <- 0 # quartimax # kappa <- 1/p # varimax # kappa <- m/(2*p) # equamax # kappa <- (m-1)/(p+m-2) # parsimax # kappa <- 1 # factor parsimony N <- matrix(1,k,k)-diag(k) M <- matrix(1,p,p)-diag(p) L2 <- L^2 f1 <- (1-kappa)*sum(diag(crossprod(L2,L2 %*% N)))/4 f2 <- kappa*sum(diag(crossprod(L2,M %*% L2)))/4 list(Gq= (1-kappa) * L * (L2 %*% N) + kappa * L * (M %*% L2), f= f1 + f2, Method=paste("Crawford-Ferguson:k=",kappa,sep="")) } infomaxT <- function(L, Tmat=diag(ncol(L)), normalize=FALSE, eps=1e-5, maxit=1000) { GPForth(L, Tmat=Tmat, normalize=normalize, eps=eps, maxit=maxit, method="infomax") } infomaxQ <- function(L, Tmat=diag(ncol(L)), normalize=FALSE, eps=1e-5, maxit=1000) { GPFoblq(L, Tmat=Tmat, normalize=normalize, eps=eps, maxit=maxit, method="infomax") } vgQ.infomax <- function(L){ Method <- "Infomax" k <- ncol(L) p <- nrow(L) S <- L^2 s <- sum(S) s1 <- rowSums(S) s2 <- colSums(S) E <- S/s e1 <- s1/s e2 <- s2/s Q0 <- sum(-E * log(E)) Q1 <- sum(-e1 * log(e1)) Q2 <- sum(-e2 * log(e2)) f <- log(k) + Q0 - Q1 - Q2 H <- -(log(E) + 1) alpha <- sum(S * H)/s^2 G0 <- H/s - alpha * matrix(1, p, k) h1 <- -(log(e1) + 1) alpha1 <- s1 %*% h1/s^2 G1 <- matrix(rep(h1,k), p)/s - as.vector(alpha1) * matrix(1, p, k) h2 <- -(log(e2) + 1) alpha2 <- h2 %*% s2/s^2 G2 <- matrix(rep(h2,p), ncol=k, byrow=T)/s - as.vector(alpha2) * matrix(1, p, k) Gq <- 2 * L * (G0 - G1 - G2) list(Gq=Gq,f=f,Method=Method) } mccammon <- function(L, Tmat=diag(ncol(L)), normalize=FALSE, eps=1e-5, maxit=1000) { GPForth(L, Tmat=Tmat, method="mccammon", normalize=normalize, eps=eps, maxit=maxit) } vgQ.mccammon <- function(L){ Method <- "McCammon entropy" k <- ncol(L) p <- nrow(L) S <- L^2 M <- matrix(1,p,p) s2 <- colSums(S) P <- S / matrix(rep(s2,p),ncol=k,byrow=T) Q1 <- -sum(P * log(P)) H <- -(log(P) + 1) R <- M %*% S G1 <- H/R - M %*% (S*H/R^2) s <- sum(S) p2 <- s2/s Q2 <- -sum(p2 * log(p2)) h <- -(log(p2) + 1) alpha <- h %*% p2 G2 <- rep(1,p) %*% t(h)/s - as.vector(alpha)*matrix(1,p,k) Gq <- 2*L*(G1/Q1 - G2/Q2) Q <- log(Q1) - log(Q2) list(Gq=Gq, f=Q, Method=Method) } bifactorT <- function(L, Tmat=diag(ncol(L)), normalize=FALSE, eps=1e-5, maxit=1000){ #adapted from Jennrich and Bentler 2011. code provided by William Revelle GPForth(L, Tmat=Tmat, normalize=normalize, eps=eps, maxit=maxit, method="bifactor") } bifactorQ <- function(L, Tmat=diag(ncol(L)), normalize=FALSE, eps=1e-5, maxit=1000){ #the oblique case #adapted from Jennrich and Bentler 2011. code provided by William Revelle GPFoblq(L, Tmat=Tmat, normalize=normalize, eps=eps, maxit=maxit, method="bifactor") } vgQ.bifactor <- function(L) { # code provided by William Revelle D <- function(L) { L2 <- L^2 L2N <- L2 %*% ! diag(NCOL(L)) list(f=sum(L2 * L2N), Gq=4 * L * L2N) } lvg <- D(L[,-1, drop=FALSE]) G <- lvg$Gq G <-cbind(G[,1],G) G[,1] <- 0 list(f=lvg$f, Gq=G) } # promax is already defined in the stats (previously mva) package # #GPromax <- function(A,pow=3){ # method <- "Promax" # # Initial rotation: Standardized Varimax # require(statsa) # xx <- promax(A,pow) # Lh <- xx$loadings # Th <- xx$rotmat # orthogonal <- F # Table <- NULL #return(list(loadings=Lh,Th=Th,Table=NULL,method,orthogonal=orthogonal)) #} GPArotation/vignettes/0000755000176000001440000000000012434664410014505 5ustar ripleyusersGPArotation/vignettes/Guide.Stex0000644000176000001440000000224412267353521016413 0ustar ripleyusers\documentclass[english]{article} \begin{document} %\VignetteIndexEntry{gpa Guide} \SweaveOpts{eval=TRUE,echo=TRUE,results=hide,fig=FALSE} \begin{Scode}{echo=FALSE,results=hide} options(continue=" ") \end{Scode} \section{GPArotation Functions} In R, the functions in this package are made available with \begin{Scode} library("GPArotation") \end{Scode} The most complete reference for the software is: Bernaards, C.A. and Jennrich, R.I. (in press) Gradient Projection Algorithms and Software for Arbitrary Rotation Criteria in Factor Analysis. Educational and Psychological Measurement. Addition material is also available at . Rotations are computed using the Gradient Projection Algorithm code, which can be called directly. Examples of this are available in the help pages for \emph{GPForth} and \emph{GPFoblq}. In R it may be most convenient to pass the rotation name to the factanal program. An example of this is \begin{Scode} data(ability.cov) z <- factanal(factors = 2, covmat = ability.cov, rotation="oblimin") loadings(z) \end{Scode} Other examples are available in the help page for \emph{rotations}. \end{document} GPArotation/MD50000644000176000001440000000331612435031140012775 0ustar ripleyusers439f9298395b06ba4ff976e008b1f94d *DESCRIPTION d4a3bd4a8f3c6b4c6cf6429c9071dfba *LICENSE ba9b69ae2a140c167879cf1c0be34077 *NAMESPACE c288c8213715a2b5f433934595292f44 *NEWS b5551fa45d1d439ac3006c6b05c0bb8f *R/GPArotation.R b2283c391ae6a2be35b3fdd08ac120d0 *R/echelon.R 0d865c154a7c2323eced4a2dc5300f92 *R/eiv.R 63dedc7efc3a9c78ff4250b2d461751d *build/vignette.rds d0e30feae95799d634da12491cc1b4f7 *data/Harman.rda 71a58ba18ad74e07ee8ab6a2485bbe45 *data/Thurstone.rda a425cfd8fbea2975fbac977d1a8e4a3f *data/WansbeekMeijer.rda c6f23ac0d16d8ad1a808ec6730766b43 *inst/CITATION 0e5a1c8a16de57655ffbf4edd867400f *inst/doc/Guide.Stex fd15e47dd9d7cdbe36948b81fccd9353 *inst/doc/Guide.pdf 1bb1f25e383cbee9ca542135395b6be5 *man/00.GPArotation.Intro.Rd e8465199f545ff3d38c321acd2e9b69b *man/GPA.Rd 2742c7a83136925d0eba8d150af3a621 *man/GPArotation-package.Rd b07d349e1b8f30647094651a5d2a0afd *man/Harman.Rd 57669df551f03effac6c7c50386aeb2b *man/NormalizingWeight.Rd 8d165e846c49cd7aca68f24392d32245 *man/Random.Start.Rd 1b2feb8eed2d7acc01d9bf6c4b926c6b *man/Thurstone.Rd c172806d91b6ead4f5586323cc3b0d68 *man/WansbeekMeijer.Rd 6d6131cbf00420833323ee4acea45672 *man/echelon.Rd 38433de7a3c98490a03151b76c310134 *man/eiv.Rd 2565ffa99e24fdc70dd9766fbdc0c0ef *man/print.GPArotation.Rd 5bca2b2e11d3d8d3b3d6ed0171fdfc59 *man/rotations.Rd 676d839d54d47a340f6ba36a5934221b *tests/Harman.R 7603d428a70927d632a9ab2225cd2892 *tests/Jennrich2002.R 781b18f963b96896b8db5224e710ebd1 *tests/MASSoblimin.R 46d697ec9edc75bcc1822dbdae7c3f0f *tests/Revelle.R 4a45741f72f718179f8070cf11681727 *tests/Thurstone.R 721c8721d216481c1af1e14680c61627 *tests/WansbeekMeijer.R d7a3d6ce00384e8d54ad36310085087f *tests/rotations.R 0e5a1c8a16de57655ffbf4edd867400f *vignettes/Guide.Stex GPArotation/build/0000755000176000001440000000000012434664410013574 5ustar ripleyusersGPArotation/build/vignette.rds0000644000176000001440000000030412434664410016130 0ustar ripleyusersb```b`fdb`b2 1# 'r/LI .I@L/HTˢK@IC$ !@„5/17]KjAj^ HvѴpxVaaqIY0AAn0Ez0?¸Ht&${+%$Q/nGPArotation/DESCRIPTION0000644000176000001440000000076612435031140014201 0ustar ripleyusersPackage: GPArotation Version: 2014.11-1 Title: GPA Factor Rotation Description: Gradient Projection Algorithm Rotation for Factor Analysis. See ?GPArotation.Intro for more details. Depends: R (>= 2.0.0) LazyLoad: yes License: GPL (>= 2) | file LICENSE Author: Coen Bernaards and Robert Jennrich Maintainer: Paul Gilbert URL: http://www.stat.ucla.edu/research/gpa Packaged: 2014-11-24 17:21:12 UTC; paul NeedsCompilation: no Repository: CRAN Date/Publication: 2014-11-25 08:40:16 GPArotation/man/0000755000176000001440000000000012434664255013257 5ustar ripleyusersGPArotation/man/WansbeekMeijer.Rd0000644000176000001440000000117712267353521016442 0ustar ripleyusers\name{WansbeekMeijer} \docType{data} \alias{WansbeekMeijer} \alias{NetherlandsTV} \title{Factor Example from Wansbeek and Meijer} \description{ Netherlands TV viewership example p 171, Wansbeek and Meijer (2000) } \usage{ data(WansbeekMeijer) } \details{ The object NetherlandsTV is loaded from the data file WansbeekMeijer. } \format{ The object NetherlandsTV is a correlation matrix. } \source{ Tom Wansbeek and Erik Meijer (2000) \emph{Measurement Error and Latent Variables in Econometrics}, Amsterdam: North-Holland. } \seealso{ \code{\link{GPForth}}, \code{\link{Thurstone}}, \code{\link{Harman}} } \keyword{datasets} GPArotation/man/NormalizingWeight.Rd0000644000176000001440000000056212267353521017205 0ustar ripleyusers\name{NormalizingWeight} \alias{NormalizingWeight} \title{Internal Utility for Normalizing Weights} \usage{ NormalizingWeight(A, normalize=FALSE) } \arguments{ \item{A}{A loading matrix.} \item{normalize}{An indication of if/how the matrix should be normalized.} } \description{ See GPFobliq and GPForth. } \value{A matrix.} \keyword{internal} GPArotation/man/Thurstone.Rd0000644000176000001440000000110012267353521015524 0ustar ripleyusers\name{Thurstone} \docType{data} \alias{Thurstone} \alias{box20} \alias{box26} \title{Example Data from Thurstone} \description{ box20 and box26 are initial factor loading matrices. } \usage{ data(Thurstone) } \details{ The objects box20 and box26 are loaded from the data file Thurstone. } \format{ The objects box20 and box26 are matrices. } \source{ Thurstone, L.L. (1947). \emph{Multiple Factor Analysis}. Chicago: University of Chicago Press. } \seealso{ \code{\link{GPForth}}, \code{\link{Harman}}, \code{\link{WansbeekMeijer}} } \keyword{datasets} GPArotation/man/eiv.Rd0000644000176000001440000001013612267353521014325 0ustar ripleyusers\encoding{latin1} \name{eiv} \alias{eiv} \title{Errors-in-Variables Rotation} \usage{ eiv(L, identity=seq(NCOL(L)), ...) } \arguments{ \item{L}{a factor loading matrix} \item{identity}{indicates rows which should be identity matrix.} \item{...}{additional arguments discarded.} } \value{A list (which includes elements used by \code{factanal}) with: \item{loadings}{The new loadings matrix.} \item{Th}{The rotation.} \item{method}{A string indicating the rotation objective function ("eiv").} \item{orthogonal}{For consistency with other rotation results. Always FALSE.} \item{convergence}{For consistency with other rotation results. Always TRUE.} \item{Phi}{The covariance matrix of the rotated factors.} } \description{ Rotate to errors-in-variables representation. } \details{ This function rotates to an errors-in-variables representation. The optimization is not iterative and does not use the GPA algorithm. The function can be used directly or the function name can be passed to factor analysis functions like \code{factanal}. The loadings matrix is rotated so the \eqn{k}{k} rows indicated by \code{identity} form an identity matrix, and the remaining \eqn{M-k}{M-k} rows are free parameters. \eqn{\Phi}{Phi} is also free. The default makes the first \eqn{k}{k} rows the identity. If inverting the matrix of the rows indicated by \code{identity} fails, the rotation will fail and the user needs to supply a different choice of rows. Not all authors consider this representation to be a rotation. Viewed as a rotation method, it is oblique, with an explicit solution: given an initial loadings matrix \eqn{L}{L} partitioned as \eqn{L = (L_1^T, L_2^T)^T}{L = rbind(L1, L2)}, then (for the default \code{identity}) the new loadings matrix is \eqn{(I, (L_2 L_1^{-1})^T)^T}{rbind(I, L2 \%*\% solve(L1))} and \eqn{\Phi = L_1 L_1^T}{Phi = L1 \%*\% t(L1)}, where \eqn{I}{I} is the \eqn{k}{k} by \eqn{k}{k} identity matrix. It is assumed that \eqn{\Phi = I}{Phi = I} for the initial loadings matrix. One use of this parameterization is for obtaining good starting values (so it looks a little strange to rotate towards this solution afterwards). It has a few other purposes: (1) It can be useful for comparison with published results in this parameterization; (2) The S.E.s are more straightfoward to compute, because it is the solution to an unconstrained optimization (though not necessarily computed as such); (3) One may have an idea about which reference variables load on only one factor, but not impose restrictive constraints on the other loadings, so, in a nonrestrictive way, it has similarities to CFA; (4) For some purposes, only the subspace spanned by the factors is important, not the specific parameterization within this subspace; (5) The back-predicted indicators (explained portion of the indicators) do not depend on the rotation method. Combined with the greater ease to obtain correct standard errors of this method, this allows easier and more accurate prediction-standard errors. } \examples{ data("WansbeekMeijer", package="GPArotation") fa.unrotated <- factanal(factors = 2, covmat=NetherlandsTV, rotation="none") fa.eiv <- eiv(fa.unrotated$loadings) fa.eiv2 <- factanal(factors = 2, covmat=NetherlandsTV, rotation="eiv") cbind(loadings(fa.unrotated), loadings(fa.eiv), loadings(fa.eiv2)) fa.eiv3 <- eiv(fa.unrotated$loadings, identity=6:7) cbind(loadings(fa.unrotated), loadings(fa.eiv), loadings(fa.eiv3)) } \seealso{ \code{\link{echelon}}, \code{\link{rotations}}, \code{\link{GPForth}}, \code{\link{GPFoblq}} } \references{ \enc{Gsta}{Gosta} \enc{Hgglund}{Hagglund}. (1982). "Factor Analysis by Instrumental Variables Methods." \emph{Psychometrika}, 47, 209--222. Sock-Cheng Lewin-Koh and Yasuo Amemiya. (2003). "Heteroscedastic factor analysis." \emph{Biometrika}, 90, 85--97. Tom Wansbeek and Erik Meijer (2000) \emph{Measurement Error and Latent Variables in Econometrics}, Amsterdam: North-Holland. } \author{Erik Meijer and Paul Gilbert.} \concept{rotation} \keyword{multivariate} GPArotation/man/print.GPArotation.Rd0000644000176000001440000000147712267353521017074 0ustar ripleyusers\name{print.GPArotation} \alias{print.GPArotation} \alias{summary.GPArotation} \alias{print.summary.GPArotation} \title{Print and Summary Methods for GPArotation} \usage{ \method{print}{GPArotation}(x, digits=3, Table=FALSE, ...) \method{summary}{GPArotation}(object, ...) \method{print}{summary.GPArotation}(x, digits=3, ...) } \arguments{ \item{object}{a GPArotation object to summarize.} \item{x}{a summary.GPArotation to print.} \item{digits}{precision of printed numbers.} \item{...}{further arguments passed to other methods.} } \value{The object printed or a summary object.} \description{ Print an object or summary of an object returned by \code{GPForth} or \code{GPFoblq}. } \seealso{ \code{\link{GPForth}}, \code{\link[base]{summary}} } \concept{rotation} \keyword{internal} GPArotation/man/GPArotation-package.Rd0000644000176000001440000000310412267353521017317 0ustar ripleyusers\name{GPArotation-package} \alias{GPArotation-package} \alias{GPArotation.Intro} \docType{package} \title{GPA Rotation for Factor Analysis} \description{GPArotation implements Gradient Projection Algorithms and several rotation objective functions for factor analysis. } \details{ \tabular{ll}{ Package: \tab GPArotation\cr Depends: \tab R (>= 2.0.0)\cr License: \tab GPL Version 2.\cr URL: \tab http://www.stat.ucla.edu/research or\cr \tab http://www.stat.ucla.edu/research/gpa\cr} The main optimization functions are \code{\link{GPForth}} and \code{\link{GPFoblq}}. Rotation objectives include \code{\link{oblimin}} and many others. } \author{Coen A. Bernaards and Robert I. Jennrich with some R modifications by Paul Gilbert. Code is modified from original source \file{splusfunctions.net} available at \url{http://www.stat.ucla.edu/research/gpa}. } \references{ The software reference is Bernaards, C.A. and Jennrich, R.I. (2005) Gradient Projection Algorithms and Software for Arbitrary Rotation Criteria in Factor Analysis. \emph{Educational and Psychological Measurement}, \bold{65}, 676--696. Theory of gradient projection algorithms may be found in: Jennrich, R.I. (2001). A simple general procedure for orthogonal rotation. \emph{Psychometrika}, \bold{66}, 289--306. Jennrich, R.I. (2002). A simple general method for oblique rotation. \emph{Psychometrika}, \bold{67}, 7--19. } \keyword{ package } \seealso{ \code{\link{rotations}}, \code{\link{GPForth}}, \code{\link{GPFoblq}}, \code{\link[stats]{factanal}} } GPArotation/man/GPA.Rd0000644000176000001440000001576512267353521014166 0ustar ripleyusers\name{GPA} \alias{GPForth} \alias{GPFoblq} \title{Rotation Optimization} \usage{ GPForth(A, Tmat=diag(ncol(A)), normalize=FALSE, eps=1e-5, maxit=1000, method="varimax", methodArgs=NULL) GPFoblq(A, Tmat=diag(ncol(A)), normalize=FALSE, eps=1e-5, maxit=1000, method="quartimin", methodArgs=NULL) } \arguments{ \item{A}{initial factor loadings matrix for which the rotation criterian is to be optimized.} \item{Tmat}{initial rotation matrix.} \item{method}{rotation objective criterian.} \item{normalize}{see details.} \item{eps}{convergence is assumed when the norm of the gradient is smaller than eps.} \item{maxit}{maximum number of iterations allowed in the main loop.} \item{methodArgs}{a list ofmethodArgs arguments passed to the rotation objective} } \description{ Gradient projection rotation optimization routine used by various rotation objective. } \value{A GPArotation object which is a list with elements \item{loadings}{The rotated loadings, one column for each factor.} \item{Th}{The rotation matrix, Lh \%*\% t(Th) = A.} \item{Table}{A matrix recording the iterations of the rotation optimization.} \item{method}{A string indicating the rotation objective function.} \item{orthogonal}{A logical indicating if the rotation is orthogonal.} \item{convergence}{A logical indicating if convergence was obtained.} \item{Phi}{t(Th) \%*\% Th. The covariance matrix of the rotated factors. This will be the identity matrix for orthogonal rotations so is omitted (NULL) for the result from GPForth.} \item{Gq}{The gradient of the objective function at the rotated loadings.} } \details{ Gradient projection rotation optimization routines developed by Coen A. Bernaards and Robert I. Jennrich. These functions can be used directly to rotate a loadings matrix, or indirectly through a rotation objective passed to a factor estimation routine such as \code{\link{factanal}}. For examples of the indirect use see the documention for rotations (such as \code{\link{oblimin}}). \code{GPForth} is the main GP algorithm for orthogonal rotation. \code{GPFoblq} is the main GP algorithm for oblique rotation. Both algorithms require a loadings matrix \code{A} which fixes the equivalence class over which the optimization is done. It must be the solution to the orthogonal factor analysis problem. A rotation is defined as \code{A \%*\% t(solve(Tmat))}. For the orthogonal case \code{Tmat} is orthonormal so this simplifies to \code{A \%*\% Tmat}. The starting point for iterative optimization is given by the \code{Tmat} rotation of \code{A}. By default the initial rotation is the identity matrix. For some rotation criteria local optima may exist and it is recommended to check for this by starting with many different initial rotations. The function \code{\link{Random.Start}} will help to do this. The argument \code{method} can be used to specify a string indicating the rotation objective. \code{GPFoblq} defaults to \code{"quartimin"} and \code{GPForth} defaults to \code{"varimax"}. Available rotation objectives are \code{"oblimin"}, \code{"quartimin"}, \code{"target"}, \code{"pst"}, \code{"oblimax"}, \code{"entropy"}, \code{"quartimax"}, \code{"varimax"}, \code{"simplimax"}, \code{"bentler"}, \code{"tandemI"}, \code{"tandemII"}, \code{ "geomin"}, \code{"cf"}, \code{"infomax"} and \code{"mccammon"}. The string is prefixed with "vgQ." to give the actual function call. The \code{vgQ.*} function call would typically not be used directly, so these methods are not exported from the package namespace. You can print these functions to see the code for calculating a criterion, but since they are not exported the package name needs to be specified. For example, use \code{GPArotation:::vgQ.oblimin} to view the function \code{vgQ.oblimin}. Some rotation criteria (including \code{"simplimax"}, \code{"pst"}, \code{"procrustes"}) require one or more additional arguments. For example, \code{"simplimax"} needs the number of 'close to zero loadings' which is given as the extra argument \code{k}. Check the rotation methods for details. (If a new rotation method is implemented and needs additional arguments then this is the way to pass them.) The argument \code{normalize} gives an indication of if and how any normalization should be done before rotation, and then undone after rotation. If \code{normalize} is \code{FALSE} (the default) no normalization is done. If \code{normalize} is \code{TRUE} then Kaiser normalization is done. (So squared row entries of normalized \code{A} sum to 1.0. This is sometimes called Horst normalization.) If \code{normalize} is a vector of length equal to the number of indicators (= number of rows of \code{A}) then the colums are divided by \code{normalize} before rotation and multiplied by \code{normalize} after rotation. If \code{normalize} is a function then it should take \code{A} as an argument and return a vector which is used like the vector above. } \seealso{ \code{\link{Random.Start}}, \code{\link[stats]{factanal}}, \code{\link{oblimin}}, \code{\link{quartimin}}, \code{\link{targetT}}, \code{\link{targetQ}}, \code{\link{pstT}}, \code{\link{pstQ}}, \code{\link{oblimax}}, \code{\link{entropy}}, \code{\link{quartimax}}, \code{\link{Varimax}}, \code{\link[stats]{varimax}}, \code{\link{simplimax}}, \code{\link{bentlerT}}, \code{\link{bentlerQ}}, \code{\link{tandemI}}, \code{\link{tandemII}}, \code{\link{geominT}}, \code{\link{geominQ}}, \code{\link{cfT}}, \code{\link{cfQ}}, \code{\link{infomaxT}}, \code{\link{infomaxQ}}, \code{\link{mccammon}}, \code{\link{promax}} } \examples{ data("Harman", package="GPArotation") qHarman <- GPForth(Harman8, Tmat=diag(2), method="quartimax") data("WansbeekMeijer", package="GPArotation") fa.unrotated <- factanal(factors = 2, covmat=NetherlandsTV, normalize=TRUE, rotation="none") GPForth(loadings(fa.unrotated), method="varimax", normalize=TRUE)$loadings TV <- GPFoblq(loadings(fa.unrotated), method="oblimin", normalize=TRUE) print(TV) print(TV, Table=TRUE) summary(TV) } \author{Coen A. Bernaards and Robert I. Jennrich with some R modifications by Paul Gilbert} \references{ Additional information is available at \url{http://www.stat.ucla.edu/research} or \url{http://www.stat.ucla.edu/research/gpa} The software reference is Bernaards, C.A. and Jennrich, R.I. (2005) Gradient Projection Algorithms and Software for Arbitrary Rotation Criteria in Factor Analysis. \emph{Educational and Psychological Measurement}, \bold{65}, 676--696. Theory of gradient projection algorithms may be found in: Jennrich, R.I. (2001). A simple general procedure for orthogonal rotation. \emph{Psychometrika}, \bold{66}, 289--306. Jennrich, R.I. (2002). A simple general method for oblique rotation. \emph{Psychometrika}, \bold{67}, 7--19. } \concept{rotation} \keyword{multivariate} GPArotation/man/Harman.Rd0000644000176000001440000000106412267353521014750 0ustar ripleyusers\name{Harman} \docType{data} \alias{Harman} \alias{Harman8} \title{Example Data from Harman} \description{ Harman8 is initial factor loading matrix for Harman's 8 physical variables. } \usage{ data(Harman) } \details{ The object Harman8 is loaded from the data file Harman. } \format{ The object Harman8 is a matrix. } \source{ Harman, H. H. (1976) \emph{Modern Factor Analysis}, Third Edition Revised, University of Chicago Press. } \seealso{ \code{\link{GPForth}}, \code{\link{Thurstone}}, \code{\link{WansbeekMeijer}} } \keyword{datasets} GPArotation/man/rotations.Rd0000644000176000001440000002325212434664255015574 0ustar ripleyusers\name{rotations} \alias{rotations} \alias{oblimin} \alias{quartimin} \alias{targetT} \alias{targetQ} \alias{pstT} \alias{pstQ} \alias{oblimax} \alias{entropy} \alias{quartimax} \alias{Varimax} \alias{simplimax} \alias{bentlerT} \alias{bentlerQ} \alias{tandemI} \alias{tandemII} \alias{geominT} \alias{geominQ} \alias{cfT} \alias{cfQ} \alias{infomaxT} \alias{infomaxQ} \alias{mccammon} \alias{bifactorT} \alias{bifactorQ} \alias{vgQ.oblimin} \alias{vgQ.quartimin} \alias{vgQ.target} \alias{vgQ.pst} \alias{vgQ.oblimax} \alias{vgQ.entropy} \alias{vgQ.quartimax} \alias{vgQ.varimax} \alias{vgQ.simplimax} \alias{vgQ.bentler} \alias{vgQ.tandemI} \alias{vgQ.tandemII} \alias{vgQ.geomin} \alias{vgQ.cf} \alias{vgQ.infomax} \alias{vgQ.mccammon} \alias{vgQ.bifactor} \title{Rotations} \usage{ oblimin(L, Tmat=diag(ncol(L)), gam=0, normalize=FALSE, eps=1e-5, maxit=1000) quartimin(L, Tmat=diag(ncol(L)), normalize=FALSE, eps=1e-5, maxit=1000) targetT(L, Tmat=diag(ncol(L)), Target=NULL, normalize=FALSE, eps=1e-5, maxit=1000) targetQ(L, Tmat=diag(ncol(L)), Target=NULL, normalize=FALSE, eps=1e-5, maxit=1000) pstT(L, Tmat=diag(ncol(L)), W=NULL, Target=NULL, normalize=FALSE, eps=1e-5, maxit=1000) pstQ(L, Tmat=diag(ncol(L)), W=NULL, Target=NULL, normalize=FALSE, eps=1e-5, maxit=1000) oblimax(L, Tmat=diag(ncol(L)), normalize=FALSE, eps=1e-5, maxit=1000) entropy(L, Tmat=diag(ncol(L)), normalize=FALSE, eps=1e-5, maxit=1000) quartimax(L, Tmat=diag(ncol(L)), normalize=FALSE, eps=1e-5, maxit=1000) Varimax(L, Tmat=diag(ncol(L)), normalize=FALSE, eps=1e-5, maxit=1000) simplimax(L, Tmat=diag(ncol(L)), k=nrow(L), normalize=FALSE, eps=1e-5, maxit=1000) bentlerT(L, Tmat=diag(ncol(L)), normalize=FALSE, eps=1e-5, maxit=1000) bentlerQ(L, Tmat=diag(ncol(L)), normalize=FALSE, eps=1e-5, maxit=1000) tandemI(L, Tmat=diag(ncol(L)), normalize=FALSE, eps=1e-5, maxit=1000) tandemII(L, Tmat=diag(ncol(L)), normalize=FALSE, eps=1e-5, maxit=1000) geominT(L, Tmat=diag(ncol(L)), delta=.01, normalize=FALSE, eps=1e-5, maxit=1000) geominQ(L, Tmat=diag(ncol(L)), delta=.01, normalize=FALSE, eps=1e-5, maxit=1000) cfT(L, Tmat=diag(ncol(L)), kappa=0, normalize=FALSE, eps=1e-5, maxit=1000) cfQ(L, Tmat=diag(ncol(L)), kappa=0, normalize=FALSE, eps=1e-5, maxit=1000) infomaxT(L, Tmat=diag(ncol(L)), normalize=FALSE, eps=1e-5, maxit=1000) infomaxQ(L, Tmat=diag(ncol(L)), normalize=FALSE, eps=1e-5, maxit=1000) mccammon(L, Tmat=diag(ncol(L)), normalize=FALSE, eps=1e-5, maxit=1000) bifactorT(L, Tmat=diag(ncol(L)), normalize=FALSE, eps=1e-5, maxit=1000) bifactorQ(L, Tmat=diag(ncol(L)), normalize=FALSE, eps=1e-5, maxit=1000) vgQ.oblimin(L, gam=0) vgQ.quartimin(L) vgQ.target(L, Target=NULL) vgQ.pst(L, W=NULL, Target=NULL) vgQ.oblimax(L) vgQ.entropy(L) vgQ.quartimax(L) vgQ.varimax(L) vgQ.simplimax(L, k=nrow(L)) vgQ.bentler(L) vgQ.tandemI(L) vgQ.tandemII(L) vgQ.geomin(L, delta=.01) vgQ.cf(L, kappa=0) vgQ.infomax(L) vgQ.mccammon(L) vgQ.bifactor(L) } \arguments{ \item{L}{a factor loading matrix} \item{Tmat}{initial rotation matrix.} \item{gam}{0=Quartimin, .5=Biquartimin, 1=Covarimin.} \item{Target}{rotation target for objective calculation.} \item{W}{weighting of each element in target.} \item{k}{number of close to zero loadings.} \item{delta}{constant added to L\^2 in objective calculation.} \item{kappa}{see details.} \item{normalize}{parameter passed to optimization routine (GPForth or GPFoblq).} \item{eps}{parameter passed to optimization routine (GPForth or GPFoblq).} \item{maxit}{parameter passed to optimization routine (GPForth or GPFoblq).} } \value{A list (which includes elements used by \code{factanal}) with: \item{loadings}{Lh from \code{GPForth} or \code{GPFoblq}.} \item{Th}{Th from \code{GPForth} or \code{GPFoblq}.} \item{Table}{Table from \code{GPForth} or \code{GPFoblq}.} \item{method}{A string indicating the rotation objective function.} \item{orthogonal}{A logical indicating if the rotation is orthogonal.} \item{convergence}{Convergence indicator from \code{GPForth} or \code{GPFoblq}.} \item{Phi}{t(Th) \%*\% Th. The covariance matrix of the rotated factors. This will be the identity matrix for orthogonal rotations so is omitted (NULL) for the result from GPForth.} } \description{ Optimize factor loading rotation objective. } \details{ These functions optimize a rotation objective. They can be used directly or the function name can be passed to factor analysis functions like \code{factanal}. Several of the function names end in T or Q, which indicates if they are orthogonal or oblique rotations (using \code{GPForth} or \code{GPFoblq} respectively. The \code{vgQ.*} versions of the code are called by the optimization routine and would typically not be used directly, so these methods are not exported from the package namespace. (They simply return the function value and gradient for a given rotation matrix.) You can print these functions, but the package name needs to be specified since they are not exported. For example, use \code{GPArotation:::vgQ.oblimin} to view the function \code{vgQ.oblimin}. The T or Q ending on function names should be omitted for the \code{vgQ.*} versions of the code so, for example, use \code{GPArotation:::vgQ.target} to view the target criterion calculation. Rotations which are available are \tabular{lll}{ oblimin \tab oblique \tab oblimin family \cr quartimin \tab oblique \tab \cr targetT \tab orthogonal \tab target rotation \cr targetQ \tab oblique \tab target rotation \cr pstT \tab orthogonal \tab partially specified target rotation \cr pstQ \tab oblique \tab partially specified target rotation \cr oblimax \tab oblique \tab \cr entropy \tab orthogonal \tab minimum entropy \cr quartimax \tab orthogonal \tab \cr varimax \tab orthogonal \tab \cr simplimax \tab oblique \tab \cr bentlerT \tab orthogonal \tab Bentler's invariant pattern simplicity criterion\cr bentlerQ \tab oblique \tab Bentler's invariant pattern simplicity criterion\cr tandemI \tab orthogonal \tab Tandem Criterion \cr tandemII \tab orthogonal \tab Tandem Criterion \cr geominT \tab orthogonal \tab \cr geominQ \tab oblique \tab \cr cfT \tab orthogonal \tab Crawford-Ferguson family \cr cfQ \tab oblique \tab Crawford-Ferguson family \cr infomaxT \tab orthogonal \tab \cr infomaxQ \tab oblique \tab \cr mccammon \tab orthogonal \tab McCammon minimum entropy ratio \cr bifactorT \tab orthogonal \tab Jennrich and Bentler bifactor rotation\cr bifactorQ \tab oblique \tab Jennrich and Bentler biquartimin rotation\cr } Also included for convenience are two analytic rotations \code{eiv} and \code{echelon} which do not require \code{GPForth} or \code{GPFoblq}. Note that \code{Varimax} defined here uses \code{vgQ.varimax} and is not \code{varimax} defined in the \code{stats} package. \code{stats:::varimax} does Kaiser normalization by default whereas \code{Varimax} defined here does not. The argument \code{kappa} parameterizes the family for the Crawford-Ferguson method. If \code{m} is the number of factors and \code{p} is the number of indicators then \code{kappa} values having special names are 0=Quartimax, 1/p=Varimax, m/(2*p)=Equamax, (m-1)/(p+m-2)=Parsimax, 1=Factor parsimony. New rotation methods can be programmed with a name "vgQ.newmethod". The inputs are the matrix L, and optionally any additional arguments. The output should be a list with elements \tabular{ll}{ \code{f} \tab the value of the criterion at L.\cr \code{Gq} \tab the gradient at L.\cr \code{Method} \tab a string indicating the criterion.\cr } } \examples{ data(ability.cov) factanal(factors = 2, covmat = ability.cov, rotation="oblimin") data("Harman", package="GPArotation") qHarman <- GPForth(Harman8, Tmat=diag(2), method="quartimax") qHarman2 <- quartimax(Harman8) data("WansbeekMeijer", package="GPArotation") fa.unrotated <- factanal(factors = 2, covmat=NetherlandsTV, rotation="none") fa.varimax <- factanal(factors = 2, covmat=NetherlandsTV, rotation="varimax", control=list(rotate=list(normalize=TRUE))) fa.oblimin <- factanal(factors = 2, covmat=NetherlandsTV, rotation="oblimin", control=list(rotate=list(normalize=TRUE))) cbind(loadings(fa.unrotated), loadings(fa.varimax), loadings(fa.oblimin)) } \seealso{ \code{\link{GPForth}}, \code{\link{GPFoblq}}, \code{\link{WansbeekMeijer}}, \code{\link{eiv}}, \code{\link{echelon}}, \code{\link[stats]{factanal}}, \code{\link[stats]{varimax}}, \code{\link[stats:varimax]{promax}} } \references{ Bernaards, C.A. and Jennrich, R.I. (2005) Gradient Projection Algorithms and Software for Arbitrary Rotation Criteria in Factor Analysis. \emph{Educational and Psychological Measurement}, \bold{65}, 676--696. Bifactor rotation, bifactorT and bifactorQ are called bifactor and biquartimin in Jennrich, R.I. and Bentler, P.M. (2011) Exploratory bi-factor analysis. \emph{Psychometrika}, \bold{76}. A discussion of rotation objectives can be found in many references, for example, Tom Wansbeek and Erik Meijer (2000) \emph{Measurement Error and Latent Variables in Econometrics}, Amsterdam: North-Holland. } \author{Coen A. Bernaards and Robert I. Jennrich with some R modifications by Paul Gilbert.} \concept{rotation} \keyword{multivariate} GPArotation/man/Random.Start.Rd0000644000176000001440000000240112267353521016052 0ustar ripleyusers\name{Random.Start} \alias{Random.Start} \title{Generate a Random Orthogonal Rotation} \usage{ Random.Start(k) } \arguments{ \item{k}{An integer indicating the dimension of the square matrix.} } \description{ Random orthogonal rotation to use as Tmat matrix to start GPForth or GPFoblq. } \value{An orthogonal matrix.} \details{ The random start function produces an orthogonal matrix with columns of length one based on the QR decompostion. } \seealso{ \code{\link{GPForth}}, \code{\link{GPFoblq}}, \code{\link{oblimin}} } \examples{ Global.min <- function(A,method,B=10){ fv <- rep(0,B) seeds <- sample(1e+7, B) for(i in 1:B){ cat(i," ") set.seed(seeds[i]) gpout <- GPFoblq(A=A, Random.Start(ncol(A)), method=method) dtab <- dim(gpout$Table) fv[i] <- gpout$Table[dtab[1],2] cat(fv[i], "\n") } cat("Min is ",min(fv),"\n") set.seed(seeds[order(fv)[1]]) ans <- GPFoblq(A=A, Random.Start(ncol(A)), method=method) ans } data("Thurstone", package="GPArotation") Global.min(box26,"simplimax",10) } \author{Coen A. Bernaards and Robert I. Jennrich with some R modifications by Paul Gilbert } \concept{rotation} \keyword{multivariate} GPArotation/man/00.GPArotation.Intro.Rd0000644000176000001440000000043212267353521017237 0ustar ripleyusers\name{00.GPArotation.Intro} \alias{00.GPArotation.Intro} \docType{package} \title{GPA Rotation for Factor Analysis} \description{See \code{\link{GPArotation-package}} ( in the help system use package?GPArotation or ?"GPArotation-package") for an overview. } \keyword{package} GPArotation/man/echelon.Rd0000644000176000001440000000753712267353521015172 0ustar ripleyusers\name{echelon} \alias{echelon} \title{Echelon Rotation} \usage{ echelon(L, reference=seq(NCOL(L)), ...) } \arguments{ \item{L}{a factor loading matrix} \item{reference}{indicates rows of loading matrix that should be used to determine the rotation transformation.} \item{...}{additional arguments discarded.} } \value{A list (which includes elements used by \code{factanal}) with: \item{loadings}{The new loadings matrix.} \item{Th}{The rotation.} \item{method}{A string indicating the rotation objective function ("echelon").} \item{orthogonal}{For consistency with other rotation results. Always TRUE.} \item{convergence}{For consistency with other rotation results. Always TRUE.} } \description{ Rotate to an echelon parameterization. } \details{ The loadings matrix is rotated so the \eqn{k}{k} rows of the loading matrix indicated by \code{reference} are the Cholesky factorization given by \code{t(chol(L[reference,] \%*\% t(L[reference,])))}. This defines the rotation transformation, which is then also applied to other rows to give the new loadings matrix. The optimization is not iterative and does not use the GPA algorithm. The function can be used directly or the function name can be passed to factor analysis functions like \code{factanal}. An orthogonal solution is assumed (so \eqn{\Phi}{Phi} is identity). The default uses the first \eqn{k}{k} rows as the reference. If the submatrix of \code{L} indicated by reference is singular then the rotation will fail and the user needs to supply a different choice of rows. One use of this parameterization is for obtaining good starting values (so it may appear strange to rotate towards this solution afterwards). It has a few other purposes: (1) It can be useful for comparison with published results in this parameterization. (2) The S.E.s are more straightforward to compute, because it is the solution to an unconstrained optimization (though not necessarily computed as such). (3) The models with k and (k+1) factors are nested, so it is more straightforward to test the k-factor model versus the (k+1)-factor model. In particular, in addition to the LR test (which does not depend on the rotation), now the Wald test and LM test can be used as well. For these, the test of a k-factor model versus a (k+1)-factor model is a joint test whether all the free parameters (loadings) in the (k+1)st column of \code{L} are zero. (4) For some purposes, only the subspace spanned by the factors is important, not the specific parameterization within this subspace. (5) The back-predicted indicators (explained portion of the indicators) do not depend on the rotation method. Combined with the greater ease to obtain correct standard errors of this method, this allows easier and more accurate prediction-standard errors. (6) This parameterization and its standard errors can be used to detect identification problems (McDonald, 1999, pp. 181-182). } \examples{ data("WansbeekMeijer", package="GPArotation") fa.unrotated <- factanal(factors = 2, covmat=NetherlandsTV, rotation="none") fa.ech <- echelon(fa.unrotated$loadings) fa.ech2 <- factanal(factors = 2, covmat=NetherlandsTV, rotation="echelon") cbind(loadings(fa.unrotated), loadings(fa.ech), loadings(fa.ech2)) fa.ech3 <- echelon(fa.unrotated$loadings, reference=6:7) cbind(loadings(fa.unrotated), loadings(fa.ech), loadings(fa.ech3)) } \seealso{ \code{\link{eiv}}, \code{\link{rotations}}, \code{\link{GPForth}}, \code{\link{GPFoblq}} } \references{ Roderick P. McDonald (1999) \emph{Test Theory: A Unified Treatment}, Mahwah, NJ: Erlbaum. Tom Wansbeek and Erik Meijer (2000) \emph{Measurement Error and Latent Variables in Econometrics}, Amsterdam: North-Holland. } \author{Erik Meijer and Paul Gilbert.} \concept{rotation} \keyword{multivariate} GPArotation/LICENSE0000644000176000001440000000013212267353521013500 0ustar ripleyusersCopyright 2005-2006, Coen Bernaards and Robert Jennrich License: GPL Version 2 or later.