chr1swallace

library(nnet)

nsnp <- 3
simdata <- function(n) {
  X <- matrix(pmin(abs(rnorm(n*nsnp)),3),nrow=n)

  p <- rbinom(n, 1, X[,1]/3)
  q <- rbinom(n, 1, X[,nsnp]/3)

  Y <- ifelse(p>0, 1, ifelse(q>0, 2, 0))

chr1swallace

## install packages using the following
## install.packages("devtools")
## library(devtools)
## install_github("ropensci/rorcid") 
## install.packages(c("tm","wordcloud"))

## load libraries
library(rorcid)
library(wordcloud)

chr1swallace

## I don't know how much R you know already.  Start at the beginning,
## use online R tutorials, the native help system, and books, and work
## through the steps below.  I've tried to write enough that if you
## already know R you won't be bored, so if you don't already know R,
## please don't assume you *have* to complete these tasks!

## install packages - only need to do this first time
install.packages("devtools")
library(devtools)
install_github("chr1swallace/coloc") # has the finemap.abf function

chr1swallace

library(data.table)
library(parallel)
library(annotSnpStats)
library(snpStats)
library(GUESSFM)

##
inv.logit.fn <-function(x) return(exp(x)/(1+exp(x)))
##

chr1swallace

## sharing parameter, largish, so we expect to see a big enough difference to check if working
S <- 100
prior.bin.fn <- function(nT1,s=100,mT1=3) {
    dbinom(nT1,size=s,prob=mT1/s)/choose(s,nT1)
}

bothpp <- function(data) {
    ss1 <- strsplit(data$t1.str,"%")
    ss2 <- strsplit(data$t2.str,"%")
    data$overlap <- sapply(1:nrow(data), function(i)

chr1swallace

## sharing parameter, largish, so we expect to see a big enough difference to check if working
S <- 100
prior.bin.fn <- function(nT1,s=100,mT1=3) {
    dbinom(nT1,size=s,prob=mT1/s)/choose(s,nT1)
}

bothpp <- function(data) {
    ss1 <- strsplit(data$t1.str,"%")
    ss2 <- strsplit(data$t2.str,"%")
    data$overlap <- sapply(1:nrow(data), function(i)

chr1swallace

library(ggdendro)
library(ggplot2)
library(reshape)
library(grid)
library(gtable)

## colours, generated by
## library(RColorBrewer)
## rev(brewer.pal(11,name="RdYlBu"))
my.colours <- c("#313695", "#4575B4", "#74ADD1", "#ABD9E9", "#E0F3F8", "#FFFFBF", 

chr1swallace

library(snpStats)
  best <- cond.best(X,Y, family=family)
  while(length(newbest <- cond.best(X, Y, best, family=family)))
    best <- c(best,newbest)

cond.best <- function(X,Y,best=NULL,p.thr=1e-6, ...) {
  if(is.null(best)) {
    cond <- snp.rhs.tests(Y ~ 1, snp.data=X, data=data.frame(Y=Y,
row.names=rownames(X)), ...)
    p.thr <- 1

chr1swallace

library(MASS)
data<-mvrnorm(n=100, mu=c(1,2), Sigma=matrix(c(1,0.5,0.5,1),2))

colnames(data) <- c("x","y")
var(data)
cor(data)

data[,"x"] <- data[,"x"] + 3
var(data) # unchanged
cor(data) # unchanged

chr1swallace

coloc.bayes.3t <- function(df1,snps=setdiff(colnames(df1),response),response="Y",priors=list(rep(1,14)),r2.trim=0.99,thr=0.005,quiet=TRUE) {
    #we consider all models which contain at most 1 snp for each of the three traits
    snps <- unique(snps)
    n.orig <- length(snps)
    if(n.orig<2)
        return(1)
    prep <- prepare.df(df1, snps, r2.trim=r2.trim, dataset=1, quiet=quiet)
    df1 <- prep$df
    snps <- prep$snps