0

Imagine I have the dataset below for 34 subjects (I randomly sliced 100 observations from it because of line limitation here in the body). Each subject has multiple observations for different time points and regions. I would like to compare two PCAs, one time with 34 subjects and another with 30 subjects, as the four removed subjects share a common biological property hoping to gain better insights about the relationships between variables with and without them. The variables are expression data of 11 genes. I searched the net for a similar approach but couldn't find one. The solution is expected to be out of the box to visualize the movement of the variables in the first space made by the first two PCA components before and after the removal.

MWE

MWEdf <- structure(list(var8 = c(-0.76609142056147, -2.01713898121296, 
-4.46688971704913, 0.910420337869208, -0.426948022548039, 1.83909837227122, 
-1.96264148049867, -7.7151802334041, -7.7151802334041, -1.85694540829475, 
-7.7151802334041, -7.7151802334041, -7.7151802334041, -2.13158058606459, 
-2.54810636145868, -7.7151802334041, -7.7151802334041, -3.77521442593664, 
-3.98371796864915, -4.10926874357161, -7.7151802334041, 1.35799483327646, 
-2.43462320798032, -7.7151802334041, -7.7151802334041, -4.8534483091215, 
1.17711600808403, -4.92369687569065, -7.7151802334041, -3.7906810918407, 
-2.96232548461371, -7.7151802334041, -5.02808235200737, -7.7151802334041, 
-1.05831979482273, -0.409818874129353, -7.7151802334041, -2.6974867026333, 
-2.62595671210859, -6.01562669572634, -1.58272458796114, -7.7151802334041, 
-5.10991301639534, -6.18769372144461, 1.31096494255942, 1.02914743154622, 
-0.815439676399235, -2.54733643719393, -4.82375239573376, -7.7151802334041, 
-7.7151802334041, 1.6071809165704, -2.18376750121581, -1.29354126608995, 
-2.63057560958295, -1.51738163711108, -7.7151802334041, -0.740370651934506, 
-1.15250395261739, -2.99494354278647, 0.451650935146269, -4.09594630152134, 
-4.15318265629547, -0.741370382520737, -7.7151802334041, -0.605764116332325, 
-5.02699629649904, 0.271910920510862, -2.07045578481502, -7.7151802334041, 
-7.7151802334041, 0.860543452498494, 1.08324037060038, -7.7151802334041, 
-2.60628419574729, -1.17934002769, -2.85301526311667, -0.325134147514517, 
-7.7151802334041, -2.52440746015085, -7.7151802334041, 0.607466040447891, 
-0.0900361021878234, 0.817616057449849, -2.66801875577869, 1.11420070303973, 
-7.7151802334041, 0.174686334508013, -7.7151802334041, -4.97773217657363, 
-1.70283895006504, -3.04905247569137, -4.61555262799482, -3.27630295037426, 
1.13467802144529, -4.77653265637224, -4.67588475198202, -3.107070191551, 
-4.47074566035168, -3.11356082965409), var1 = c(-0.495108149803674, 
-3.17713715120826, -1.14943692580593, -0.893496203018593, -1.96284555265964, 
1.50758036214262, -0.845127182185463, -1.22096542274149, 7.8326025960379, 
0.0913324403081445, -3.78994494530725, -1.71619891986841, -0.869070883365001, 
-3.04679539393059, -3.05447502444768, 7.085026774747, -0.222061913994753, 
1.17432355744966, -5.77614228861214, -1.22642480430481, 1.21599088040901, 
-0.861495565110941, -3.14314942096873, 4.45595975776499, -0.0654413740129408, 
-2.23650951933111, -1.36000524019377, -2.96889298140345, 8.5826506602165, 
-0.834921125280983, -2.36021318087611, 10.5383510782524, -0.934321133072771, 
9.116557360081, -2.81947007559542, -2.41201715553776, -3.24601542017151, 
-1.176103622133, 0.7533927950895, -4.08165831608544, -1.38576793837184, 
0.318839320238546, -2.58514366404274, 1.52785346522179, 1.52898230364193, 
-0.36813734137728, -3.11546209038064, -4.58070520124863, -1.62631676712226, 
8.7258707806982, 1.56320856335612, 0.130383059799003, -0.582180413581807, 
-1.38339542529005, -1.53431511480175, 0.0487152913404208, 8.65275830034076, 
-2.4162953362632, 0.874023422204311, -2.57496454005447, 0.521968905243072, 
-2.76646758198274, -3.69584625548357, -3.51248232118694, 8.59773376431057, 
-2.00670268262432, -3.50284456724115, 0.372586615627262, -2.47314256188851, 
-2.46166656681707, 1.03918080040088, -1.08141121745081, -1.54152965308943, 
9.30441320173456, -2.70312157947318, -3.9005664920717, -3.17621606468347, 
-1.93676012425402, 8.72386883133048, -3.40593113026505, -0.0873505088619274, 
0.0409202053921885, 0.302548612289073, -0.109573960376755, -2.80726445271719, 
-1.08301290288397, -2.09342682884945, -0.61950670547579, -0.253389335821968, 
-1.28396487904583, -3.83591273601144, -2.38014070639087, -1.54111689076371, 
-0.20762060091596, -1.78882124270982, -4.77614228861214, -2.18960270458112, 
-1.6670676787955, -2.83953317033868, -0.821089257841496), var2 = c(1.31847760578085, 
-1.95766491907428, 0.312202226637037, -0.33158665019081, -1.74633168563386, 
-7.00853851728086, -0.272188790178215, -0.279777964026632, 8.47093024058916, 
0.396879823620879, 1.33401393916983, 0.30944011137583, 0.477006191140113, 
-0.886088731013743, -2.80783075529923, -7.00853851728086, 0.27205611694226, 
2.85287924509224, -1.09268009114773, -0.228007369781452, 2.27015546244087, 
-5.4035456663762, -1.8719831216853, 9.9196412681735, -7.00853851728086, 
-0.24928942862097, -2.02236942275441, 0.746862180012467, 11.8394573064516, 
0.233700150456528, -1.40153858438253, 11.8456247391247, -0.640165698802804, 
-7.00853851728086, 0.328307718126639, 1.13549440410477, -1.84889028525164, 
-3.34690841944147, -1.29339928425394, -2.57528824119271, -1.72874225888642, 
-0.0661465724436867, 1.33263570870225, 4.39284449114782, 0.616526056953677, 
0.0193735274291036, -1.4341953467425, 0.385629146801427, 1.76650046508852, 
10.1403634148571, -7.00853851728086, -0.749352456412755, -0.332593326200125, 
-1.0189232860184, -2.26064337056647, 1.25767914175963, 9.48320952138525, 
0.148945398840805, -1.54428841203392, -1.22066117666879, 0.524329360739018, 
-1.68301677135026, -1.20109271351902, -0.480298993244838, -7.00853851728086, 
0.363585365570409, -2.78810691866575, 0.144868196700813, -3.3926886706115, 
0.0398603506317511, 2.88492883947132, -1.4827546460226, -1.42548049629243, 
8.26831801132424, -0.116019068967256, -4.52149826279015, -2.50628630321307, 
-3.42503095707368, -7.00853851728086, -1.55121023433708, 2.5700667780509, 
-0.356663382174928, -0.936235832822645, 3.25305015645654, -2.02872914800559, 
-0.698587577615136, 0.937518531685181, -0.361890614984036, 1.84419607274378, 
0.505954816359844, -3.40997268632027, 1.18229325563832, -0.480556043936571, 
-7.00853851728086, -3.48719272021875, -0.239255253521888, 0.0508889197445535, 
-0.460639795128257, -1.90463993201964, -1.19029225851577), var7 = c(-0.330829329116428, 
-1.55506937188927, -1.88294522878535, -0.528328976154117, -1.01731768598956, 
1.10027288719863, -1.21753977665106, -0.421942124546977, -4.57455835665767, 
-2.09251611223271, -1.09797058183209, -3.37769229908215, -1.21711798939191, 
-1.77761658607216, -1.90493544990986, -4.57455835665767, 0.197091650219251, 
-0.230196440701443, 0.457144529407861, -2.60652738180172, -0.80111469853503, 
-1.40634837041636, 0.29505030742647, -4.57455835665767, -1.51338340737245, 
-2.23696916254069, 0.17220131910551, -0.522768213961021, -4.57455835665767, 
-1.24621111939717, -1.88564763964793, -4.57455835665767, -2.66201495394189, 
-4.57455835665767, -1.07642103796333, 0.513127989832217, -0.835765732926364, 
-0.374014316906214, -1.24762772490359, -2.23179837877705, 0.137777536157347, 
0.907293274111244, -1.88984096589015, 2.8512627246863, 0.41030713403829, 
-1.05235966440185, -1.70229203795461, -0.826187512250203, -0.57500471454134, 
-4.57455835665767, -1.77393244794009, -0.488720903432738, -2.25708907845063, 
-0.653721120713123, -1.99248307725326, -2.06177055633256, -4.57455835665767, 
-2.23350065947502, -0.576375047868402, -1.02378648268242, 2.6701213058599, 
-1.48695164838891, -3.25730965853039, -0.179797053746557, -4.57455835665767, 
-0.907051833336545, -0.47099667390776, 0.234141279556065, -1.11264360846803, 
-2.30438997495603, -0.838208901265527, -0.534477689206142, -0.233049355053239, 
-4.57455835665767, -0.565226088944112, -2.60914700529148, -2.16803346899691, 
-2.31685458049897, -4.57455835665767, -1.24623771777253, -2.17492749929414, 
-0.275995249824351, -0.730284398596546, 2.14469443458394, -0.889229753269594, 
-0.141495504689145, -1.15559715449128, -0.22183632228897, -1.43466108116738, 
-0.878716043116411, -1.57129142133162, -0.550858482221925, -1.7890850300495, 
-1.88004807403731, -1.60321347130523, -1.63202377231906, -3.18119447590293, 
-1.3910728453052, -1.90654109625549, -0.882465261169953), var9 = c(-3.12570255110097, 
-3.28694924730506, -3.31209898638033, -1.02592535024889, -4.13082353855094, 
-8.15790783740283, -8.15790783740283, -0.863128372919989, -8.15790783740283, 
-3.76343029507556, -8.15790783740283, -8.15790783740283, -2.3975418120009, 
-0.0915680360610931, -5.46169594220289, -8.15790783740283, -1.53092989701775, 
-8.15790783740283, -2.11898656466105, -4.223518775761, -8.15790783740283, 
-2.19591205320154, -1.22703558647012, -8.15790783740283, -8.15790783740283, 
-8.15790783740283, -1.00036242545617, -0.604086862121557, -8.15790783740283, 
-8.15790783740283, -4.78252758292461, -8.15790783740283, -0.453516776640668, 
4.4613068595425, -3.40000814102092, -0.964708647777353, -2.09554569742541, 
-2.03784051076509, -8.15790783740283, -7.15790783740283, -1.24582221014324, 
-3.10267087923265, -8.15790783740283, -8.15790783740283, -8.15790783740283, 
-2.74342497715408, -2.96860187436403, -3.19638211957713, -1.63453806259706, 
-8.15790783740283, -8.15790783740283, -2.4889458701903, -8.15790783740283, 
-2.67190459332695, -4.25009548441925, -3.41797311057328, -8.15790783740283, 
-8.15790783740283, -8.15790783740283, -2.17314010076636, 1.19823964597437, 
-4.74530624600454, -3.10252059916627, -0.806740236288237, -8.15790783740283, 
-2.88862666867542, -2.39709065712214, -1.54203554567714, -4.17019674683821, 
-4.65673739177897, -1.63369963853562, -1.84243890193421, 0.304892713274772, 
-8.15790783740283, -1.44310271001609, -4.2810380036233, -5.92619509700957, 
-4.87230063247181, -8.15790783740283, -0.442413189942948, -8.15790783740283, 
-1.86151149808851, -4.09685439126772, 0.756194582541847, -1.52613070236118, 
-0.271540946279072, -2.75244353394145, 1.05273413569781, -8.15790783740283, 
-2.76350822521604, -3.78557416115544, -1.58702718073226, -4.33625672513209, 
-1.90840757136076, -2.32944821309541, -4.02522715716724, -3.61363022753232, 
-0.904188139582001, -4.73331099706008, -3.3087864772882), var10 = c(0.0289656313068957, 
0.373602866683926, 1.99674120803818, 0.332753867325611, 0.792014657925903, 
0.470966921990647, 0.94663426720099, 1.83225963003594, -2.10339597992164, 
0.102486219951604, 2.22257209515469, 1.48289982935378, 1.21915478467835, 
0.521658367396709, 0.29944991363134, -2.10339597992164, 2.08460767288794, 
2.17867764710764, 1.27363377073715, 1.36493582562816, 1.99906733951548, 
-0.74339223363042, 1.30001126160313, 2.40729105904187, 1.50058925778142, 
1.49893071178779, 1.20226297626558, 1.88493793150188, -2.10339597992164, 
1.81231991785049, 1.13557091999213, -2.10339597992164, 1.47643786991532, 
-2.10339597992164, 1.04809512528693, 0.325306227868594, 1.51340774473956, 
-0.156195474368856, 2.20182353985771, -0.117328086733032, 0.0148534448421561, 
1.02716376293441, 1.59154766513745, 1.62512125172647, 0.592706128616561, 
0.41925079078228, -0.441485294774679, 0.34191297949347, 0.4879176414842, 
-2.10339597992164, 1.01046966034846, 1.31358258356031, 2.3168013818118, 
-1.00969194915727, -0.197877028446637, 0.0987643645215791, 1.59988533617193, 
2.03966766097494, 0.346517618870097, 1.89617112236461, 0.583713782344691, 
0.768073981640994, 1.20686958516122, 0.257941061225577, -2.10339597992164, 
-0.753634674487042, 0.503598390155653, 1.05339140653442, 0.546751837642406, 
1.84525479041041, 1.48627502738556, 0.292665854188427, 1.09883527173631, 
-2.10339597992164, 0.29067232601637, -0.767964665863868, -0.390408101629476, 
-0.763982455131721, -2.10339597992164, -0.396518795122059, 0.974786820918249, 
0.897366911895652, 0.124082602944642, 1.83235767412441, -0.14103703700562, 
0.957793085827849, 0.277136877144504, 0.464623855107616, 2.04400842440552, 
0.896194758107584, 0.562591741800035, 1.11337334634118, 0.680361922637898, 
1.55773369386323, 0.803060478551213, 0.842087084199926, 0.897299725897007, 
2.49037541204806, 0.626095745461374, 1.99807485308563), var3 = c(1.00160909456513, 
0.672137620230934, 1.15833122789207, 0.648619953643806, -0.59919071063274, 
2.87689936309182, 0.134983227999234, 1.30622494810311, -4.35295822772392, 
1.55542718434884, -0.0299776025513561, -4.35295822772392, 1.1916512163768, 
-1.0690031689304, 0.702216451354013, -4.35295822772392, 1.53001624481845, 
2.84930532440386, -0.113856775583852, 0.320056993371298, 3.8744977540771, 
0.429001198577856, 1.08993377819927, 9.01226662509849, 0.567552379787263, 
0.667644955730391, 0.257825220378131, 1.52369018096945, -4.35295822772392, 
1.35210272629299, 0.00467776795719592, 10.6062234689839, 0.68745566014783, 
8.2727573329444, -0.235426559245328, 2.14964165245345, 1.35892636801489, 
0.00403263569110306, 2.811721668697, -0.244300154024336, -0.0130639969552401, 
2.16243380850675, 0.0844153948732535, 3.18606305341119, 3.41533471073402, 
0.982606126684218, 0.302065577637963, 0.0171273953294652, -0.135019136222561, 
8.5726030373794, -4.35295822772392, 1.2243934660816, -4.35295822772392, 
0.434497233155148, -0.766478669489751, 0.847756647178218, -4.35295822772392, 
2.0162183838438, 4.32106547822111, 0.0884940230001326, 3.30253367179797, 
-1.43545843472914, 1.99784696589433, 0.533708798871265, 8.15954317908347, 
-1.18884957948292, -1.35132350529794, -0.276760496922638, 0.359175976731085, 
0.358470491058529, 0.334325182509876, 1.26649568555349, 2.03588465893217, 
-4.35295822772392, -0.0208149193732915, -1.714449462649, 1.05204566189433, 
-0.682877302634521, 10.5549997079682, -0.163224439104046, 1.38769437268607, 
1.31896055863769, 0.38481200767317, 3.53572937983515, 0.939475785484913, 
0.848411268657822, 0.721003339082249, 0.453929952506409, 2.45221394751013, 
-1.28801502596584, -0.0684298328540455, 1.01191955569214, -0.0934945137512957, 
-4.35295822772392, 1.55350878372428, 1.75345073671216, 0.0189336728288777, 
0.362482469117602, -0.714422642181384, 1.3480629126612), var4 = c(1.27129603295718, 
-1.73670593390797, -1.87924713539433, -1.00689267291271, -3.4427023442917, 
1.08981523579948, -3.91666309353264, -1.54456763529261, -6.50814579998435, 
0.420830277102208, -1.51631871391336, -1.67982973099713, -2.16809975386325, 
-0.703277065657377, -1.19451339504835, -6.50814579998435, -1.19235068143037, 
-1.49267904065091, -0.74456422547599, -3.2479785556142, 0.293811997524274, 
-0.306554165788819, -0.540363712694524, -6.50814579998435, -0.624031975528875, 
-2.15262412728046, -1.33293014878597, -4.71284646648463, -6.50814579998435, 
-1.32117821775747, -2.32563079190724, -6.50814579998435, -1.2506474836629, 
-6.50814579998435, -2.63787000032375, -0.066706145294607, -2.28486522719624, 
-1.749526333499, -0.841064115771509, -3.90120511660975, -1.79724111238401, 
-0.918022501064342, -2.0891112424212, 0.679380979141177, 0.260953261599768, 
-0.761280247276694, -1.64998795562906, -3.42464356465903, -2.071564270724, 
-6.50814579998435, -1.37363417684091, 0.307927190332797, -0.609044597271349, 
-1.88222402686293, -0.910967865622226, -6.50814579998435, -6.50814579998435, 
-3.48178606325636, -1.28266485348154, -1.71634527789696, 1.25829055659671, 
-3.850444790783, -0.292922485237628, -1.75431062137546, -6.50814579998435, 
-2.92258965432918, -4.30063589701547, -1.0491217545282, -0.872786967871075, 
-1.19250244257853, -2.68450634148801, -0.372235687232108, 0.469395820993578, 
-6.50814579998435, -1.2546406654409, -2.75391479007392, -2.11572086099397, 
0.010147797525201, -6.50814579998435, -2.50865672632938, -0.40434142193162, 
0.895938547905838, -0.239574159541785, 1.12628156865921, -1.44087317861875, 
-1.07405755507249, -1.02381275292426, -0.641849193960849, -2.19875724597918, 
-1.90368718123766, -5.04377008181742, -1.22294422036976, -3.19518714453377, 
-1.94867311331168, -0.0355802691650244, -2.22057675020776, -3.18054112541048, 
-1.17685533351222, -2.55579722389006, -0.954198881377253), var6 = c(-8.77317064977228, 
-8.56362072689587, -5.06568075139293, -5.8602372994869, -10.8600329197821, 
-10.8600329197821, -10.8600329197821, -9.14189485837309, -10.8600329197821, 
-10.8600329197821, -10.8600329197821, -6.65565950352082, -5.89985771358851, 
-6.56025726099769, -5.06214962854289, -10.8600329197821, -5.43644871950305, 
-10.8600329197821, -5.49988616728945, -10.8600329197821, -10.8600329197821, 
-10.8600329197821, -6.30543511981882, -10.8600329197821, -10.8600329197821, 
-10.8600329197821, -10.8600329197821, -5.92808684748435, -10.8600329197821, 
-9.04626075433508, -10.8600329197821, 6.58481226187201, -10.8600329197821, 
-10.8600329197821, -7.50435387465533, -10.8600329197821, -10.8600329197821, 
-4.5272733635962, -10.8600329197821, -10.8600329197821, -6.73296140114314, 
-10.8600329197821, -8.75099134145485, -10.8600329197821, -2.86951195774468, 
-5.11563855726648, -6.79662923679483, -10.8600329197821, -10.8600329197821, 
-10.8600329197821, -10.8600329197821, -5.6259863407905, -10.8600329197821, 
-6.70695463385735, -5.02957752674785, -10.8600329197821, -10.8600329197821, 
-10.8600329197821, -3.01091065888899, -9.79566581625367, -1.78344425962383, 
-10.8600329197821, -5.51215157617147, -8.03592819596774, -10.8600329197821, 
-5.89239954284383, -6.62065938950444, -7.31779009660874, -10.8600329197821, 
-10.8600329197821, -10.8600329197821, -8.80635191531331, -3.84259741115852, 
-10.8600329197821, -6.12296304573489, -5.0377139376075, -8.30331676060807, 
-3.67557403821932, 5.84080917530208, -10.8600329197821, -10.8600329197821, 
-7.84737562383492, -6.36550232886693, -4.45380988995396, -6.11390183309968, 
-4.31903240920357, -10.8600329197821, -5.53081162440189, -10.8600329197821, 
-10.8600329197821, -9.81773892917815, -6.43934499413147, -10.8600329197821, 
-10.8600329197821, -6.12874257341012, -10.8600329197821, -8.92520780142023, 
-10.8600329197821, -8.45089896740659, 3.5125642939694), var5 = c(0.221164322015587, 
-1.75345420556099, -0.597178517441407, -0.279478123999225, -1.87759518392492, 
0.485154837493812, -0.890616922739509, -1.07039196872649, -5.78021577799099, 
-0.594908285405899, -1.14565955035268, -1.22963397228915, -2.77595480188379, 
-0.639074304783455, 0.271731060307341, -5.78021577799099, 0.269330918456738, 
0.0676082402050221, -0.833840081467789, -2.32833237810147, -5.78021577799099, 
-0.343573342340476, -0.842862429541462, -5.78021577799099, -0.371149824418796, 
-5.78021577799099, -1.11612015643887, -2.0011504165272, -5.78021577799099, 
-0.674266616590759, 0.257606429920767, -5.78021577799099, -3.39812799683953, 
-5.78021577799099, -2.26574609892532, 0.330913471858659, -1.85009373889213, 
-0.613109100980674, -0.710419894479443, -0.613832203803001, -1.59900080399472, 
0.2380363271816, -1.14939103495457, 1.17444996730064, -0.0530384808955081, 
-0.967069676026141, -2.1153908984289, -1.79191148359456, -0.417622430391506, 
-5.78021577799099, -5.78021577799099, 0.585788047776912, -0.301754007186611, 
-0.972356997908185, 0.226754528534945, -2.02708058480777, -5.78021577799099, 
0.154584280991563, -5.78021577799099, 0.252459199383738, 1.22560744488516, 
-3.65176265015781, 1.13978161668709, -1.79787934858811, -5.78021577799099, 
-1.30053709195946, -1.96552742317638, -1.03473208650946, -2.18557107554134, 
-1.20933544168721, -1.6928660945641, -0.673990048179032, 0.468580599306031, 
-5.78021577799099, -0.820355313833179, -0.872371293973152, -0.931700712893974, 
0.322128176208049, -5.78021577799099, -1.48331658721109, -1.89004214186016, 
-0.701901379605352, -0.144021894178888, 1.87622637834411, -1.11743788947157, 
-0.767060939087396, -0.650882651070608, -0.244014342639601, -0.729067168905347, 
-1.32035601434369, -4.78021577799099, -0.322803449659705, -1.5763652953542, 
-1.75238903619498, -0.745422054062242, -0.484758038451173, -0.34081369071379, 
-2.12216851783694, -0.269095171132888, 0.188786532276764), var11 = c(-2.16481608903487, 
-4.50853902279846, -1.97166634702243, 1.53412995617401, -2.63973760744524, 
-0.488664090656482, -4.38274095310386, -2.29223041687919, -7.22255336242347, 
-2.38672345652796, -0.891769339613153, -4.57405676726292, -2.7666794552248, 
-3.29124320816999, -4.17213779533038, -7.22255336242347, -2.54116320861255, 
-1.84732415812304, 1.20494627643505, -1.967396957714, -3.4740585530148, 
-2.81779616718194, -2.83479957061812, 5.45643223095428, -3.85679328615594, 
-5.08315198501481, -2.60556631400667, 2.52686248487654, -7.22255336242347, 
-2.38301058512261, -3.97711627894401, -7.22255336242347, 0.413655953956429, 
-7.22255336242347, -4.02386322802863, -4.41067722855315, -2.34149130020581, 
-1.6606811577764, -1.1484598005909, -2.79168686165664, -3.03617893487314, 
-7.22255336242347, -0.726491942944442, -2.77825627043031, -7.22255336242347, 
-4.03782509841298, -4.25515946952713, -2.63187069137713, -3.08659394631456, 
5.6747602620056, -2.46972227165758, -2.5781501337784, -3.7691510114214, 
-2.99593463153195, -3.69098692956035, -2.03906382404617, -7.22255336242347, 
-4.2011021191255, -3.61460345778439, -2.55847773948177, 0.641568716102673, 
-2.69160663800394, -4.24839284028547, -3.59366549437894, -7.22255336242347, 
-4.27360256269383, -4.15734715749615, -2.46774990612004, -4.17371019448352, 
-3.31130449407867, -7.22255336242347, -4.19158549847821, -2.21581173251343, 
-7.22255336242347, -1.45614659009669, -3.44673676575, -4.89472745029697, 
-3.86215202836492, -7.22255336242347, -4.26121794495675, -7.22255336242347, 
-2.28438945731791, -3.25391679099563, 0.949770070866544, 0.343031917968915, 
-4.00572581296898, -3.10423988372715, -2.01746684918339, -3.33269057543637, 
-3.00670091034164, -1.63627774868854, -0.607613371042468, -2.77002290990708, 
-1.74281213037036, -3.69166778337422, -3.24614868833834, -3.80874098438962, 
2.96015708267, -2.88102890061418, -3.39299813887799), Nbr = structure(c(28L, 
5L, 7L, 4L, 19L, 17L, 30L, 20L, 16L, 25L, 3L, 4L, 25L, 10L, 2L, 
14L, 25L, 14L, 13L, 33L, 23L, 21L, 12L, 16L, 2L, 26L, 15L, 32L, 
14L, 9L, 8L, 34L, 7L, 34L, 20L, 10L, 31L, 9L, 33L, 31L, 30L, 
14L, 18L, 11L, 23L, 20L, 5L, 7L, 2L, 16L, 17L, 8L, 6L, 9L, 6L, 
17L, 22L, 8L, 33L, 34L, 3L, 19L, 27L, 15L, 34L, 21L, 15L, 30L, 
24L, 8L, 5L, 5L, 32L, 16L, 3L, 27L, 6L, 8L, 16L, 21L, 28L, 5L, 
1L, 18L, 9L, 15L, 2L, 3L, 7L, 8L, 24L, 11L, 19L, 5L, 23L, 4L, 
31L, 32L, 26L, 1L), levels = c("1", "2", "3", "4", "5", "6", 
"7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", 
"18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", 
"29", "30", "31", "32", "33", "34"), class = "factor")), row.names = c(NA, 
-100L), class = "data.frame")

Code

library(tidyverse)
library(gridExtra) # to combine graphs
library(FactoMineR) # to do PCA

## PCA 34 
pcaFM34 <- FactoMineR::PCA(MWEdf[1:11],scale.unit = TRUE, graph = FALSE)

varsDF34 <- as.data.frame(pcaFM34$var$coord) %>%
    rownames_to_column("Var") %>%
    as_tibble() %>%
    select(Var, Dim.1, Dim.2)

pca34 <- MWEdf %>%
    ggplot() +
    geom_hline(yintercept = 0, linetype = 3, colour = "grey20") +
    geom_vline(xintercept = 0, linetype = 3, colour = "grey20") +
    geom_segment(aes(x = 0, xend = Dim.1 * 7, y = 0, yend = Dim.2 * 7, color = Var), arrow = arrow(length = unit(0.01, "npc"), type = "open"), lwd = 0.5, alpha = 1, data = varsDF34, show.legend = FALSE) +
    geom_text(aes(x = Dim.1 * 7.7, y = Dim.2 * 7.7, label = Var, color = Var), size = 3, nudge_x = 0, nudge_y = 0, alpha = 1, data = varsDF34) +
    scale_color_manual(guide = "none", values = c("#E31A1C","#332288", "#66A61E", "#A9a9a9", "#Ffd700", "#Daa520", "#F4a460", "#00bfff", "#9400d3", "#00ff7f", "#Eeff82")) +
    labs(x = str_c("PC1 (",round(pcaFM34$eig[1, 2], 1), "%)", sep = ""), y = str_c("PC2 (",round(pcaFM34$eig[2, 2], 1),"%)", sep = "")) +
    labs(title = "PCA of 34 subjects") +
    guides(color = "none") + 
    theme_classic()

## MWEdf$PC1_34 <- pcaFM34$ind$coord[, 1]
## MWEdf$PC2_34 <- pcaFM34$ind$coord[, 2]

## PCA 30: now the removing 4 subjects 
MWEdf30 <- MWEdf %>%
    filter(!Nbr %in% c(14, 16, 22, 34)) %>%
    as.data.frame()

pcaFM30 <- FactoMineR::PCA(MWEdf30[1:11],scale.unit = TRUE, graph = FALSE)

varsDF30 <- as.data.frame(pcaFM30$var$coord) %>%
    rownames_to_column("Var") %>%
    as_tibble() %>%
    select(Var, Dim.1, Dim.2)

pca30 <- MWEdf %>%
    ggplot() +
    geom_hline(yintercept = 0, linetype = 3, colour = "grey20") +
    geom_vline(xintercept = 0, linetype = 3, colour = "grey20") +
    geom_segment(aes(x = 0, xend = Dim.1 * 7, y = 0, yend = Dim.2 * 7, color = Var), arrow = arrow(length = unit(0.01, "npc"), type = "open"), lwd = 0.5, alpha = 1, data = varsDF30, show.legend = FALSE) +
    geom_text(aes(x = Dim.1 * 7.7, y = Dim.2 * 7.7, label = Var, color = Var), size = 3, nudge_x = 0, nudge_y = 0, alpha = 1, data = varsDF30) +
    scale_color_manual(guide = "none", values = c("#E31A1C","#332288", "#66A61E", "#A9a9a9", "#Ffd700", "#Daa520", "#F4a460", "#00bfff", "#9400d3", "#00ff7f", "#Eeff82")) +
    labs(x = str_c("PC1 (",round(pcaFM30$eig[1, 2], 1), "%)", sep = ""), y = str_c("PC2 (",round(pcaFM30$eig[2, 2], 1),"%)", sep = "")) +
    labs(title = "PCA of 30 subjects") +
    guides(color = "none") + 
    theme_classic()

gridExtra::grid.arrange(pca30, pca34, nrow = 1, padding = unit(0, "line"))

Output

enter image description here

What is needed

Please, look at var1, var2, and var3 before and after removing the four subjects. They continue to have the same relationship but rotate with others. So my question: How to best visualize the rotation of variables? Can we get shiny or plotly to convey this difference? If not, what other options exist to make this change visually possible?

NB The challenge is to predict the direction of some variables that rotated more than others because it could be either way. Can the data offer a clue as to which direction these variables moved? For var1, var2, and var3 as an example, it is easy to predict that they move from Lt to the Rt on PC1 since they kept the same relationship to each other, and they all moved together.

Hint

One way to do this may be to randomly sample another subset from the large group after removal and see where variables would land by PCA. Then we can predict the direction of variables based on this newly sampled dataset, which will be our clue as to the transitional position of variables before we can construct their final continuous movement on the first space. I wonder how to achieve this in R.

doctorate
  • 1,381
  • 1
  • 19
  • 43

1 Answers1

1

This was my trial to generate two sets of graphs, each with separate randomly sliced observations from the dataset to enhance the visualization and reveal directions of the rotating variables in the first PCA space made by PC1 and PC2. I also provide a bash code to generate gif animation from the sequential graphs in Linux; however, the animation is not smooth because the center of PCA changes with each dataset. What better way(s) are there to do something similar?

R Code

## Data A (pc34A and pc30A)
set.seed(99)
MWEdfA <- df %>%
    slice_sample(n = 100)

## PCA 34 

pcaFM34A <- FactoMineR::PCA(MWEdfA[1:11],scale.unit = TRUE, graph = FALSE)

varsDF34A <- as.data.frame(pcaFM34A$var$coord) %>%
    rownames_to_column("Var") %>%
    as_tibble() %>%
    select(Var, Dim.1, Dim.2)

pca34A <- MWEdfA %>%
    ggplot() +
    geom_hline(yintercept = 0, linetype = 3, colour = "grey20") +
    geom_vline(xintercept = 0, linetype = 3, colour = "grey20") +
    geom_segment(aes(x = 0, xend = Dim.1 * 7, y = 0, yend = Dim.2 * 7, color = Var), arrow = arrow(length = unit(0.01, "npc"), type = "open"), lwd = 0.5, alpha = 1, data = varsDF34A, show.legend = FALSE) +
    geom_text(aes(x = Dim.1 * 7.7, y = Dim.2 * 7.7, label = Var, color = Var), size = 3, nudge_x = 0, nudge_y = 0, alpha = 1, data = varsDF34A) +
    scale_color_manual(guide = "none", values = c("#E31A1C","#332288", "#66A61E", "#A9a9a9", "#Ffd700", "#Daa520", "#F4a460", "#00bfff", "#9400d3", "#00ff7f", "#Eeff82")) +
    labs(x = str_c("PC1 (",round(pcaFM34A$eig[1, 2], 1), "%)", sep = ""), y = str_c("PC2 (",round(pcaFM34A$eig[2, 2], 1),"%)", sep = "")) +
    labs(title = "PCA of 34A subjects") +
    guides(color = "none") + 
    theme_classic()

## MWEdfA$PC1_34 <- pcaFM34A$ind$coord[, 1]
## MWEdfA$PC2_34 <- pcaFM34A$ind$coord[, 2]

## PCA 30: now the removing four subjects 
MWEdfA30 <- MWEdfA %>%
    filter(!Nbr %in% c(14, 16, 22, 34)) %>%
    as.data.frame()

pcaFM30A <- FactoMineR::PCA(MWEdfA30[1:11],scale.unit = TRUE, graph = FALSE)

varsDF30A <- as.data.frame(pcaFM30A$var$coord) %>%
    rownames_to_column("Var") %>%
    as_tibble() %>%
    select(Var, Dim.1, Dim.2)

pca30A <- MWEdfA %>%
    ggplot() +
    geom_hline(yintercept = 0, linetype = 3, colour = "grey20") +
    geom_vline(xintercept = 0, linetype = 3, colour = "grey20") +
    geom_segment(aes(x = 0, xend = Dim.1 * 7, y = 0, yend = Dim.2 * 7, color = Var), arrow = arrow(length = unit(0.01, "npc"), type = "open"), lwd = 0.5, alpha = 1, data = varsDF30A, show.legend = FALSE) +
    geom_text(aes(x = Dim.1 * 7.7, y = Dim.2 * 7.7, label = Var, color = Var), size = 3, nudge_x = 0, nudge_y = 0, alpha = 1, data = varsDF30A) +
    scale_color_manual(guide = "none", values = c("#E31A1C","#332288", "#66A61E", "#A9a9a9", "#Ffd700", "#Daa520", "#F4a460", "#00bfff", "#9400d3", "#00ff7f", "#Eeff82")) +
    labs(x = str_c("PC1 (",round(pcaFM30A$eig[1, 2], 1), "%)", sep = ""), y = str_c("PC2 (",round(pcaFM30A$eig[2, 2], 1),"%)", sep = "")) +
    labs(title = "PCA of 30A subjects") +
    guides(color = "none") + 
    theme_classic()

## Data B (pc34A and PCA30A)
set.seed(1)
MWEdfB <- df %>%
    slice_sample(n = 100)

## PCA 34 

pcaFM34B <- FactoMineR::PCA(MWEdfB[1:11],scale.unit = TRUE, graph = FALSE)

varsDF34A <- as.data.frame(pcaFM34B$var$coord) %>%
    rownames_to_column("Var") %>%
    as_tibble() %>%
    select(Var, Dim.1, Dim.2)

pca34B <- MWEdfB %>%
    ggplot() +
    geom_hline(yintercept = 0, linetype = 3, colour = "grey20") +
    geom_vline(xintercept = 0, linetype = 3, colour = "grey20") +
    geom_segment(aes(x = 0, xend = Dim.1 * 7, y = 0, yend = Dim.2 * 7, color = Var), arrow = arrow(length = unit(0.01, "npc"), type = "open"), lwd = 0.5, alpha = 1, data = varsDF34A, show.legend = FALSE) +
    geom_text(aes(x = Dim.1 * 7.7, y = Dim.2 * 7.7, label = Var, color = Var), size = 3, nudge_x = 0, nudge_y = 0, alpha = 1, data = varsDF34A) +
    scale_color_manual(guide = "none", values = c("#E31A1C","#332288", "#66A61E", "#A9a9a9", "#Ffd700", "#Daa520", "#F4a460", "#00bfff", "#9400d3", "#00ff7f", "#Eeff82")) +
    labs(x = str_c("PC1 (",round(pcaFM34B$eig[1, 2], 1), "%)", sep = ""), y = str_c("PC2 (",round(pcaFM34B$eig[2, 2], 1),"%)", sep = "")) +
    labs(title = "PCA of 34B subjects") +
    guides(color = "none") + 
    theme_classic()

## MWEdfB$PC1_34 <- pcaFM34B$ind$coord[, 1]
## MWEdfB$PC2_34 <- pcaFM34B$ind$coord[, 2]

## PCA 30: now the removing four subjects 
MWEdfB30 <- MWEdfB %>%
    filter(!Nbr %in% c(14, 16, 22, 34)) %>%
    as.data.frame()

pcaFM30B <- FactoMineR::PCA(MWEdfB30[1:11],scale.unit = TRUE, graph = FALSE)

varsDF30B <- as.data.frame(pcaFM30B$var$coord) %>%
    rownames_to_column("Var") %>%
    as_tibble() %>%
    select(Var, Dim.1, Dim.2)

pca30B <- MWEdfB %>%
    ggplot() +
    geom_hline(yintercept = 0, linetype = 3, colour = "grey20") +
    geom_vline(xintercept = 0, linetype = 3, colour = "grey20") +
    geom_segment(aes(x = 0, xend = Dim.1 * 7, y = 0, yend = Dim.2 * 7, color = Var), arrow = arrow(length = unit(0.01, "npc"), type = "open"), lwd = 0.5, alpha = 1, data = varsDF30B, show.legend = FALSE) +
    geom_text(aes(x = Dim.1 * 7.7, y = Dim.2 * 7.7, label = Var, color = Var), size = 3, nudge_x = 0, nudge_y = 0, alpha = 1, data = varsDF30B) +
    scale_color_manual(guide = "none", values = c("#E31A1C","#332288", "#66A61E", "#A9a9a9", "#Ffd700", "#Daa520", "#F4a460", "#00bfff", "#9400d3", "#00ff7f", "#Eeff82")) +
    labs(x = str_c("PC1 (",round(pcaFM30B$eig[1, 2], 1), "%)", sep = ""), y = str_c("PC2 (",round(pcaFM30B$eig[2, 2], 1),"%)", sep = "")) +
    labs(title = "PCA of 30B subjects") +
    guides(color = "none") + 
    theme_classic()

ggsave(plot = pca30A, file = str_c(getwd(), "PCA30A.png",sep="/"), width = 6, height = 6, units = "in", dpi = 600)
ggsave(plot = pca30B, file = str_c(getwd(), "PCA30B.png",sep="/"), width = 6, height = 6, units = "in", dpi = 600)
ggsave(plot = pca34A, file = str_c(getwd(), "PCA34A.png",sep="/"), width = 6, height = 6, units = "in", dpi = 600)
ggsave(plot = pca34B, file = str_c(getwd(), "PCA34B.png",sep="/"), width = 6, height = 6, units = "in", dpi = 600)

gridExtra::grid.arrange(pca30A, pca30B, pca34B, pca34A, nrow = 1, padding = unit(0, "line"))

## To create GIF animation, rename the images sequentially like this: 1-PCA30A.png 2-PCA30B.png 3-PCA34B.png 4-PCA34A.png 
## Linux command line: convert -delay 100 -loop 0 *.png output.gif

Output using gridExtra

enter image description here

Output as gif animation

enter image description here

Update: PCA coordinates aligned

this code added to the above ggplot() graphs and coordinates get unified:

coord_cartesian(ylim = c(-5, 6), xlim = c(-6, 7)) +

I put this line after labs(title = ...) line.

Improved gridExtra output

enter image description here

Improved gif animation output

enter image description here

So this animation reveals exciting observations:

  • The vars 1, 2, and 3 moved together as expected toward the left from positive to negative scores along PC1 with var2 being the fastest variable that went all the way till it scored negatively on PC2.
  • Vars 4 and 5 begin widely separate, then they move toward each other as two dear lovers and make higher scores on PC1 till they almost meet with their highest score on PC1.
  • Var 6, 8, and 9 are moving up from negative to positive PC2 scores
  • Var 7 is just moving too little to earn a comment
  • Var 10 is the only variable that made the most drastic movement as it reversed scores on PC1 and PC2 (similar to var2).
  • Var 11 is moving down from positive PC2 scores to negative ones

Disclaimer

Given the domain area of research and the original identity of these recoded variables, the movement of these genes in the directions described above makes a lot of sense from the biological point of view. I see great value in following a similar approach in this field by subtracting a distinct subset of observations to clarify a specific point and justify a study's results. I hope this can draw more attention.

What is needed?

Generate something similar in R with a unified center to smoothly depict each variable's movement stepwise on the first PCA space made by PC1 and PC2. I don't know, but I feel like I am asking for a yet-to-be-created R package.

Dataset Provided upon Request

This is because of the limited size of lines allowed here.

doctorate
  • 1,381
  • 1
  • 19
  • 43