R/qtl，遗传图校正距离

library(ggplot2)

library(ggpubr)

library(qtl)

f2<- read.cross(format="csvr",dir="",

  file="F2P05M30-binr1m5k-Raw.csv",genotypes=c("A","H","B"),

  alleles=c("A","B"),na.strings=c("N"))

##修改R::plotMap的参数，调试染色体的宽度和间距

plotMap<-function (x, map2, chr, horizontal = FALSE, shift = TRUE, show.marker.names = FALSE,

    alternate.chrid = FALSE, ...)

{

    dots <- list(...)

    if ("main" %in% names(dots)) {

        themain <- dots$main

        usemaindefault <- FALSE

    }

    else usemaindefault <- TRUE

    if ("xlim" %in% names(dots)) {

        xlim <- dots$xlim

        usexlimdefault <- FALSE

    }

    else usexlimdefault <- TRUE

    if ("ylim" %in% names(dots)) {

        ylim <- dots$ylim

        useylimdefault <- FALSE

    }

    else useylimdefault <- TRUE

    if ("xlab" %in% names(dots))

        xlab <- dots$xlab

    else {

        if (horizontal)

            xlab <- "Location (cM)"

        else xlab <- "Chromosome"

    }

    if ("ylab" %in% names(dots))

        ylab <- dots$ylab

    else {

        if (horizontal)

            ylab <- "Chromosome"

        else ylab <- "Location (cM)"

    }

    map <- x

    if (inherits(map, "cross"))

        map <- pull.map(map)

    if (!missing(map2) && inherits(map2, "cross"))

        map2 <- pull.map(map2)

    if (!inherits(map, "map") || (!missing(map2) && !inherits(map2,

        "map")))

        warning("Input should have class \"cross\" or \"map\".")

    if (!missing(map2) && is.matrix(map[[1]]) != is.matrix(map2[[1]]))

        stop("Maps must be both sex-specific or neither sex-specific.")

    if (!missing(chr)) {

        map <- map[matchchr(chr, names(map))]

        if (!missing(map2))

            map2 <- map2[matchchr(chr, names(map2))]

    }

    sex.sp <- FALSE

    if (is.matrix(map[[1]])) {

        one.map <- FALSE

        sex.sp <- TRUE

        if (!missing(map2)) {

            if (is.logical(map2)) {

                horizontal <- map2

                map2 <- lapply(map, function(a) a[2, ])

                map <- lapply(map, function(a) a[1, ])

            }

            else {

                Map1 <- lapply(map, function(a) a[1, , drop = TRUE])

                Map2 <- lapply(map, function(a) a[2, , drop = TRUE])

                Map3 <- lapply(map2, function(a) a[1, , drop = TRUE])

                Map4 <- lapply(map2, function(a) a[2, , drop = TRUE])

                old.mfrow <- par("mfrow")

                on.exit(par(mfrow = old.mfrow))

                par(mfrow = c(2, 1))

                class(Map1) <- class(Map2) <- class(Map3) <- class(Map4) <- "map"

                plotMap(Map1, Map3, horizontal = horizontal,

                  shift = shift, show.marker.names = show.marker.names,

                  alternate.chrid = alternate.chrid)

                plotMap(Map2, Map4, horizontal = horizontal,

                  shift = shift, show.marker.names = show.marker.names,

                  alternate.chrid = alternate.chrid)

                return(invisible(NULL))

            }

        }

        else {

            map2 <- lapply(map, function(a) a[2, ])

            map <- lapply(map, function(a) a[1, ])

        }

    }

    else {

        if (!missing(map2))

            one.map <- FALSE

        else one.map <- TRUE

    }

    if (one.map) {

        n.chr <- length(map)

        if (!show.marker.names) {

            chrpos <- 1:n.chr

            thelim <- range(chrpos) + c(-0.5, 0.5)

        }

        else {

            chrpos <- seq(1, n.chr * 2, by = 2)        ##2->10

            thelim <- range(chrpos) + c(-0.35, 2.35)

        }

        if (shift)

            map <- lapply(map, function(a) a - a[1])

        maxlen <- max(unlist(lapply(map, max)))

        if (horizontal) {

            old.xpd <- par("xpd")

            old.las <- par("las")

            par(xpd = TRUE, las = 1)

            on.exit(par(xpd = old.xpd, las = old.las))

            if (usexlimdefault)

                xlim <- c(0, maxlen)

            if (useylimdefault)

                ylim <- rev(thelim)

            plot(0, 0, type = "n", xlim = xlim, ylim = ylim,

                yaxs = "i", xlab = xlab, ylab = ylab, yaxt = "n")

            a <- par("usr")

            for (i in 1:n.chr) {

                segments(min(map[[i]]), chrpos[i], max(map[[i]]),

                  chrpos[i])

### not this line

###              segments(map[[i]], chrpos[i] - 0.25, map[[i]],

### not this line

###                  chrpos[i] + 0.25)

                segments(map[[i]], chrpos[i] - 0.25, map[[i]],

                  chrpos[i] + 0.25)

                if (show.marker.names)

### not this line

###                  text(map[[i]], chrpos[i] + 0.35, names(map[[i]]),

### not this line

###                    srt = 90, adj = c(1, 0.5))

                  text(map[[i]], chrpos[i] + 0.35, names(map[[i]]),

                    srt = 90, adj = c(0.1, 0.5))

            }

            if (!alternate.chrid || length(chrpos) < 2) {

                for (i in seq(along = chrpos)) axis(side = 2,

                  at = chrpos[i], labels = names(map)[i])

            }

            else {

                odd <- seq(1, length(chrpos), by = 2)        ##2->10

                even <- seq(2, length(chrpos), by = 2)      ##2->10

                for (i in odd) {

                  axis(side = 2, at = chrpos[i], labels = "")

                  axis(side = 2, at = chrpos[i], labels = names(map)[i],

### not this line

###                    line = -0.4, tick = FALSE)

                    line = -0.4, tick = FALSE)

                }

                for (i in even) {

                  axis(side = 2, at = chrpos[i], labels = "")

                  axis(side = 2, at = chrpos[i], labels = names(map)[i],

### not this line

###                    line = +0.4, tick = FALSE)

                    line = +0.4, tick = FALSE)

                }

            }

        }

        else {

            old.xpd <- par("xpd")

            old.las <- par("las")

            par(xpd = TRUE, las = 1)

            on.exit(par(xpd = old.xpd, las = old.las))

            if (usexlimdefault)

                xlim <- thelim

            if (useylimdefault)

                ylim <- c(maxlen, 0)

            plot(0, 0, type = "n", ylim = ylim, xlim = xlim,

                xaxs = "i", xlab = xlab, ylab = ylab, xaxt = "n")

            a <- par("usr")

            for (i in 1:n.chr) {

                segments(chrpos[i], min(map[[i]]), chrpos[i],

                  max(map[[i]]))

################ 控制标记线长度 ################### 下方是原数值

###just this line        segments(chrpos[i] - 0.25, map[[i]], chrpos[i] +

###just this line                  0.25, map[[i]])

###                if (show.marker.names)

###                  text(chrpos[i] + 0.35, map[[i]], names(map[[i]]),

###                    adj = c(0, 0.5))

################ 控制标记线长度 ################### 下方是修改数值

                segments(chrpos[i] - 0.048, map[[i]], chrpos[i] +

                  0.048, map[[i]])

                if (show.marker.names)

                  text(chrpos[i] + 0.35, map[[i]], names(map[[i]]),

                    adj = c(0, 0.5))

################ 控制标记线长度 ###################

            }

            if (!alternate.chrid || length(chrpos) < 2) {

                for (i in seq(along = chrpos)) axis(side = 1,

                  at = chrpos[i], labels = names(map)[i])

            }

            else {

                odd <- seq(1, length(chrpos), by = 2)      ##2->10

                even <- seq(2, length(chrpos), by = 2)    ##2->10

                for (i in odd) {

                  axis(side = 1, at = chrpos[i], labels = "")

                  axis(side = 1, at = chrpos[i], labels = names(map)[i],

### not this line

###                    line = -0.4, tick = FALSE)

                    line = -0.4, tick = FALSE)

                }

                for (i in even) {

                  axis(side = 1, at = chrpos[i], labels = "")

                  axis(side = 1, at = chrpos[i], labels = names(map)[i],

### not this line

###                    line = +0.4, tick = FALSE)

                    line = +0.4, tick = FALSE)

                }

            }

        }

        if (usemaindefault)

            title(main = "Genetic map")

        else if (themain != "")

            title(main = themain)

    }

    else {

        map1 <- map

        if (is.matrix(map2[[1]]))

            stop("Second map appears to be a sex-specific map.")

        if (length(map1) != length(map2))

            stop("Maps have different numbers of chromosomes.")

        if (any(names(map1) != names(map2))) {

            cat("Map1: ", names(map1), "\n")

            cat("Map2: ", names(map2), "\n")

            stop("Maps have different chromosome names.")

        }

        if (shift) {

            map1 <- lapply(map1, function(a) a - a[1])

            map2 <- lapply(map2, function(a) a - a[1])

        }

        n.mar1 <- sapply(map1, length)

        n.mar2 <- sapply(map2, length)

        markernames1 <- lapply(map1, names)

        markernames2 <- lapply(map2, names)

        if (any(n.mar1 != n.mar2)) {

            if (show.marker.names) {

                warning("Can't show marker names because of different numbers of markers.")

                show.marker.names <- FALSE

            }

        }

        else if (any(unlist(markernames1) != unlist(markernames2))) {

            if (show.marker.names) {

                warning("Can't show marker names because markers in different orders.")

                show.marker.names <- FALSE

            }

        }

        n.chr <- length(map1)

        maxloc <- max(c(unlist(lapply(map1, max)), unlist(lapply(map2,

            max))))

        if (!show.marker.names) {

            chrpos <- 1:n.chr

            thelim <- range(chrpos) + c(-0.5, 0.5)

        }

        else {

            chrpos <- seq(1, n.chr * 2, by = 2)      ##2->10

            thelim <- range(chrpos) + c(-0.4, 2.4)

        }

        if (!horizontal) {

            old.xpd <- par("xpd")

            old.las <- par("las")

            par(xpd = TRUE, las = 1)

            on.exit(par(xpd = old.xpd, las = old.las))

            if (usexlimdefault)

                xlim <- thelim

            if (useylimdefault)

                ylim <- c(maxloc, 0)

            plot(0, 0, type = "n", ylim = ylim, xlim = xlim,

                xaxs = "i", xlab = xlab, ylab = ylab, xaxt = "n")

            a <- par("usr")

            for (i in 1:n.chr) {

                if (max(map2[[i]]) < max(map1[[i]]))

                  map2[[i]] <- map2[[i]] + (max(map1[[i]]) -

                    max(map2[[i]]))/2

                else map1[[i]] <- map1[[i]] + (max(map2[[i]]) -

                  max(map1[[i]]))/2

                segments(chrpos[i] - 0.3, min(map1[[i]]), chrpos[i] -

                  0.3, max(map1[[i]]))

                segments(chrpos[i] + 0.3, min(map2[[i]]), chrpos[i] +

                  0.3, max(map2[[i]]))

                wh <- match(markernames1[[i]], markernames2[[i]])

                for (j in which(!is.na(wh))) segments(chrpos[i] -

                  0.3, map1[[i]][j], chrpos[i] + 0.3, map2[[i]][wh[j]])

                if (any(is.na(wh)))

                  segments(chrpos[i] - 0.4, map1[[i]][is.na(wh)],

                    chrpos[i] - 0.2, map1[[i]][is.na(wh)])

                wh <- match(markernames2[[i]], markernames1[[i]])

                if (any(is.na(wh)))

                  segments(chrpos[i] + 0.4, map2[[i]][is.na(wh)],

                    chrpos[i] + 0.2, map2[[i]][is.na(wh)])

                if (show.marker.names)

                  text(chrpos[i] + 0.35, map2[[i]], names(map2[[i]]),

                    adj = c(0, 0.5))

            }

            if (!alternate.chrid || length(chrpos) < 2) {

                for (i in seq(along = chrpos)) axis(side = 1,

                  at = chrpos[i], labels = names(map1)[i])

            }

            else {

                odd <- seq(1, length(chrpos), by = 2)      ##2->10

                even <- seq(2, length(chrpos), by = 2)    ##2->10

                for (i in odd) {

                  axis(side = 1, at = chrpos[i], labels = "")

                  axis(side = 1, at = chrpos[i], labels = names(map1)[i],

### not this line

###                    line = -0.4, tick = FALSE)

                    line = -0.4, tick = FALSE)

                }

                for (i in even) {

                  axis(side = 1, at = chrpos[i], labels = "")

                  axis(side = 1, at = chrpos[i], labels = names(map1)[i],

### not this line

###                    line = +0.4, tick = FALSE)

                    line = +0.4, tick = FALSE)

                }

            }

        }

        else {

            old.xpd <- par("xpd")

            old.las <- par("las")

            par(xpd = TRUE, las = 1)

            on.exit(par(xpd = old.xpd, las = old.las))

            if (usexlimdefault)

                xlim <- c(0, maxloc)

            if (useylimdefault)

                ylim <- rev(thelim)

            plot(0, 0, type = "n", xlim = xlim, ylim = ylim,

                xlab = xlab, ylab = ylab, yaxt = "n", yaxs = "i")

            a <- par("usr")

            for (i in 1:n.chr) {

                if (max(map2[[i]]) < max(map1[[i]]))

                  map2[[i]] <- map2[[i]] + (max(map1[[i]]) -

                    max(map2[[i]]))/2

                else map1[[i]] <- map1[[i]] + (max(map2[[i]]) -

                  max(map1[[i]]))/2

                segments(min(map1[[i]]), chrpos[i] - 0.3, max(map1[[i]]),

                  chrpos[[i]] - 0.3)

                segments(min(map2[[i]]), chrpos[i] + 0.3, max(map2[[i]]),

                  chrpos[[i]] + 0.3)

                wh <- match(markernames1[[i]], markernames2[[i]])

                for (j in which(!is.na(wh))) segments(map1[[i]][j],

                  chrpos[i] - 0.3, map2[[i]][wh[j]], chrpos[i] +

                    0.3)

                if (any(is.na(wh)))

                  segments(map1[[i]][is.na(wh)], chrpos[i] -

                    0.4, map1[[i]][is.na(wh)], chrpos[i] - 0.2)

                wh <- match(markernames2[[i]], markernames1[[i]])

                if (any(is.na(wh)))

                  segments(map2[[i]][is.na(wh)], chrpos[i] +

                    0.4, map2[[i]][is.na(wh)], chrpos[i] + 0.2)

                if (show.marker.names)

                  text(map2[[i]], chrpos[i] + 0.35, names(map2[[i]]),

                    srt = 90, adj = c(1, 0.5))

            }

            if (!alternate.chrid || length(chrpos) < 2) {

                for (i in seq(along = chrpos)) axis(side = 2,

                  at = chrpos[i], labels = names(map1)[i])

            }

            else {

                odd <- seq(1, length(chrpos), by = 2)        ##2->10

                even <- seq(2, length(chrpos), by = 2)      ##2->10

                for (i in odd) {

                  axis(side = 2, at = chrpos[i], labels = "")

                  axis(side = 2, at = chrpos[i], labels = names(map1)[i],

### not this line

###                    line = -0.4, tick = FALSE)

                    line = -0.4, tick = FALSE)

                }

                for (i in even) {

                  axis(side = 2, at = chrpos[i], labels = "")

                  axis(side = 2, at = chrpos[i], labels = names(map1)[i],

### not this line

###                    line = +0.4, tick = FALSE)

                    line = +0.4, tick = FALSE)

                }

            }

        }

        if (usemaindefault) {

            if (!sex.sp)

                title(main = "Comparison of genetic maps")

            else title(main = "Genetic map")

        }

        else if (themain != "")

            title(main = themain)

    }

    invisible()

}

#

par(mfrow=c(2,1))

©著作权归作者所有,转载或内容合作请联系作者
  • 人面猴
    序言：七十年代末，一起剥皮案震惊了整个滨河市，随后出现的几起案子，更是在滨河造成了极大的恐慌，老刑警刘岩，带你破解...
    沈念sama阅读 203,324评论 5赞 476
  • 死咒
    序言：滨河连续发生了三起死亡事件，死亡现场离奇诡异，居然都是意外死亡，警方通过查阅死者的电脑和手机，发现死者居然都...
    沈念sama阅读 85,303评论 2赞 381
  • 救了他两次的神仙让他今天三更去死
    文/潘晓璐 我一进店门，熙熙楼的掌柜王于贵愁眉苦脸地迎上来，“玉大人，你说我怎么就摊上这事。” “怎么了？”我有些...
    开封第一讲书人阅读 150,192评论 0赞 337
  • 道士缉凶录：失踪的卖姜人
    文/不坏的土叔 我叫张陵，是天一观的道长。 经常有香客问我，道长，这世上最难降的妖魔是什么？ 我笑而不...
    开封第一讲书人阅读 54,555评论 1赞 273
  • 港岛之恋（遗憾婚礼）
    正文 为了忘掉前任，我火速办了婚礼，结果婚礼上，老公的妹妹穿的比我还像新娘。我一直安慰自己，他们只是感情好，可当我...
    茶点故事阅读 63,569评论 5赞 365
  • 恶毒庶女顶嫁案：这布局不是一般人想出来的
    文/花漫 我一把揭开白布。 她就那样静静地躺着，像睡着了一般。 火红的嫁衣衬着肌肤如雪。 梳的纹丝不乱的头发上，一...
    开封第一讲书人阅读 48,566评论 1赞 281
  • 城市分裂传说
    那天，我揣着相机与录音，去河边找鬼。 笑死，一个胖子当着我的面吹牛，可吹牛的内容都是我干的。 我是一名探鬼主播，决...
    沈念sama阅读 37,927评论 3赞 395
  • 双鸳鸯连环套：你想象不到人心有多黑
    文/苍兰香墨 我猛地睁开眼，长吁一口气：“原来是场噩梦啊……” “哼！你这毒妇竟也来了？” 一声冷哼从身侧响起，我...
    开封第一讲书人阅读 36,583评论 0赞 257
  • 万荣杀人案实录
    序言：老挝万荣一对情侣失踪，失踪者是张志新（化名）和其女友刘颖，没想到半个月后，有当地人在树林里发现了一具尸体，经...
    沈念sama阅读 40,827评论 1赞 297
  • 护林员之死
    正文 独居荒郊野岭守林人离奇死亡，尸身上长有42处带血的脓包…… 初始之章·张勋 以下内容为张勋视角 年9月15日...
    茶点故事阅读 35,590评论 2赞 320
  • 白月光启示录
    正文 我和宋清朗相恋三年，在试婚纱的时候发现自己被绿了。 大学时的朋友给我发了我未婚夫和他白月光在一起吃饭的照片。...
    茶点故事阅读 37,669评论 1赞 329
  • 活死人
    序言：一个原本活蹦乱跳的男人离奇死亡，死状恐怖，灵堂内的尸体忽然破棺而出，到底是诈尸还是另有隐情，我是刑警宁泽，带...
    沈念sama阅读 33,365评论 4赞 318
  • 日本核电站爆炸内幕
    正文 年R本政府宣布，位于F岛的核电站，受9级特大地震影响，放射性物质发生泄漏。R本人自食恶果不足惜，却给世界环境...
    茶点故事阅读 38,941评论 3赞 307
  • 男人毒药：我在死后第九天来索命
    文/蒙蒙 一、第九天 我趴在偏房一处隐蔽的房顶上张望。 院中可真热闹，春花似锦、人声如沸。这庄子的主人今日做“春日...
    开封第一讲书人阅读 29,928评论 0赞 19
  • 一桩弑父案，背后竟有这般阴谋
    文/苍兰香墨 我抬头看了看天上的太阳。三九已至，却和暖如春，着一层夹袄步出监牢的瞬间，已是汗流浃背。 一阵脚步声响...
    开封第一讲书人阅读 31,159评论 1赞 259
  • 情欲美人皮
    我被黑心中介骗来泰国打工， 没想到刚下飞机就差点儿被人妖公主榨干…… 1. 我叫王不留，地道东北人。 一个月前我还...
    沈念sama阅读 42,880评论 2赞 349
  • 代替公主和亲
    正文 我出身青楼，却偏偏与公主长得像，于是被迫代替她去往敌国和亲。 传闻我的和亲对象是个残疾皇子，可洞房花烛夜当晚...
    茶点故事阅读 42,399评论 2赞 342

推荐阅读更多精彩内容

  • R--创建图形
    手动输入数据 weight<-c(32,43,23,43)mpg<-c(12,21,9,22)mtcars<-da...
    KevinCool阅读 1,081评论 0赞 1
  • The R
    命令行运行R 脚本 使用 R CMD BATCH name.R 或者Rscript name.R 都能在终端运行R...
    NeyoShinado阅读 1,281评论 0赞 0
  • 01R入门
    向量A <- c(1:3)B <- seq(from=,to=,by=)D <- rep(0,5) append ...
    Jachin111阅读 1,191评论 0赞 0
  • R/qtl2_1
    原文网址：https://kbroman.org/qtl2/assets/vignettes/user_guide...
    耕读者阅读 1,201评论 0赞 1
  • R初学者指南学习
    第一章：基本原理与概念的学习 1.1对象的产生，排列及删除 1.1.1 函数ls()的功能是显示所有在内存中的对象...
    超人快飞阅读 668评论 0赞 2