Примеры по R

r <- "9,1"
as.numeric( gsub(",", ".", r) )

> vec = c()
> values = c('a','b','c','d','e','f','g')
> vec <- append(vec, values)
> vec
[1] "a" "b" "c" "d" "e" "f" "g"

a <- sample(1:10)
# [1]  3 10  1  6  7  4  8  2  5  9
remove <- c(3,5,7) # удалить 3,5,7-й элементы 
# [1] 3 5 7
a <- a[-remove]
# [1]  3 10  6  4  2  5  9

x <- c(NA, 3, NA, 5)
# Вариант 1:
x[!is.na(x)]
[1] 3 5
# Вариант 2:
na.omit(x)
[1] 3 5

x[length(x)]                                  # последний элемент x
last <- function(x) { return (x[length(x)]) } # превращаем в функцию

tail(x, n=1)                                  # последний элемент x
last <- function(x) { tail(x, n = 1) }

# order() возвращает индексы элементов, 
# чьи значения упорядочены по возрастанию
a <- c(12,7,3,9,6)
order(a)
[1] 3 5 2 4 1
# самое маленькое число (3) расположено в исходном векторе 
# на 3-й позиции, следующее число (6) -- на 5-й и т.д.

# Вектор, упорядоченный по возрастанию
a[order(a)]
[1]  3  6  7  9 12

# Вектор, упорядоченный по убыванию
a[order(a, decreasing = TRUE)]
[1] 12  9  7  6  3

y <- iris[c(-1,-150),5]
# table() покажет уровни фактора и их частоту
table(y)
y
    setosa versicolor  virginica 
        49         50         49

# which.max() определить уровень, встречающийся чаще всего
# names() выведет имя этого уровня
names( which.max(table(y)) )
[1] "versicolor"

# Добавим в список list элемент newobj и дадим ему имя name
list.new <- append(list, list(name=newobj))
# При этом имена элементов из списка list сохраняются

# Удаление 3-го элемента списка myList
myList[[3]] <- NULL
# При удалении нескольких элементов,
# подход тот же, что и при удалении элементов вектора

# Создаем список списков
listoflists = list(list(c1=1, c2='a', c3=3, c4=4),
                   list(c1=5, c2='b', c3=6, c4=7))
# Преобразуем список в матрицу, транспонируем ее
# и преобразуем полученный результат в таблицу
df = as.data.frame(t(sapply(listoflists, unlist)))

> string_with_nums <- " dfg45h 67 h"
> string_without_nums <- gsub("[^[:digit:]]", "", string_with_nums)
> string_without_nums
[1] "4567"

# Вариант 1
is.empty <- function(x) {
    return(length(x)==0)
}
# Вариант 2
is.empty <- function(x) {
    return(identical(x, numeric(0)))
}

a = c(1,2,3,3,4,5,6,7,7,8)

# 1. Удаление повторяющихся элементов с сохранением первого вхождения элемента
# Результат: c(1,2,3,4,5,6,7,8)

# Возвращает TRUE, если элемент уже существует в векторе (списке, таблице).
duplicated(a)
##[1] FALSE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE  TRUE FALSE

# Возвращает вектор с удаленными повторяющимися элементами.
unique(a)
# или
a[!duplicated(a)]
##[1] 1 2 3 4 5 6 7 8

# 2. Удаление всех элементов, присутствующих в векторе более одного раза
# Результат: c(1,2,4,5,6,8)

a[!(duplicated(a) .html)", "", string_with_nums)
> string_without_nums
[1] "4567"

> s1 = 'Learning "R" is fun!'
> s2 = "Learning \"R\" is fun!"
> s1
[1] "Learning \"R\" is fun!"
> s2
[1] "Learning \"R\" is fun!"

> cat(s1)
Learning "R" is fun! 
> cat(s2)
Learning "R" is fun!

.Last.value

lv <- function() .Last.value.

`%+=%` = function(o1,o2) eval.parent(substitute(o1 <- o1 + o2))
x <- 1
x %+=% 2 

# останов, если logical_expression не TRUE. Без возможности комментировать
stopifnot( logical_expression )
# расширяет возможности stopifnot, но тоже без добавления комментариев
# install.packages('assertthat')
assert_that( logical_expression )
# С возможность комментировать
if ( !logical_expression ) stop("error message")

# Как проверить, существует ли объект obj_name
exists("obj_name")

s <- "\t\n\r    Test Text  \t\t\n\r\t"
# Вариант 1
trimws(s)
## [1] "Test Text"
# Вариант 2
stringr::str_trim(s)
## [1] "Test Text"
# Вариант 3
trim <- function (x) gsub("^s+|s+$", "", x)
trim(s)
## [1] "Test Text"

a <- "old"
test <- function () {
   a <<- "new"
   # другой вариант:
   # assign("a", "new", envir = .GlobalEnv)
}
test()
a
 [1] "new"

sink("myfile.txt") # перенаправим вывод из stdout в файл myfile.txt
my.func()          # запустим функцию, которая что-то выводит
sink()             # направим вывод назад в stdout

# Объединим прочитанные readLines строки в одну:
singleString <- paste(readLines("filename.txt"), collapse="\n")

# Создадим тестовую таблицу данных.
> mydata <- data.frame(name = c("Antony", "Bob", "Cecilia", "Jack", "Mary", "Tony"),
+                      col_a = c(0, 1, 0, 1, 2, 3),
+                      col_b = c(3, 0, 3, 3, 1, 0),
+                      stringsAsFactors=FALSE)
> mydata
     name col_a col_b
1  Antony     0     3
2     Bob     1     0
3 Cecilia     0     3
4    Jack     1     3
5    Mary     2     1
6    Tony     3     0

# Нужные нам строки - 1-ая и 6-ая
> grep('[t,T]ony', mydata$name)
[1] 1 6

> mydata[grep('[t,T]ony', mydata$name),]
    name col_a col_b
1 Antony     0     3
6   Tony     3     0

# Создадим пустую таблицу mydata с числовыми колонками First, Second
# и символьной колонкой Third:
mydata <- data.frame(First=numeric(0),
                     Second=numeric(0),
                     Third = character(0),
                     stringsAsFactors=FALSE)
str(mydata) # проверим:

## 'data.frame':    0 obs. of  3 variables:
##  $ First: num 
##  $ Second: num 
##  $ Third: chr

# Задана таблица с единственной колонкой
df <- data.frame(id=1)
# Имена других колонок заданы заранее
namevector <- c("col2","col3","col4")
# Добавляем эти пустые колонки в таблицу
df[,namevector] <- NA
print(df)

##  id col1 col2 col3
##1  1   NA   NA   NA

# Заметим, что names() воспользоваться нельзя, т.к. изначально
# df имеет всего одну колонку, которой нельзя дать три имени.

# Используем функцию Encoding().

# Для одной колонки:
Encoding(table$colname) <- "UTF-8"

# Для всей таблицы:
for (i in 1:length(table))
  Encoding(table$[[i]]) <- "UTF-8"

# Создаем тестовую таблицу
numPeople = 10
sex=sample(c("male","female"),numPeople,replace=T)
age = sample(14:102, numPeople, replace=T)
income = sample(20:150, numPeople, replace=T)
population = data.frame(sex=sex, age=age, income=income)
# Выводим ее содержимое
population
# sex age income
# 1  female  42     40
# 2  female  99     41
# 3    male  28     75
# 4  female  20     62
# 5  female  25    113
# 6    male  52     51
# 7    male  16    137
# 8    male  53     37
# 9    male  14     22
# 10   male  60     76

# Упорядочиваем строки таблицы по возрастанию значений из колонки age
population[order(population$age),]
# sex age income
# 9    male  14     22
# 7    male  16    137
# 4  female  20     62
# 5  female  25    113
# 3    male  28     75
# 1  female  42     40
# 6    male  52     51
# 8    male  53     37
# 10   male  60     76
# 2  female  99     41

# Обычно верхний столбец в записанном csv-файле содержит заголовки строк.
# Если такой заголовок не нужен, делаем так:

write.table(my_data_frame, sep=",",  col.names=FALSE)

# Обратите внимание: используется write.table, а не write.csv.

# Преобразуем 1-ю и 3-ю колонки таблицы data:
data[, c(1,3)] <- sapply(data[, c(1,3)], as.numeric)

# Создадим тестовую таблицу с двумя пустыми колонками:
dat <- data.frame(a=1:5, b=1:5, c=rep(NA,5), d=1:5, e=rep(NA,5))
# Удалим колонки, целиком состоящие из NA из таблицы dat:
dat <- dat[, !sapply(dat, function(x) all(is.na(x))), drop=F]

df <- data.frame(first=letters[1:5], 
                 second=c(1,2,NA,4,NA), 
                 third=c(8,7,NA,5,4))
#   first second third
# 1     a      1     8
# 2     b      2     7
# 3     c     NA    NA
# 4     d      4     5
# 5     e     NA     4

# Удалить все строки с NA - вариант 1
na.omit(df)
# или, что то же самое, оставить только 
# строки без NA
df[complete.cases(df),]
#   first second third
# 1     a      1     8
# 2     b      2     7
# 4     d      4     5

# Удалить строки с NA в заданном столбце
# В примере - в 3-ем
df[complete.cases(df[,3]),]
# first second third
# 1     a      1     8
# 2     b      2     7
# 4     d      4     5
# 5     e     NA     4

df <-  data.frame(A=1:3, B=letters[1:3], stringsAsFactors = T)
data.frame(t(df))

# Создаем таблицу
df = data.frame(c1=1:4, c2=letters[1:4], c3=5:8)
# Удаляем колонку "с2"
df_new = df[ , -which(names(df) %in% c("c2"))]

plot.new() # пустое окно, готовое к добавлению графиков
frame()    # другой способ

> n <- 2 # число переменных
> listoffactors <- paste0("factor",1:n)
> listoffactors
[1] "factor1" "factor2"
> as.formula(paste("y~",paste(listoffactors,collapse="+")))
y ~ factor1 + factor2

# Если в коде записано:
if (condition == TRUE) x <- TRUE
else x <- FALSE
# R воспринимает первую строку как закончившуюся.
# Вторая строка начинается с else, который будет истолкован как самостоятельный оператор.
# Поскольку такого оператора не существует, будет выдано сообщение об ошибке
#    Error: unexpected 'else' in " else"
# Чтобы R интерпретировал else как часть предшествующего if’а, нужно указать ему
# при помощи фигурных скобок, что if еще не закончился:
if (condition == TRUE) { 
  x <- TRUE
} else {x <- FALSE}

# Пауза на 2.5 секунды:
Sys.sleep(2.5)

if(!file.exists(destination_file)) {
  # выполнить, если файла не существует
}

# На примере файлов MS Excel *.xlsx
library(readxl)
file.list <- list.files(pattern='*.xlsx')
df.list <- lapply(file.list, read_excel)
# Вместо read_excel можно использовать read.table, read.csv, ...
# с соответствующим шаблоном в list.files

# Если колонки таблиц одинаковы, их можно объединить
library(dplyr)
df <- bind_rows(df.list, .id = "id")
# Опция .id добавляет колонку,
# для идентификации отдельных таблиц 
# внутри объединенной таблицы.

# Вывод списка пакетов, установленных пользователем,
# и номеров версий этих пакетов
# (пакеты, поставляемые вместе с R, игнорируются).
user_installed <- as.data.frame(installed.packages()[,c(1,3:4)])
rownames(user_installed) <- NULL
user_installed <- user_installed[is.na(user_installed$Priority),1:2,drop=FALSE]
print(user_installed, row.names=FALSE)

data()

# Задаем список нужных пакетов.
list.of.packages <- c("a", "b") # замените a и b на имена нужных пакетов
new.packages <- list.of.packages[!(list.of.packages %in% installed.packages()[,"Package"])]
# Если есть пакеты, которые нужно установить, то устанавливаем их.
if (length(new.packages)) install.packages(new.packages)
# Загружаем установленные пакеты.
lapply(new.packages, require, character.only=T)

install.packages("имя.пакета", repos = "http://cran.us.r-project.org")

old.packages()               # возвращает список установленных пакетов, которые уже устарели
update.packages()            # обновляет все установленные пакеты в режиме диалога с пользователем
update.packages(ask = FALSE) # обновляет все установленные пакеты, не задавая вопросов

> .libPaths()
[1] "C:/Program Files/R/R-3.2.2/library"

# 1) Если не установлен пакет devtools, то его нужно установить.
install.packages("devtools")
# 2) Загрузить devtools.
library(devtools)
# 3) Загрузить пакет из GitHub функцией
#
# install_github("автор/название_пакета")
#
# Например, для установки пакета activelearning, находящегося в репозитории 
# github.com/ramhiser/activelearning
# нужно задать
install_github("ramhiser/activelearning")

WARNING: Rtools is required to build R packages, but is not currently installed.

Please download and install Rtools 3.3 from http://cran.r-project.org/bin/windows/Rtools/ and then run find_rtools().

> find_rtools()
[1] TRUE

# Первое встретившееся предупреждение будет рассматриваться R
# как ошибка
options( warn = 2 )

sessionInfo()

> sessionInfo()

R version 3.2.2 (2015-08-14)
Platform: x86_64-w64-mingw32/x64 (64-bit)
Running under: Windows 7 x64 (build 7601) Service Pack 1

locale:
[1] LC_COLLATE=Russian_Russia.1251  LC_CTYPE=Russian_Russia.1251   
[3] LC_MONETARY=Russian_Russia.1251 LC_NUMERIC=C                   
[5] LC_TIME=Russian_Russia.1251    

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

rm(list=ls())