abikoushi

#create unsorted Pareto chart
#depend on library qcc
pareto.chart2 <- function (x, unsorted=TRUE,
                          ylab = "Frequency", ylab2 = "Cumulative Percentage", 
                          xlab, cumperc = seq(0, 100, by = 25), ylim, main, col = heat.colors(length(x)), 
                          plot = TRUE, ...) 
{
  call <- match.call(expand.dots = TRUE)
  varname <- deparse(substitute(x))
  x <- as.table(x)

abikoushi

nihongo <- function (family = "HiraKakuPro-W3"){
  old =par(family = family)
  return(old)
}

abikoushi

cpy <- function(a){
    if(is.data.frame(a) | is.matrix(a)){ write.table(a, pipe("pbcopy"), sep="\t", row.names=FALSE, quote=FALSE)
    }else write.table(t(a), pipe("pbcopy"), sep="\t", row.names=FALSE, quote=FALSE)
}

abikoushi

cpy <- function(a){
    if(is.data.frame(a) | is.matrix(a)){ write.table(a, file="clipboard", sep="\t", row.names=FALSE, quote=FALSE)
    }else write.table(t(a), file="clipboard", sep="\t", row.names=FALSE, quote=FALSE)
}

abikoushi

hatena <- function(x){
 cn1 <- NULL
 if(!is.null(colnames(x))) cn1 <- paste("|*",colnames(x))
 dim1 <- dim(x)
 x <- apply(x, 2,as.character)
 x <- paste("|",x)
 dim(x) <- dim1
 if(is.null(cn1)){
 	write.table(x, quote=FALSE,col.names=FALSE, row.names=FALSE, eol="|\n")
 	}else{

abikoushi

histcol <-function(hst, from, to, col="cornflowerblue"){
  bw<-diff(hst$breaks)[1]
  part<-c(from,to)
  xv <-seq(part[1],part[2],bw)
  yv <- hst$counts[hst$breaks[-length(hst$breaks)] %in% xv]
  for(k in 1:(length(xv)-1)){
    polygon(sort(rep(xv[k:(k+1)], 2)), c(0,rep(yv[k], 2),0), 
            col=col)
  }
}

abikoushi

dnorm2 <- function(x, y, r=0.7){
  det <- 1- r^2
  return(
    1/(2 * pi * sqrt(det)) * exp(-(x^2 -2 * r * y + y^2)/(2*det) )
  )
}

abikoushi

size_calc <-function(L,p,alpha=0.05){
  ceiling(((qnorm(alpha/2) ^ 2) *p*(1-p))/L^2)
}

abikoushi

CIset<-function(k, n, group=NULL, conf=0.95){
  rate = k/n
  len <-length(k)
  CI =sapply(1:len ,function(i){
    ans <- binom.test(k[i], n[i], conf.level =conf)
    ans$conf.int[1:2]})
  data.frame(group =if(is.null(group)){LETTERS[1:len]}else{group},
             rate=rate,
             upper = CI[1,],
             lower = CI[2,])

abikoushi

cdh <- function(sf, bw=NULL, digits =0, strata=1, col="white",main=NULL){
  if(class(sf)!="survfit"){
    cat("survfitオブジェクトを入れてください。\n")
  }
  if(is.null(sf$strata)){
    DT =sf$time
    surv =sf$surv
  }else{
    if(strata==1){
      DT =sf$time[1:sf$strata[1]]