abikoushi

#include <RcppArmadillo.h>
using namespace Rcpp;
using namespace arma;
// [[Rcpp::depends(RcppArmadillo)]]

// [[Rcpp::export]]
mat rcate(const int N, const rowvec & p){
  int K = p.n_cols;
  rowvec cump = cumsum(p);
  mat x(N, K);

abikoushi

doVB <- function(y,X,a=0.5,b=0.001,iter=200){
  K <- ncol(X)
  sxy = t(X)%*%y
  lambda <- rgamma(K,1,1)
  ahat <- rep(a,K)
  bhat <- rep(b,K)
  for (i in 1:iter) {
    for(j in 1:K){
      ahat[j] = sxy[j]+a
      bhat[j] = X[,j]%*%exp(X[,-j,drop=FALSE]%*%log(lambda[-j]))+b

abikoushi

####
#Negative sampling
####
library(Matrix)
library(ggplot2)
##tau = prior param.
#grad
dlogll <- function(lambda,Y,X,W,tau){
  as.vector(t(X)%*%(lambda-Y)) + 0.5*tau*W
}

abikoushi

library(ggplot2)
library(dplyr)

sign_p <- function(mu, x, prob=0.5){
  x2 <- x-mu
  x2 <- x2[x2 != 0]
  pos <- sum(x2>0)
  p1 = pbinom(pos, length(x2), prob = prob, lower.tail = FALSE)
  p2 = pbinom(pos, length(x2), prob = prob, lower.tail = TRUE)
  data.frame(p = 2*min(p1, p2), location=mu)

abikoushi

library(ggplot2)


out <- vector("list", 10000)
for(i in 1:10000){
  x <- rt(10,3)
  out[[i]] <- sign(x)*rank(abs(x))  
}

ggplot(data=NULL)+

abikoushi

signTable <- function(mu,x){
  x2 <- x-mu
  x2 <- x2[x2 != 0]
  data.frame(table(sign(x2)), loc=mu)
}

wilcoxTable <- function(mu,x){
  x2 <- x-mu
  x2 <- x2[x2 != 0]
  data.frame(w=sign(x2)*rank(abs(x2)), loc=mu)

abikoushi

library(ggplot2)

binomfun <- function(c,n){
  sum(choose(n,floor(n/2+seq(-c,c)))/(2^n))
}

wilcoxCI <- function(x,level){
  xx <- outer(x,x,"+")
  u <- sort(xx[lower.tri(xx, diag = TRUE)]/2)
  n <- length(u)

abikoushi

library(ggplot2)
#check the moments
integrate(function(x)x*dexp(x), 0,Inf)
integrate(function(x)x^2*dexp(x), 0,Inf)
integrate(function(x)x*dnorm(x,1,1), -Inf,Inf)
integrate(function(x)x^2*dnorm(x,1,1), -Inf,Inf)


pv_simfun <- function(n1,n2){
  x1 <- rexp(n1)

abikoushi

binomfun <- function(c,n){
  sum(choose(n,n/2+seq(-c,c))/(2^n))
}

signCI <- function(x,level){
  n <- length(x)
  sx <- sort(x)
  alpha_c = sapply(1:(n/2), binomfun, n=n)
  k <- which.max(alpha_c-(level)>0)
  lower <- sx[k]

abikoushi

library(rvest)
library(dplyr)
#browseURL(paste0(url_ncbi,qt))

qt <- "ID3" #searh query

NCBI_search <- function(qt){
  url_ncbi <- "https://www.ncbi.nlm.nih.gov/gene/?term="
  url_t <- paste0(url_ncbi,qt)
  html_t <- read_html(url_t)