explodecomputer

# library(TwoSampleMR)
library(MRInstruments)
data(gwas_catalog)
gwas_catalog_subset <- subset(gwas_catalog, Phenotype %in% c('Body mass index')& SNP %in% c('rs10938397', 'rs1516725', 'rs2568958', 'rs633715', 'rs7138803', 'rs8089364'))
exposure_dat <- format_gwas_catalog(gwas_catalog_subset)
exposure_dat <- format_data(gwas_catalog_subset, "exposure")
ao <- available_outcomes()
outcome_dat <- extract_outcome_data(exposure_dat$SNP, c(1), proxies = 1, rsq = 0.8, align_alleles = 1, palindromes = 1, maf_threshold = 0.3)
dat <- harmonise_data(exposure_dat, outcome_dat, action = 2)
mr_results <- mr(dat)

explodecomputer

get_beta_se_from_p_z_n_vary <- function(z, n, vy, maf)
{
    # qval <- qchisq(pnorm(abs(z), low=FALSE)*2, 1, low=F) / (qchisq(pnorm(abs(z), low=FALSE)*2, n-2, low=F)/(n-2))
    # r <- sqrt(sum(qval / (n - qval)))
    r <- sqrt(abs(z)^2 / (abs(z)^2 + n-2))
    b <- sign(z) * sqrt(r^2 * vy / (2*maf*(1-maf)))
    se <- b / z
    return(list(b=b, se=se))
}

explodecomputer

library(reshape2)

get_pairs <- function(people)
{
	require(reshape2)

	# Create matrix of all possible pairings
	# Only use pairings on diagonal with an offset of half the number of people
	# This ensures that there is equal spacing between each person's turn to present (as def or pros)
	p <- rep(people, 2)

explodecomputer

library(TwoSampleMR)
ao <- available_outcome()
i <- grep("arachid", ao$trait)
b <- extract_instruments(ao$id[i[1]])
o <- extract_outcome_data(b$SNP[1], ao$id)
dat <- harmonise_data(b[1,], o)
m <- mr(dat)

ivw <- subset(m, method=="Fixed effects meta analysis (delta method)" & pval < 0.05)
ivw <- subset(ivw, !duplicated(outcome))

explodecomputer

library(TwoSampleMR)
library(systemfit)

# test 2sls

b <- matrix(rbinom(10000, 2, 0.5), 1000)
eff <- rnorm(10)
g <- b %*% eff * 100
u <- rnorm(1000)
x <- scale(rnorm(1000) + g - u) * 100

explodecomputer

# bash/zsh git prompt support
#
# Copyright (C) 2006,2007 Shawn O. Pearce <[email protected]>
# Distributed under the GNU General Public License, version 2.0.
#
# This script allows you to see the current branch in your prompt.
#
# To enable:
#
#    1) Copy this file to somewhere (e.g. ~/.git-prompt.sh).

explodecomputer

library(shiny)

ui <- bootstrapPage(
	selectizeInput('foo', choices = NULL, label="Species")
)


server <- function(input, output, session)
{
	updateSelectizeInput(session, 'foo', choices = state.name, server = TRUE)

explodecomputer

library(shiny)
library(shinydashboard)
library(googleAuthR)

options("googleAuthR.scopes.selected" = c("https://www.googleapis.com/auth/userinfo.profile", "https://www.googleapis.com/auth/userinfo.email"))
options("googleAuthR.webapp.client_id" = "906514199468-1jpkqgngur8emoqfg9j460s47fdo2euo.apps.googleusercontent.com")
options("googleAuthR.webapp.client_secret" = "I7Gqp83Ku4KJxL9zHWYxG_gD")

user_info <- function(){
	f <- gar_api_generator("https://www.googleapis.com/oauth2/v1/userinfo",

explodecomputer

get_beta_se_from_p_z_n_vary <- function(z, n, vy, maf)
{
	qval <- qchisq(pnorm(abs(z), low=FALSE)*2, 1, low=F) / (qchisq(pnorm(abs(z), low=FALSE)*2, n-2, low=F)/(n-2))
	r <- sqrt(sum(qval / (n - qval)))
	b <- sign(z) * sqrt(r^2 * vy / (2*maf*(1-maf)))
	se <- b / z
	return(list(b=b, se=se))
}

explodecomputer

palette(c("#E41A1C", "#377EB8", "#4DAF4A", "#984EA3",
  "#FF7F00", "#FFFF33", "#A65628", "#F781BF", "#999999"))

shinyServer(function(input, output, session) {

  # Combine the selected variables into a new data frame
  selectedData <- reactive({
    iris[, c(input$xcol, input$ycol)]
  })