R/cor_linkx.R

Defines functions cor_linkx

cor_linkx <-function(data,
         p,
         envdata = report,
         Ptab,
         zoom = 2,
         show = "z",
         topdat = null,
         corva = 0,
         range = 1,
         lacx = "left",
         lacy = "bottom",
         numpoint2 = 21,
         curvature = 0.2,
         p.thur = 0.3,
         onlysig = TRUE
){

  if (show == "z"& !is.null(topdat)) {
    topdat1 = topdat
  }else{
    aa = TRUE
  }

  if (show == "y"&lacx == "right") {
    data = data.frame(x = max(data$x)+1,y = data$y,label = data$label)

  }else if(show == "y"&lacx == "left"& lacy == "bottom"){
    data = data.frame(x = min(data$x)-1,y = data$y-1,label = data$label)
  }else if(show == "y"&lacx == "left"& lacy == "top"){
    data = data.frame(x = min(data$x)-1,y = data$y,label = data$label)
  }else if(show == "x"& lacy == "top"&lacx == "right"){
    data = data.frame(x = data$x ,y =max(data$y)+1,label = data$label)
  }else if(show == "x"& lacy == "top"&lacx == "left"){
    data = data.frame(x = data$x,y =max(data$y)+1,label = data$label)
  }else if(show == "x"& lacy == "bottom"&lacx == "left"){
    data = data.frame(x = data$x,y =min(data$y)-1,label = data$label)
  }else if(show == "x"& lacy == "bottom"&lacx == "right"){
    data = data.frame(x = data$x ,y =min(data$y)-1,label = data$label)
  } else if(show == "z"){
    data = data
  }



  colnames(envdata)[1] = c("label")
  dat1 = envdata %>%gather(key = "groupbc", value = "R",-label)

  data31<- data %>% full_join(dat1,by = "label")

  colnames(Ptab)[1] = "label"
  dat2 = Ptab %>%gather(key = "group.p.bc", value = "p",-label)
  head(dat2)
  data32 <- data %>% left_join(dat2,by = "label")
  data3 = cbind(data31,data32[,-(1:3)])
  head(data3)

  group <- c()
  group[data3$R > 0] <- "pos"
  group[data3$R < 0] <- "neg"
  group[data3$R == 0] <- "nose"
  data3$groupr = group


  #-p matrix
  group <- c()
  group[data3$p > p.thur] <- "nose"
  group[data3$p < p.thur] <- "sig"

  data3$groupp = group
  # head(data3)
  data3$group = gsub("p.BC","",data3$group.p.bc)
  x = length(unique(data3$group))
  idtab = data3
  # filter R2 for curve
  if (onlysig == TRUE& sig) {
    data3 = data3 %>% filter(p < p.thur )
  }

  # ggplot() + geom_point(aes(x,y),data = data) +
  #   geom_point(aes(x -1,y +1),data = data)
  #
  # ggplot() + geom_point(aes(x,y),data = data) +
  #   geom_point(aes(xend,yend),data = topdat)
  n = x +1

  if (is.null(topdat)) {
    if (show == "y"&lacx == "left") {
      dat = data.frame(x =  min(data$x) - zoom,y = data$y )
      seqnum = (max(dat$y) - min(dat$y))/n
      tem = seq(from=min(dat$y), to=max(dat$y),by=seqnum)
      tem = tem[length(tem):1]

      topdat = data.frame(x=seq(from=min(dat$x), to=max(dat$x),by=seqnum),
                          y = tem) %>% slice(-1)
      topdat = topdat[-nrow(topdat),]
      colnames(topdat) = paste0(colnames(topdat),"end")
      topdat$group = unique(data3$group)

    } else if (show == "y"&lacx == "right"){
      dat = data.frame(x = max(data$x) + zoom,y = data$y )
      seqnum = (max(dat$y) - min(dat$y))/n
      topdat = data.frame(x= max(data$x) + zoom,
                          y = seq(from=min(dat$y), to=max(dat$y),by=seqnum)) %>%
        dplyr::slice(-1)
      topdat = topdat[-nrow(topdat),]
      colnames(topdat) = paste0(colnames(topdat),"end")
      topdat$group = unique(data3$group)
    } else if(show == "x"&lacy == "bottom"){
      dat = data.frame(x = data$x,y = min(data$y) - zoom)
      seqnum = (max(dat$x) - min(dat$x))/n
      tem = seq(from=min(dat$y), to=max(dat$y),by=seqnum)
      tem = tem[length(tem):1]

      topdat = data.frame(x=seq(from=min(dat$x), to=max(dat$x),by=seqnum),
                          y = tem) %>% slice(-1)
      topdat = topdat[-nrow(topdat),]
      colnames(topdat) = paste0(colnames(topdat),"end")
      topdat$group = unique(data3$group)

    } else if( show == "x"&lacy == "top"){
      dat = data.frame(x = data$x ,y = max(data$y)+zoom)
      seqnum = (max(dat$x) - min(dat$x))/n
      tem = seq(from=min(dat$y), to=max(dat$y),by=seqnum)
      # tem = tem[length(tem):1]

      topdat = data.frame(x=seq(from=min(dat$x), to=max(dat$x),by=seqnum),
                          y = tem) %>% slice(-1)
      topdat = topdat[-nrow(topdat),]
      colnames(topdat) = paste0(colnames(topdat),"end")
      topdat$group = unique(data3$group)

    }
    if (show=="z"&lacx == "left"& lacy == "bottom") {
      dat = data.frame(x = data$x + zoom,y = data$y + zoom)
      seqnum = (max(dat$x) - min(dat$x))/n
      tem = seq(from=min(dat$y), to=max(dat$y),by=seqnum)
      tem = tem[length(tem):1]

      topdat = data.frame(x=seq(from=min(dat$x), to=max(dat$x),by=seqnum),
                          y = tem) %>% slice(-1)
      topdat = topdat[-nrow(topdat),]
      colnames(topdat) = paste0(colnames(topdat),"end")
      topdat$group = unique(data3$group)

    } else if (show=="z"&lacx == "right"& lacy == "bottom"){
      dat = data.frame(x = data$x - zoom,y = data$y + zoom)
      seqnum = (max(dat$x) - min(dat$x))/n
      topdat = data.frame(x=seq(from=min(dat$x), to=max(dat$x),by=seqnum),
                          y = seq(from=min(dat$y), to=max(dat$y),by=seqnum)) %>%
        dplyr::slice(-1)
      topdat = topdat[-nrow(topdat),]
      colnames(topdat) = paste0(colnames(topdat),"end")
      topdat$group = unique(data3$group)
    } else if(show=="z"&lacx == "right"&lacy == "top"){
      dat = data.frame(x = data$x - zoom,y = data$y - zoom)
      seqnum = (max(dat$x) - min(dat$x))/n
      tem = seq(from=min(dat$y), to=max(dat$y),by=seqnum)
      tem = tem[length(tem):1]

      topdat = data.frame(x=seq(from=min(dat$x), to=max(dat$x),by=seqnum),
                          y = tem) %>% slice(-1)
      topdat = topdat[-nrow(topdat),]
      colnames(topdat) = paste0(colnames(topdat),"end")
      topdat$group = unique(data3$group)

    } else if( show=="z"&lacx == "left"&lacy == "top"){
      dat = data.frame(x = data$x + zoom,y = data$y - zoom)
      seqnum = (max(dat$x) - min(dat$x))/n
      tem = seq(from=min(dat$y), to=max(dat$y),by=seqnum)
      # tem = tem[length(tem):1]

      topdat = data.frame(x=seq(from=min(dat$x), to=max(dat$x),by=seqnum),
                          y = tem) %>% slice(-1)
      topdat = topdat[-nrow(topdat),]
      colnames(topdat) = paste0(colnames(topdat),"end")
      topdat$group = unique(data3$group)

    }
  } else{
    topdat = topdat
  }


  # head(data3)
  tab2 = data3 %>% left_join(topdat,by = "group")
  # head(tab2)

  # corva = -0.2
  tem = c(rep(corva,floor(nrow(data)/2)),
          rep(-corva,ceiling(nrow(data)/2)))

  # range = 0.02
  tem2 = tab2$R^2*200 *range
  tab2$size = tem2
  # library(ggnewscale)

  id1 = idtab %>% filter(group ==unique(data3$group)[1]) %>%.[1:(floor(nrow(data)/2)),] %>%.$label
  id2 = idtab %>% filter(group ==unique(data3$group)[1]) %>%.[(floor(nrow(data)/2) + 1):nrow(data),] %>%.$label

  head(tab2)
  p0 = p +
    # new_scale("size") +
    geom_curve(data = tab2 %>% filter(label %in% id1),
               aes_string(x = "xend",
                          y = "yend",
                          xend = "x",
                          yend = "y",
                          group = "groupbc",
                          color ="groupr",
                          size = "size"),
               curvature = -corva,show.legend = TRUE
    ) +
    ggnewscale::new_scale("size") +

    geom_curve(data = tab2 %>% filter(label %in% id2),
               aes_string(x = "xend",
                          y = "yend",
                          xend = "x",
                          yend = "y",
                          group = "groupbc",
                          color ="groupr",
                          size = "size"),
               curvature = corva,show.legend = FALSE
    ) +
    scale_size_continuous(name = "Size.matel") +
    scale_color_manual(values = c("#91331FFF","#46732EFF")) +
    # guides(shape = guide_legend(override.aes = list(fill = "blue") )) +
    ggnewscale::new_scale_fill() +
    ggnewscale::new_scale_color() +
    geom_point(data = tab2,
               aes_string(x = "x",
                          y = "y",
                          color = "groupr",
                          fill = "groupr",
                          size = tem2*0.65
               ),
               pch = 21,) +
    scale_color_manual(values = c("#91331FFF","#46732EFF")) +
    scale_fill_manual(values = c("#91331FFF","#46732EFF")) +
    ggnewscale::new_scale_fill() +
    geom_point(data = topdat,aes(x = xend, y = yend),pch = numpoint2,size =8,
               color = "grey60",fill = "#FFF5EB") +
    ggrepel::geom_text_repel(data = topdat,aes(x = xend, y = yend,label = group))

  return(list(p0,topdat))
}
taowenmicro/ggClusterNet documentation built on March 29, 2025, 1:04 p.m.