tukachev

# McCrae's rpa (r profile agreement)
rpa <- function(p1,p2){
  if (length(p1) != length(p2)) 
    stop("'p1' and 'p2' must have the same length")
  k <- length(p1)
  sumM.sq <- sum(((p1 + p2)/2)^2)
  sumd.sq <- sum((p1 - p2)^2)
  ipa <- (k + 2*sumM.sq - sumd.sq) / sqrt(10*k)
  rpa <- ipa / sqrt(k - 2 + ipa^2)
  return(rpa)

tukachev

#Функция для вычисления Фи-коэффициента Гилфорда для четырехклеточных таблиц
#Guilford J. P. The phi-coefficient and chi-square as indices of item validity. — Psychometrika. 1941. VI. P. 11—19.

phi.coeff <- function(x){
  #Проверка
  if (!is.matrix(x)) 
    stop("Function only defined for 2-way tables.")
  a <- x[1,1]
  b <- x[1,2]
  c <- x[2,1]

tukachev

# The Gower similarity index
gower <- function(p1, p2, max, min){
  if (length(p1) != length(p2)) 
    stop("'p1' and 'p2' must have the same length")
  k <- length(p1)
  range <- max - min
  d <- sum(abs(p1 - p2) / range)
  gs <- 1 - d / k
  return(gs)
}

tukachev

packs <- c("knitr", "ggplot2", "XML", "reshape2", "rCharts", "Cairo")
lapply(packs, require, character.only = TRUE)
theurl = "http://www.sochi2014.com/medalnyj-zachet"
## Grab Data, Clean and Reshape
raw <- readHTMLTable(theurl, header=FALSE, 
                         colClasses = c(rep("factor", 2), rep("numeric", 4)))
raw <- as.data.frame(raw)[, -1]
colnames(raw) <- c("Страна", "Золото", "Серебро", "Бронза", "Всего")
raw <- with(raw, raw[order(Всего, Золото, Серебро, Бронза), ])
raw <- raw[raw[, "Всего"] != 0, ]

tukachev

read.gspreadsheet <- function(key) {
  require(RCurl)
  myCsv <- getURL(paste("https://docs.google.com/spreadsheet/pub?hl=en_US&hl=en_US&key=", 
                        key, "&single=true&gid=0&output=csv", sep = ""),
                  .encoding = "UTF8")
  read.table(textConnection(myCsv), header = T, sep = ",", stringsAsFactors = FALSE)
}

tukachev

google.distance <- function(origin, destination, mode = "driving"){
  require(XML)
  require(RCurl)
  origin <- gsub(" ","+",origin)
  destination <- gsub(" ","+",destination)
  url <- paste0("http://maps.googleapis.com/maps/api/distancematrix/xml?origins=",origin,"&destinations=",destination,"&mode=",mode,"&language=ru_RU")
  xmlpage <- xmlParse(getURL(url))
  duration <- as.numeric(xmlValue(xmlChildren(xpathApply(xmlpage,"//duration")[[1]])$value))
  distance <- as.numeric(xmlValue(xmlChildren(xpathApply(xmlpage,"//distance")[[1]])$value))
  origin.ad <- xmlValue(xpathApply(xmlpage,"//origin_address")[[1]])

tukachev

# McCrae's rpa (r profile agreement): calc&plot :)
rpa <- function(p1, p2){
  if (length(p1) != length(p2)) 
    stop("'p1' and 'p2' must have the same length")
  k <- length(p1)
  pr1 <- (p1 - 5.5)/2
  pr2 <- (p2 - 5.5)/2
  sumM.sq <- sum(((pr1 + pr2)/2)^2)
  sumd.sq <- sum((pr1 - pr2)^2)
  ipa <- (k + 2*sumM.sq - sumd.sq) / sqrt(10*k)

tukachev

#Функция отправки почтового сообщения (СМС, если использовать шлюз оператора)
#username — имя пользователя почты на gmail.com
#password — пароль от почты на gmail.com
#emailto — e-mail получателя (например, username@mail.ru или используя email2sms шлюз оператора 79ХХХХХХХХХ@sms.ycc.ru)
#sub — тема сообщения
#msg — текст сообщения

gmail.send <- function(username, password, emailto, sub, msg)
{
  frommailuser <- paste(username,"@gmail.com", sep='')

tukachev

# Младенческая смертность в России (2011-2012) и результаты выборов в госдуму (2011)
# по регионам РФ
# Исходные данные: 
#   - официальные результаты выборов 
# http://ru.wikipedia.org/wiki/Выборы_в_Государственную_думу_(2011)#cite_note-87
#   - данные Росстата по младенческой смертности в 2012 году 
# http://www.gks.ru/free_doc/2012/demo/t3-3.xls

# Загружаем необходимые пакеты
library("psych")

tukachev

corstars < - function(x){
require(Hmisc)
x <- as.matrix(x)
R <- rcorr(x)$r
p <- rcorr(x)$P
mystars <- ifelse(p < .01, "**|", ifelse(p < .05, "* |", " |"))
R <- format(round(cbind(rep(-1.11, ncol(x)), R), 3))[,-1]
Rnew <- matrix(paste(R, mystars, sep=""), ncol=ncol(x))
diag(Rnew) <- paste(diag(R), " |", sep="")
rownames(Rnew) <- colnames(x)