compare average of users from your ethnicity to K13 official averages

**Jana** · 05-17-2021, 11:30 PM

I composed average of all 17 Croatian users from our K13 spreadsheet:

https://onedrive.live.com/redir?resi...cdocx&e=opab1c

And got this:

Code:

TA_Croat,27.57,33.92,14.75,8.09,11.38,1.44,0.66,0.49,0.39,0.82,0.11,0.02,0.13

It's extremely tight fit with official Croatian average, which means we did great job with it!

17 users here are as we see super representative for Croatia as a whole, mix od dinaric and panonnian Croats with some being admixed with minorites which reflects well society of Croatia.

Target: TA_Croat
Distance: 0.6343% / 0.63430801 | ADC: 0.5x RC

43.9 Croat
35.0 Bosniak_Bosnia
21.1 Croat_North

Target: TA_Croat
Distance: 0.8339% / 0.83389597 | R2P | ADC: 1x RC

82.4 Bosniak_Bosnia
17.6 Austrian

Distance to: TA_Croat

0.50706162 35.20% Greek_Western-Thrace + 64.80% Polish

I used:

Spoiler!

**Jana** · 05-17-2021, 11:32 PM

I would like to see TA users average for other nations too, to compare them to official averages in Vahaduo spreadsheets. Include all users from your ethnicity you can find in the spreadsheet, except if somebody has super foreign mix, like Gypsy for example, or has too much recent foreign ancestry (parent eg)

**Jana** · 05-17-2021, 11:37 PM

List of Hungarian users in case somebody wants to do them:

n=25

Spoiler!

**Jana** · 05-17-2021, 11:43 PM

You can help yourself to find all users of your ethnicity by typing for example: "Italian" or "English" is the search option of the document, so it will list all users with that given ethnicity.

**Jana** · 05-17-2021, 11:53 PM

Serbian users

n=26

Spoiler!

**Jana** · 05-18-2021, 12:01 AM

Portuguese users

n=20

Spoiler!

etc...

**Leto** · 05-18-2021, 12:19 AM

I've excluded the half Russians but included people with more distant non-Russian ancestry (besides Ukrainian & Belorussian which are not foreign)

Code:

Russian_TA_avg,25.72,47.28,8.32,6.32,4.00,0.76,1.69,0.39,3.74,1.02,0.40,0.09,0.27

Distance to: Russian_TA_avg
1.78390022 Russian_average
2.92396990 Russian_Southwest
3.93282341 Russian_Kostroma
4.09222433 Ukrainian_Belgorod
4.19565251 Russian_Smolensk
4.26051640 Belarusian_Minsk
4.44507593 Russian_Kargopol
4.47898426 Ukrainian
4.54598724 Mordovian
5.73861482 Belorussian

Distance to: Russian_TA_avg
0.64051388 70.80% Russian_average + 29.20% Ukrainian_Belgorod
0.73731215 63.60% Russian_average + 36.40% Russian_Southwest
0.88373811 39.00% Russian_Kargopol + 61.00% Russian_Southwest
0.89263126 82.60% Belarusian_Minsk + 17.40% Tatar
0.94162402 59.60% Mordovian + 40.40% Polish
0.99678391 57.40% Mordovian + 42.60% Polish_Kielce
1.06075226 50.20% Russian_Kargopol + 49.80% Ukrainian
1.17542673 10.00% Bashkir + 90.00% Belarusian_Minsk
1.27633230 77.60% Russian_average + 22.40% Ukrainian
1.27673148 66.20% Mordovian + 33.80% Polish_Masuria

Not bad at all, there is plenty of real people with this kind of results!

**Jana** · 05-18-2021, 12:21 AM

Originally Posted by Leto

I've excluded the half Russians but included people with more distant non-Russian ancestry (besides Ukrainian & Belorussian which are not foreign)

Code:

Russian_TA_avg,25.72,47.28,8.32,6.32,4.00,0.76,1.69,0.39,3.74,1.02,0.40,0.09,0.27

Distance to: Russian_TA_avg
1.78390022 Russian_average
2.92396990 Russian_Southwest
3.93282341 Russian_Kostroma
4.09222433 Ukrainian_Belgorod
4.19565251 Russian_Smolensk
4.26051640 Belarusian_Minsk
4.44507593 Russian_Kargopol
4.47898426 Ukrainian
4.54598724 Mordovian
5.73861482 Belorussian

Distance to: Russian_TA_avg
0.64051388 70.80% Russian_average + 29.20% Ukrainian_Belgorod
0.73731215 63.60% Russian_average + 36.40% Russian_Southwest
0.88373811 39.00% Russian_Kargopol + 61.00% Russian_Southwest
0.89263126 82.60% Belarusian_Minsk + 17.40% Tatar
0.94162402 59.60% Mordovian + 40.40% Polish
0.99678391 57.40% Mordovian + 42.60% Polish_Kielce
1.06075226 50.20% Russian_Kargopol + 49.80% Ukrainian
1.17542673 10.00% Bashkir + 90.00% Belarusian_Minsk
1.27633230 77.60% Russian_average + 22.40% Ukrainian
1.27673148 66.20% Mordovian + 33.80% Polish_Masuria

Not bad at all, there is plenty of real people with this kind of results!

Wow, also super tight fit with Russian average! Nice work

up:
This experiment works very well.

**~~Komintasavalta~~** · 05-18-2021, 03:10 AM

Our resident tsundere got mad at me for some reason again, so maybe I'm not allowed to post in this thread. But it's something that I can do really fast, so I made a CSV file of the lines in the docx file grouped by ethnicity or nationality: https://pastebin.com/raw/DB6vyztL.

Here's a PCA based on the CSV file. The FST distances between the components are not taken into account, so for example the Baltic component is considered to be equally distant from North_Atlantic and East_Asian. Therefore even Samoan, Filipino, Kazakh, and Uyghur users plot between West Asians and Europeans.

Here's also a stacked bar chart made using the Circlize R package:

Some users probably gave fake percentages, because their percentages don't add up to 100:

Code:

> t=read.csv("https://pastebin.com/raw/DB6vyztL",header=T,row.names=2)[,-1]
> s=rowSums(t)
> s2=sort(s[abs(s-100)>.5])
> cat(paste(s2,names(s2)),sep="\n")
95.24 Gangrel(Kurd-Turk)
97.18 YupYup(Serb)
97.46 GreentheViper(British-Mexican)
98.02 sonofthedutch(Dutch-English_Canadian)
98.02 Sturmgewehr(Albanian)
98.19 Imperator_Biff(Irish)
98.2 Gooding(Anglo_American)
98.26 Noxv(Chechen)
98.44 Frizzlefry(white_American)
98.62 Malkoz(Turkey)
98.64 lilalila1988(Serb)
98.76 CordedWhelp_father(white_American)
98.94 acbrasil(white_Brazilian)
98.94 Senpai(white_American)
98.97 Catgeorge(Greek)
99.08 Lehel(Hungarian)
99.12 wilhelmhalys(Polish-Spanish)
99.2 Elnar(VolgaTatar-Mordvin)
99.27 Elias(Morrocan-Syrian)
99.27 Yaglakar(Uyghur)
99.28 Cumansky(Polish-Ukrainian)
99.37 Roman-Anatolian(Pontic_Greek)
99.42 Paytonmil(Israeli)
100.62 Mr.G_father(Hungarian)
102 waam(Jew)

Code:

library(tidyverse)
library(ggforce)
library(ggrepel)

t=read.csv("https://pastebin.com/raw/DB6vyztL",header=T,row.names=2,check.names=F)
t=t[t[,1]!="Other",]
pop=t[,1]
t=t[,-1]/100

p=prcomp(t)
pct=paste0(colnames(p$x)," (",sprintf("%.1f",100*p$sdev/sum(p$sdev)),"%)")
p2=as.data.frame(p$x)

centers=aggregate(p2,by=list(pop),mean)

set.seed(1488)
color=as.factor(sample(seq(1,length(unique(pop)))))
col=rbind(c(60,80),c(25,95),c(30,70),c(70,50),c(60,100),c(20,50),c(15,40),c(20,30))
hues=c(0,50,90,130,170,210,240,270,320)+15
pal1=as.vector(apply(col,1,function(x)hcl(seq(15,375,length=hues+1)[1:hues],x[1],x[2])))
pal2=as.vector(apply(col,1,function(x)hcl(seq(15,375,length=hues+1)[1:hues],ifelse(x[2]>50,.8*x[1],.2*x[1]),ifelse(x[2]>50,.3*x[2],100))))

i=1
xpc=sym(paste0("PC",i))
ypc=sym(paste0("PC",i+1))

ranges=apply(p2,2,function(x)abs(max(x)-min(x)))
maxrange=max(ranges[c(i,i+1)])
lims=sapply(c(i,i+1),function(x)mean(range(p2[,x]))+c(-.52*maxrange,.52*maxrange))

p2$pop=pop

load=p$rotation
mult=min(max(p2[,i])/max(load[,i]),max(p2[,i+1])/max(load[,i+1]))

ggplot(p2,aes(!!xpc,!!ypc,group=0))+
# ggforce::geom_mark_hull(aes(group=pop),color=pal1[color[as.factor(pop)]],fill=pal1[color[as.factor(pop)]],concavity=100,radius=unit(.15,"cm"),expand=unit(.15,"cm"),alpha=.2,size=.1)+
geom_point(aes(x=!!xpc,y=!!ypc),color=color[as.factor(pop)],size=.3)+
geom_voronoi_tile(aes(x=!!xpc,y=!!ypc,fill=color[as.factor(pop)],color=color[as.factor(pop)]),size=.07,max.radius=maxrange/40)+
# geom_point(data=centers,aes(x=!!xpc,y=!!ypc,color=color),size=.8)+
# geom_label(data=centers,aes(x=!!xpc,y=!!ypc,label=Group.1),color=pal2[color],fill=pal1[color],alpha=.8,size=2.2,label.r=unit(.1,"lines"),label.padding=unit(.1,"lines"),label.size=0)+
geom_label_repel(data=centers,aes(x=!!xpc,y=!!ypc,label=Group.1),color=pal2[color],fill=pal1[color],alpha=.8,size=2.2,label.r=unit(.1,"lines"),label.padding=unit(.1,"lines"),label.size=.1,max.overlaps=Inf,box.padding=.0,min.segment.length=0,segment.size=.4,segment.color=pal1[color],point.size=0)+
geom_segment(data=load,aes(x=0,y=0,xend=mult*!!xpc,yend=mult*!!ypc),arrow=arrow(length=unit(.3,"lines")),color="gray20",size=.3)+
annotate("text",x=mult*load[,i],y=mult*load[,i+1],label=rownames(load),size=2.2,color="gray20",vjust=ifelse(load[,i+1]>0,-.5,1.4))+
labs(x=pct[i],y=pct[i+1])+
# coord_fixed(xlim=lims[,1],ylim=lims[,2],expand=F)+
coord_fixed()+
scale_x_continuous(breaks=seq(-1,1,.05))+
scale_y_continuous(breaks=seq(-1,1,.05))+
scale_fill_manual(values=pal1)+
scale_color_manual(values=pal2)+
theme(
  axis.text=element_text(color="black",size=6),
  axis.text.y=element_text(angle=90,vjust=1,hjust=.5),
  axis.ticks=element_blank(),
  axis.ticks.length=unit(0,"pt"),
  axis.title=element_text(color="black",size=8),
  legend.position="none",
  panel.background=element_rect(fill="white"),
  panel.border=element_rect(color="gray90",fill=NA,size=.4),
  panel.grid.minor=element_blank(),
  panel.grid.major=element_line(color="gray90",size=.2),
  plot.background=element_rect(fill="white",color=NA)
)

ggsave("a.png",width=9,height=9)

Code:

library(circlize)
library(pheatmap) # for Legend)
library(vegan) # for reorder.hclust
library(dendextend) # for color_branches

t0=read.csv("https://pastebin.com/raw/DB6vyztL")
t=data.frame(aggregate(t0[-c(1:2)],list(t0[,1]),mean),row.names=1)/100
t=t[!rownames(t)=="Other",]

t2=cbind(t[,c(2,1,3,5,4)],rowSums(t[,c(8,9,10)]),rowSums(t[,c(6,7,11,12,13)]))
names(t2)[c(6,7)]=c("East_Asian+Siberian+Amerindian","Other")

hc=hclust(dist(t))
hc=reorder(hc,as.matrix(t2)%*%seq(ncol(t2))^2)
labels=hc$labels[hc$order]
t2=t2[hc$labels[hc$order],]

labelcolor=hcl(c(120,30,120,90,210,0,60,180,330,250,210,90)+15,c(60,60,50,60,50,50,60,50,50,50),c(70,70,50,70,70,70,50,50,50,50,50,50))
barcolor=c(hcl(c(210,120,60,30,0,300)+15,60,70),"gray60")

cut=cutree(hc,12)
dend=color_branches(as.dendrogram(hc),k=length(unique(cut)),col=labelcolor[unique(cut[labels])])

circos.clear()
png("a.png",w=2000,h=2000,res=300)
circos.par(cell.padding=c(0,0,0,0),points.overflow.warning=F)
circos.initialize("a",xlim=c(0,nrow(t)))

circos.track(ylim=c(0,1),bg.border=NA,track.height=.17,track.margin=c(0.0001,0),panel.fun=function(x,y)
  for(i in 1:nrow(t))circos.text(i-.5,0,labels[i],adj=c(0,.5),facing="clockwise",niceFacing=T,cex=.65,col=labelcolor[cut[labels[i]]])
)

circos.track(ylim=c(0,1),track.margin=c(0,.01),track.height=.45,bg.lty=0,panel.fun=function(x,y){
  pos=1:nrow(t2)-.5
  barwidth=1
  for(i in 1:ncol(t2)){
    seq1=rowSums(t2[,seq(i-1),drop=F])
    seq2=rowSums(t2[,seq(i),drop=F])
    circos.rect(pos-barwidth/2,if(i==1){0}else{seq1},pos+barwidth/2,seq2,col=barcolor[i],border="gray15",lwd=.1)
  }
  for(i in 1:ncol(t2)){
    seq1=rowSums(t2[,seq(i-1),drop=F])
    seq2=rowSums(t2[,seq(i),drop=F])
    lab=round(100*t2[,i])
    lab[lab<=1]=""
    circos.text(pos,if(i==1){seq1/2}else{seq1+(seq2-seq1)/2},labels=lab,col="gray15",cex=.5,facing="downward")
  }
})

circos.track(ylim=c(0,attr(dend,"height")),bg.border=NA,track.margin=c(0,.0015),track.height=.35,panel.fun=function(x,y)circos.dendrogram(dend))

lg=Legend(at=colnames(t2),legend_gp=gpar(col=barcolor),background=barcolor,type="points",labels_gp=gpar(fontsize=8))
draw(lg,x=unit(8,"mm"),y=unit(7,"mm"),just=c("left","bottom"))

circos.clear()
dev.off()

**cakmir7y** · 05-18-2021, 06:46 AM

This average is made only out of four members but not bad anyway

czech_average,32.385,38.275,11.7425,6.27,7.78,1.11 75,0.72,0.1575,0.415,0.9825,0.0425,0.2175,0.105

Distance to: czech_average
2.07633993 Czech
2.38468813 Slovak
3.90996004 Sorb_Lusatia
4.66646949 Hungarian_North
4.69077153 South_Polish
5.08493732 Ukrainian_Galicia
5.32107015 Slovenian
5.86122747 Croat_North
6.56045254 Ukrainian_Carpathian
6.83631388 German_East
6.85169596 Hungarian_Transdanubia+Budapest
7.12237934 Moldova_Ukrainian
7.16253010 Hungarian
7.44666956 Hungarian_Alföld
7.89448146 Polish_Masuria
8.10505629 Polish_Kielce
8.65613872 Polish
8.68533174 Croat_East
8.73609967 Croat
9.26421813 Bosniak_Bosnia
9.61205168 Ukrainian
10.20556160 Austrian
10.23029264 Croat_West
11.53568323 Moldova_North
11.58459268 Croat_South

Target: czech_average
Distance: 0.6653% / 0.66533752 | ADC: 0.25x RC
44.0 Czech
39.2 Sorb_Lusatia
16.5 Croat_East
0.3 Karitiana