## code to prepare `idat_example` dataset goes here
library(data.table)
library(tidyverse)
library(omni54manifest)
data(manifest_subset, package = "omni54manifest")
#################################################
nbeads <- c(2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 4L, 4L, 5L, 5L, 5L, 5L, 5L,
5L, 5L, 5L, 5L, 5L, 5L, 5L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L,
6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L,
6L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L,
7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 8L, 8L, 8L, 8L, 8L,
8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L,
8L, 8L, 8L, 8L, 8L, 8L, 8L, 9L, 9L, 9L, 9L, 9L, 9L, 9L, 9L, 9L,
9L, 9L, 9L, 9L, 9L, 9L, 9L, 9L, 9L, 9L, 9L, 9L, 9L, 9L, 9L, 9L,
9L, 9L, 9L, 9L, 9L, 9L, 9L, 9L, 9L, 9L, 9L, 9L, 9L, 9L, 9L, 9L,
9L, 9L, 9L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L,
10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L,
10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L, 10L,
10L, 10L, 10L, 10L, 10L, 10L, 11L, 11L, 11L, 11L, 11L, 11L, 11L,
11L, 11L, 11L, 11L, 11L, 11L, 11L, 11L, 11L, 11L, 11L, 11L, 11L,
11L, 11L, 11L, 11L, 11L, 11L, 11L, 11L, 11L, 11L, 11L, 11L, 11L,
11L, 11L, 11L, 11L, 11L, 11L, 11L, 11L, 11L, 11L, 11L, 11L, 11L,
11L, 11L, 12L, 12L, 12L, 12L, 12L, 12L, 12L, 12L, 12L, 12L, 12L,
12L, 12L, 12L, 12L, 12L, 12L, 12L, 12L, 12L, 12L, 12L, 12L, 12L,
12L, 12L, 12L, 12L, 12L, 12L, 12L, 12L, 12L, 12L, 12L, 12L, 12L,
12L, 12L, 12L, 12L, 12L, 12L, 12L, 12L, 12L, 12L, 12L, 12L, 12L,
12L, 12L, 12L, 12L, 12L, 12L, 12L, 12L, 13L, 13L, 13L, 13L, 13L,
13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L,
13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L,
13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L,
13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L,
13L, 14L, 14L, 14L, 14L, 14L, 14L, 14L, 14L, 14L, 14L, 14L, 14L,
14L, 14L, 14L, 14L, 14L, 14L, 14L, 14L, 14L, 14L, 14L, 14L, 14L,
14L, 14L, 14L, 14L, 14L, 14L, 14L, 14L, 14L, 14L, 14L, 14L, 14L,
14L, 14L, 15L, 15L, 15L, 15L, 15L, 15L, 15L, 15L, 15L, 15L, 15L,
15L, 15L, 15L, 15L, 15L, 15L, 15L, 15L, 15L, 15L, 15L, 15L, 15L,
15L, 15L, 15L, 15L, 15L, 15L, 15L, 15L, 15L, 15L, 15L, 15L, 15L,
15L, 15L, 15L, 15L, 15L, 16L, 16L, 16L, 16L, 16L, 16L, 16L, 16L,
16L, 16L, 16L, 16L, 16L, 16L, 16L, 16L, 16L, 16L, 16L, 16L, 16L,
16L, 16L, 16L, 16L, 16L, 16L, 16L, 16L, 16L, 16L, 16L, 16L, 16L,
16L, 16L, 16L, 16L, 17L, 17L, 17L, 17L, 17L, 17L, 17L, 17L, 17L,
17L, 17L, 17L, 17L, 17L, 17L, 17L, 17L, 17L, 17L, 17L, 18L, 18L,
18L, 18L, 18L, 18L, 18L, 18L, 18L, 18L, 18L, 18L, 18L, 18L, 18L,
18L, 18L, 18L, 18L, 18L, 18L, 18L, 18L, 18L, 18L, 18L, 18L, 18L,
18L, 18L, 19L, 19L, 19L, 19L, 19L, 19L, 19L, 19L, 19L, 19L, 19L,
19L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L, 20L,
21L, 21L, 21L, 21L, 21L, 21L, 21L, 21L, 21L, 21L, 21L, 21L, 22L,
22L, 22L, 22L, 22L, 22L, 23L, 23L, 23L, 23L, 24L, 24L, 24L, 24L,
25L, 25L, 25L, 25L, 26L, 26L, 26L, 26L, 27L, 27L, 27L, 27L, 27L,
27L, 30L, 30L, 31L, 31L, 31L, 31L, 32L, 32L, 32L, 32L, 36L, 36L,
48L, 48L)
get_nbeads <- function(n) {
sample(nbeads, size = n, replace = TRUE)
}
sds <- c(68L, 103L, 115L, 149L, 155L, 159L, 164L, 171L, 176L, 178L,
183L, 184L, 196L, 201L, 215L, 219L, 226L, 228L, 235L, 235L, 242L,
242L, 242L, 242L, 243L, 244L, 247L, 250L, 253L, 258L, 261L, 265L,
270L, 280L, 281L, 282L, 285L, 287L, 288L, 288L, 291L, 293L, 293L,
295L, 297L, 298L, 298L, 298L, 300L, 301L, 302L, 303L, 306L, 308L,
308L, 309L, 310L, 312L, 312L, 314L, 315L, 316L, 317L, 318L, 318L,
318L, 318L, 319L, 320L, 322L, 322L, 326L, 329L, 329L, 331L, 331L,
332L, 333L, 338L, 338L, 338L, 339L, 340L, 340L, 344L, 344L, 346L,
346L, 347L, 347L, 348L, 349L, 349L, 350L, 357L, 358L, 361L, 362L,
362L, 363L, 363L, 363L, 366L, 367L, 367L, 367L, 368L, 368L, 369L,
370L, 370L, 371L, 371L, 373L, 373L, 377L, 377L, 381L, 384L, 385L,
386L, 387L, 388L, 388L, 388L, 390L, 391L, 393L, 393L, 393L, 397L,
397L, 397L, 397L, 398L, 398L, 404L, 405L, 406L, 408L, 411L, 412L,
412L, 413L, 413L, 414L, 417L, 419L, 419L, 421L, 424L, 425L, 427L,
428L, 429L, 429L, 432L, 432L, 434L, 434L, 437L, 438L, 441L, 441L,
443L, 445L, 447L, 449L, 454L, 454L, 456L, 459L, 459L, 459L, 459L,
461L, 461L, 462L, 465L, 465L, 465L, 466L, 468L, 470L, 472L, 474L,
474L, 477L, 478L, 479L, 481L, 485L, 486L, 486L, 487L, 488L, 491L,
492L, 492L, 493L, 498L, 498L, 499L, 501L, 502L, 503L, 505L, 506L,
508L, 508L, 509L, 510L, 511L, 513L, 513L, 513L, 513L, 514L, 515L,
519L, 519L, 520L, 524L, 524L, 525L, 528L, 528L, 529L, 529L, 533L,
534L, 535L, 536L, 537L, 537L, 537L, 537L, 539L, 539L, 540L, 545L,
553L, 553L, 554L, 555L, 556L, 558L, 560L, 561L, 565L, 566L, 567L,
567L, 568L, 569L, 571L, 572L, 573L, 574L, 578L, 581L, 583L, 583L,
584L, 585L, 585L, 588L, 589L, 595L, 600L, 606L, 607L, 608L, 609L,
611L, 614L, 615L, 615L, 616L, 618L, 619L, 621L, 623L, 626L, 628L,
629L, 630L, 632L, 634L, 635L, 636L, 637L, 651L, 653L, 654L, 655L,
656L, 661L, 661L, 670L, 673L, 673L, 675L, 675L, 677L, 677L, 679L,
680L, 683L, 685L, 690L, 692L, 693L, 694L, 694L, 699L, 701L, 710L,
710L, 710L, 712L, 712L, 713L, 714L, 715L, 717L, 717L, 719L, 720L,
721L, 723L, 729L, 729L, 730L, 730L, 732L, 732L, 733L, 735L, 736L,
737L, 739L, 739L, 740L, 743L, 747L, 747L, 753L, 755L, 755L, 755L,
760L, 765L, 768L, 772L, 778L, 784L, 786L, 787L, 788L, 799L, 801L,
802L, 802L, 810L, 811L, 812L, 821L, 821L, 826L, 826L, 828L, 835L,
837L, 839L, 841L, 842L, 843L, 844L, 846L, 850L, 851L, 852L, 858L,
866L, 869L, 869L, 871L, 873L, 875L, 879L, 880L, 881L, 882L, 883L,
886L, 887L, 888L, 889L, 890L, 894L, 896L, 900L, 903L, 904L, 905L,
909L, 910L, 910L, 919L, 922L, 922L, 929L, 933L, 937L, 941L, 949L,
949L, 949L, 959L, 969L, 971L, 974L, 982L, 982L, 990L, 1001L,
1003L, 1006L, 1007L, 1008L, 1013L, 1017L, 1017L, 1019L, 1021L,
1023L, 1025L, 1026L, 1028L, 1036L, 1036L, 1044L, 1047L, 1049L,
1060L, 1064L, 1065L, 1067L, 1068L, 1070L, 1081L, 1084L, 1085L,
1085L, 1087L, 1093L, 1098L, 1100L, 1106L, 1121L, 1124L, 1125L,
1140L, 1142L, 1144L, 1146L, 1146L, 1150L, 1155L, 1164L, 1167L,
1174L, 1179L, 1190L, 1191L, 1191L, 1214L, 1223L, 1227L, 1227L,
1241L, 1256L, 1262L, 1269L, 1280L, 1280L, 1287L, 1288L, 1296L,
1299L, 1316L, 1318L, 1320L, 1320L, 1344L, 1344L, 1348L, 1348L,
1348L, 1352L, 1369L, 1370L, 1372L, 1389L, 1389L, 1396L, 1398L,
1399L, 1401L, 1403L, 1411L, 1412L, 1415L, 1428L, 1428L, 1444L,
1472L, 1474L, 1477L, 1478L, 1482L, 1483L, 1484L, 1504L, 1504L,
1510L, 1516L, 1518L, 1523L, 1528L, 1534L, 1538L, 1541L, 1542L,
1554L, 1558L, 1560L, 1561L, 1570L, 1571L, 1586L, 1588L, 1589L,
1591L, 1594L, 1597L, 1608L, 1616L, 1634L, 1644L, 1670L, 1687L,
1696L, 1723L, 1726L, 1733L, 1737L, 1759L, 1759L, 1762L, 1764L,
1768L, 1770L, 1777L, 1791L, 1796L, 1819L, 1835L, 1851L, 1857L,
1868L, 1906L, 1923L, 1954L, 1982L, 1986L, 1998L, 2040L, 2051L,
2063L, 2073L, 2088L, 2104L, 2117L, 2135L, 2145L, 2175L, 2193L,
2211L, 2229L, 2239L, 2247L, 2290L, 2367L, 2445L, 2725L, 2975L,
3247L, 3642L)
get_sds <- function(n) {
sample(sds, size = n, replace = TRUE)
}
means <- c(239L, 279L, 316L, 331L, 360L, 404L, 418L, 426L, 427L, 435L,
448L, 470L, 472L, 491L, 503L, 504L, 512L, 517L, 529L, 531L, 535L,
557L, 560L, 561L, 563L, 570L, 573L, 581L, 589L, 593L, 595L, 601L,
603L, 605L, 606L, 606L, 624L, 631L, 631L, 646L, 649L, 656L, 662L,
672L, 677L, 682L, 697L, 697L, 698L, 699L, 700L, 703L, 712L, 715L,
717L, 718L, 718L, 719L, 727L, 736L, 739L, 741L, 750L, 752L, 754L,
764L, 769L, 769L, 776L, 780L, 782L, 784L, 791L, 794L, 794L, 798L,
800L, 803L, 809L, 810L, 810L, 818L, 819L, 835L, 851L, 854L, 857L,
861L, 863L, 863L, 865L, 867L, 870L, 870L, 875L, 884L, 885L, 886L,
890L, 891L, 913L, 916L, 934L, 948L, 948L, 950L, 965L, 975L, 977L,
978L, 978L, 998L, 1000L, 1001L, 1002L, 1003L, 1003L, 1006L, 1019L,
1021L, 1028L, 1029L, 1031L, 1031L, 1039L, 1046L, 1055L, 1073L,
1074L, 1078L, 1079L, 1080L, 1083L, 1085L, 1087L, 1101L, 1103L,
1103L, 1104L, 1109L, 1111L, 1113L, 1114L, 1118L, 1122L, 1126L,
1126L, 1148L, 1152L, 1156L, 1175L, 1180L, 1185L, 1187L, 1193L,
1194L, 1202L, 1202L, 1205L, 1207L, 1240L, 1244L, 1259L, 1263L,
1276L, 1279L, 1281L, 1286L, 1287L, 1287L, 1297L, 1306L, 1311L,
1313L, 1313L, 1341L, 1352L, 1368L, 1374L, 1376L, 1376L, 1378L,
1397L, 1400L, 1402L, 1405L, 1409L, 1428L, 1445L, 1474L, 1501L,
1522L, 1525L, 1526L, 1531L, 1547L, 1549L, 1561L, 1564L, 1572L,
1577L, 1600L, 1609L, 1617L, 1635L, 1636L, 1638L, 1641L, 1641L,
1711L, 1724L, 1742L, 1753L, 1982L, 1986L, 2012L, 2040L, 2047L,
2141L, 2229L, 2371L, 2511L, 2888L, 3238L, 3253L, 3306L, 3588L,
3629L, 4061L, 4425L, 4900L, 5126L, 5133L, 5230L, 5305L, 5360L,
5435L, 5481L, 5491L, 5536L, 5595L, 5752L, 5755L, 5805L, 5846L,
5958L, 6002L, 6016L, 6071L, 6319L, 6338L, 6420L, 6422L, 6476L,
6518L, 6545L, 6587L, 6659L, 6708L, 6730L, 6749L, 6758L, 6768L,
6804L, 6854L, 6882L, 6955L, 7076L, 7092L, 7147L, 7160L, 7388L,
7473L, 7498L, 7591L, 7643L, 7665L, 7797L, 7875L, 7932L, 7935L,
8045L, 8096L, 8146L, 8153L, 8157L, 8252L, 8328L, 8376L, 8572L,
8574L, 8650L, 8688L, 8775L, 8936L, 9002L, 9005L, 9096L, 9167L,
9195L, 9290L, 9320L, 9367L, 9388L, 9476L, 9599L, 9639L, 9717L,
9729L, 9759L, 9812L, 9851L, 9854L, 9884L, 9929L, 9930L, 9953L,
10006L, 10047L, 10131L, 10163L, 10360L, 10393L, 10406L, 10406L,
10445L, 10629L, 10699L, 10821L, 10831L, 10937L, 10973L, 10974L,
11025L, 11126L, 11183L, 11190L, 11279L, 11318L, 11361L, 11381L,
11441L, 11651L, 11661L, 12008L, 12013L, 12162L, 12169L, 12232L,
12337L, 12352L, 12353L, 12370L, 12986L, 13018L, 13063L, 13165L,
13253L, 13368L, 13379L, 13541L, 13598L, 13616L, 13656L, 13803L,
14339L, 15059L, 15110L, 15159L, 15233L, 15527L, 15553L, 15625L,
15787L, 16156L, 16185L, 16470L, 16701L, 16778L, 16834L, 16834L,
16994L, 17056L, 17237L, 17484L, 17778L, 17810L, 17966L, 18364L,
18476L, 18586L, 18744L, 19797L, 20149L, 21942L, 22868L, 24282L,
24645L, 29249L, 29447L)
get_means <- function(n) {
sample(means, size = n, replace = TRUE)
}
set.seed(20211221)
idat_ex <- manifest_subset %>%
mutate(
A_Red_Mean = get_means(200), # Not NA
A_Grn_Mean = get_means(200), # Not NA
B_Red_Mean = ifelse(ProbeType == "II", NA, get_means(200)), # NA for ProbeType == "II"
B_Grn_Mean = ifelse(ProbeType == "II", NA, get_means(200))) %>% # NA for ProbeType == "II"
mutate(
A_Red_SD = get_sds(200), # Not NA
A_Grn_SD = get_sds(200), # Not NA
B_Red_SD = ifelse(ProbeType == "II", NA, get_sds(200)), # NA for ProbeType == "II"
B_Grn_SD = ifelse(ProbeType == "II", NA, get_sds(200))) %>% # NA for ProbeType == "II"
mutate(
A_Red_NBeads = get_nbeads(200), # Not NA
A_Grn_NBeads = get_nbeads(200), # Not NA
B_Red_NBeads = ifelse(ProbeType == "II", NA, get_nbeads(200)), # NA for ProbeType == "II"
B_Grn_NBeads = ifelse(ProbeType == "II", NA, get_nbeads(200))) # NA for ProbeType == "II"
#################################################
m_ex <- bind_cols(idat_ex, channel_probe_to_alleles(idat_ex)) %>%
mutate(SNP1 = substr(SNP, 2, 2),
SNP2 = substr(SNP, 4, 4))
d_trans_ex <- m_ex %>%
select(Allele_A_sig_Mean, Allele_B_sig_Mean) %>%
rename(x = Allele_A_sig_Mean, y = Allele_B_sig_Mean) %>%
mutate(x = log(x + 1), y = log(y + 1))
library(mclust)
fit <- get_call_model()
pred_ex <- predict(fit, newdata = d_trans_ex)
grp_ex <- apply(pred_ex$z, 1, which.max)
prb_ex <- apply(pred_ex$z, 1, max)
grp_ex_AB <- cluster_to_AB(grp_ex)
pm_ex <- to_plus_minus(grp_ex_AB, m_ex$SNP1, m_ex$SNP2, m_ex$RefStrand, sep = "")
table(grp_ex)
table(pm_ex)
table(grp_ex, pm_ex)
########################################
usethis::use_data(idat_ex, overwrite = TRUE)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.