Page 3 of 3 FirstFirst 123
Results 21 to 25 of 25

Thread: New version of K15 PCA (bullseye plot)

  1. #21
    Veteran Member
    Apricity Funding Member
    "Friend of Apricity"

    Komintasavalta's Avatar
    Join Date
    Sep 2020
    Last Online
    Yesterday @ 09:19 PM
    Location
    コミ共和国
    Meta-Ethnicity
    Finno-Permic
    Ethnicity
    Peasant
    Ancestry
    コミ
    Country
    Finland
    Taxonomy
    Karaboğa (euryprosopic, platyrrhine, dolichocephalic)
    Relationship Status
    Virgin
    Gender
    Posts
    2,060
    Thumbs Up
    Received: 4,731
    Given: 2,915

    2 Not allowed!

    Default

    The plots posted in this thread don't take FST into account, so many north Caucasisans plot further right on PC1 than Chuvashes. But if you multiply the matrix of admixture percentages with an MDS matrix of the FST matrix, then Chuvashes plot much further east on PC1:



    Or here's K15 updated along with some of my new averages:



    Code:
    library(tidyverse)
    library(ggforce)
    
    t=read.csv("https://pastebin.com/raw/hDBUcTL8",row.names=1,check.names=F) # K13 original
    
    A=function(x)unlist(strsplit(x," "))
    pick=A("Adygei Ashkenazi Austrian Balkar Belorussian Bulgarian Central_Greek Chechen Chuvash Croatian Danish East_Finnish East_German East_Sicilian Erzya Estonian Estonian_Polish Finnish French French_Basque Greek Greek_Thessaly Hungarian Irish Italian_Abruzzo Italian_Jewish Kabardin Kargopol_Russian Kumyk Lezgin Lithuanian Mari Moldavian Nogay North_Dutch North_German North_Italian North_Ossetian North_Swedish Norwegian Orcadian Ossetian Polish Portuguese Romanian Russian_Smolensk Sardinian Serbian South_Dutch South_Italian South_Polish Southeast_English Southwest_English Southwest_Finnish Southwest_French Southwest_Russian Spanish_Andalucia Spanish_Aragon Spanish_Cantabria Spanish_Castilla_La_Mancha Spanish_Castilla_Y_Leon Spanish_Cataluna Spanish_Extremadura Spanish_Galicia Spanish_Murcia Spanish_Valencia Swedish Tabassaran Tatar Tuscan Ukrainian Ukrainian_Belgorod Ukrainian_Lviv West_German West_Norwegian West_Scottish West_Sicilian")
    t=t[pick,]
    
    fst=as.matrix(as.dist(read.csv(text=",,,,,,,,,,,,,,
    0.015,,,,,,,,,,,,,,
    0.02,0.022,,,,,,,,,,,,,
    0.02,0.022,0.024,,,,,,,,,,,,
    0.029,0.028,0.037,0.038,,,,,,,,,,,
    0.027,0.026,0.033,0.031,0.035,,,,,,,,,,
    0.026,0.024,0.034,0.032,0.027,0.019,,,,,,,,,
    0.053,0.05,0.059,0.058,0.051,0.046,0.038,,,,,,,,
    0.06,0.062,0.064,0.056,0.075,0.053,0.055,0.078,,,,,,,
    0.112,0.114,0.115,0.102,0.123,0.109,0.11,0.127,0.075,,,,,,
    0.111,0.113,0.114,0.1,0.125,0.11,0.112,0.13,0.083,0.056,,,,,
    0.138,0.141,0.141,0.128,0.156,0.14,0.143,0.161,0.12,0.113,0.107,,,,
    0.178,0.179,0.181,0.173,0.188,0.176,0.174,0.19,0.145,0.166,0.178,0.217,,,
    0.109,0.108,0.114,0.108,0.112,0.103,0.094,0.106,0.102,0.137,0.144,0.178,0.195,,
    0.144,0.144,0.148,0.142,0.149,0.139,0.132,0.139,0.131,0.164,0.171,0.204,0.219,0.042,",head=F)))/1000
    
    t2=as.matrix(t)%*%cmdscale(fst,ncol(fst)-1)
    
    p0=prcomp(t2)
    pct=paste0(colnames(p0$x)," (",sprintf("%.1f",100*p0$sdev/sum(p0$sdev)),"%)")
    p=as.data.frame(p0$x)
    
    p[,1]=-p[,1]
    p=p/sd(p[,1])
    
    p$pop=as.factor(cutree(hclust(dist(t2)),16))
    
    set.seed(1)
    hue=seq(0,360,length.out=nlevels(p$pop)+1)%>%head(-1)%>%sample()
    pal1=hcl(hue,100,55)
    
    i=1
    
    xpc=sym(paste0("PC",i))
    ypc=sym(paste0("PC",i+1))
    seg=lapply(1:3,function(j)apply(as.matrix(dist(t)),1,function(x)unlist(p[names(sort(x)[j]),c(i,i+1)],use.names=F))%>%t%>%cbind(p[,c(i,i+1)]))%>%do.call(rbind,.)%>%setNames(paste0("V",1:4))
    
    ggplot(p,aes(!!xpc,!!ypc))+
    geom_segment(data=seg,aes(x=V1,y=V2,xend=V3,yend=V4),color="gray50",size=.1)+
    ggforce::geom_mark_hull(aes(group=pop),color=pal1[p$pop],fill=pal1[p$pop],concavity=100,radius=unit(.15,"cm"),expand=unit(.15,"cm"),alpha=.2,size=.15)+
    geom_point(aes(x=!!xpc,y=!!ypc),color=pal1[p$pop],size=.3)+
    geom_text(aes(x=!!xpc,y=!!ypc,label=rownames(p)),color=pal1[p$pop],size=2,vjust=-.6)+
    labs(x=pct[i],y=pct[i+1])+
    scale_x_continuous(breaks=seq(-10,10,.5),expand=expansion(.06))+
    scale_y_continuous(breaks=seq(-10,10,.5),expand=expansion(.03))+
    theme(
      axis.ticks=element_blank(),
      axis.ticks.length=unit(0,"pt"),
      axis.text.y=element_text(angle=90,vjust=1,hjust=.5),
      axis.text=element_text(color="black",size=6),
      axis.title=element_text(color="black",size=8),
      legend.position="none",
      panel.background=element_rect(fill="white"),
      plot.background=element_rect(fill="white",color=NA),
      panel.border=element_rect(color="gray80",fill=NA,size=.4),
      panel.grid.minor=element_blank(),
      panel.grid.major=element_line(color="gray90",size=.2)
    )
    
    ggsave(paste0(i,".png"),width=7,height=7)
    Last edited by Komintasavalta; 10-28-2021 at 02:22 PM.

  2. #22
    Senior Member Gergő Marosvári's Avatar
    Join Date
    Jan 2021
    Last Online
    Yesterday @ 08:13 PM
    Location
    Borsod-Abaúj-Zemplén county/North Hungary
    Meta-Ethnicity
    Steppe warriors
    Ethnicity
    Hungarian (Magyar)
    Ancestry
    Mostly Hungarian (possibly with little Székely ancestry) 1/16 Zipser German Distant Rusyn, Slovak
    Country
    Hungary
    Y-DNA
    R1a-YP1337 (East Europe/Russia)
    mtDNA
    U2e1/U2e1b1 (Hungarian Conqueror: Karos1/12 - Karos-Eperjesszög)
    Taxonomy
    East Europid with Borreby and possibly Alföld/Turanid-like influence
    Hero
    Árpád, Saint Stephen I, my family
    Relationship Status
    Single
    Age
    22
    Gender
    Posts
    407
    Thumbs Up
    Received: 692
    Given: 337

    4 Not allowed!

    Default

    Me



    My grandmother



    My mother, her's is really a BULLSEYE!





  3. #23
    Veteran Member noricum's Avatar
    Join Date
    Sep 2009
    Last Online
    Yesterday @ 09:12 PM
    Ethnicity
    Lavanttaler
    Country
    Austria
    Y-DNA
    R-BY96309
    mtDNA
    H5-T16304C
    Gender
    Posts
    1,317
    Thumbs Up
    Received: 1,559
    Given: 1,274

    2 Not allowed!

    Default

    Me



    Единокровный брат



    Schwägerin


  4. #24
    Senior Member celticdragongod's Avatar
    Join Date
    Dec 2017
    Last Online
    Yesterday @ 10:52 PM
    Meta-Ethnicity
    Celtic
    Ethnicity
    Irish
    Country
    United States
    Politics
    Irish Republican
    Gender
    Posts
    939
    Thumbs Up
    Received: 1,847
    Given: 3,488

    1 Not allowed!

  5. #25
    Veteran Member Apricity Funding Member
    "Friend of Apricity"

    calxpal's Avatar
    Join Date
    Mar 2018
    Last Online
    Today @ 01:13 AM
    Ethnicity
    British/Irish/French Canadian/Ukrainian
    Country
    Canada
    mtDNA
    T2a
    Relationship Status
    Single
    Age
    25
    Gender
    Posts
    2,755
    Thumbs Up
    Received: 6,306
    Given: 10,129

    4 Not allowed!

    Default

    Me


    Dad



    Mom



    Grandma

    Last edited by calxpal; 11-01-2021 at 06:27 AM.
    =(^.^)=

Page 3 of 3 FirstFirst 123

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Replies: 17
    Last Post: 08-28-2018, 12:30 PM
  2. Replies: 40
    Last Post: 05-03-2018, 10:09 PM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •