# notacja indeksowa operacji złączania
# koncepcja polega na tym, że rzędy są generowane dla każdego rzędu wewnątrz []
tabelaSprzed_data.table[tabelaProduktu_data.table, on = "IDproduktu"]
library("data.table")
tabelaProdukt_data.table <- as.data.table(tabelaProdukt)
tabelaSprzed_data.table <- as.data.table(tabelaSprzed)
# notacja indeksowa operacji złączania
# koncepcja polega na tym, że rzędy są generowane dla każdego rzędu wewnątrz []
tabelaSprzed_data.table[tabelaProduktu_data.table, on = "IDproduktu"]
tabelaSprzed_data.table[tabelaProdukt_data.table, on = "IDproduktu"]
merge(tabelaProdukt, tabelaSprzed, by = "IDproduktu", all.x = TRUE)
library("data.table")
tabela_zlaczona <- tabelaProdukt
tabela_zlaczona$SprzedaneEgzemplarze <- tabelaSprzed$SprzedaneEgzemplarze[match(tabela_zlaczona$IDproduktu,
tabelaSprzed$IDproduktu)]
print(tabela_zlaczona)
library("dplyr")
left_join(tabelaProdukt, tabelaSprzed, by = "IDproduktu")
merge(tabelaProdukt, tabelaSprzed, by = "IDproduktu")
library("data.table")
tabelaProdukt_data.table <- as.data.table(tabelaProdukt)
tabelaSprzed_data.table <- as.data.table(tabelaSprzed)
merge(tabelaProdukt, tabelaSprzed, by = "IDproduktu")
library("dplyr")
inner_join(tabelaProdukt, tabelaSprzed, by = "IDproduktu")
merge(tabelaProdukt, tabelaSprzed, by = "IDproduktu", all=TRUE)
library("data.table")
tabelaProdukt_data.table <- as.data.table(tabelaProdukt)
tabelaSprzed_data.table <- as.data.table(tabelaSprzed)
merge(tabelaProdukt_data.table, tabelaSprzed_data.table,
by = "IDproduktu", all = TRUE)
library("dplyr")
full_join(tabelaProdukt, tabelaSprzed, by = "IDproduktu")
library("data.table")
notowania <- data.table(
cena_ofertowa = c(5, 5, 7, 8),
cena_kupna = c(6, 6, 8, 10),
liczba_ofert_sprzedazy = c(100, 100, 100, 100),
liczba_ofert_kupna = c(100, 100, 100, 100),
when = as.POSIXct(strptime(
c("2018-10-18 1:03:17",
"2018-10-18 2:12:23",
"2018-10-18 2:15:00",
"2018-10-18 2:17:51"),
"%Y-%m-%d %H:%M:%S")))
print(notowania)
library("data.table")
notowania <- data.table(
cena_ofertowa = c(5, 5, 7, 8),
cena_kupna = c(6, 6, 8, 10),
liczba_ofert_sprzedazy = c(100, 100, 100, 100),
liczba_ofert_kupna = c(100, 100, 100, 100),
data = as.POSIXct(strptime(
c("2018-10-18 1:03:17",
"2018-10-18 2:12:23",
"2018-10-18 2:15:00",
"2018-10-18 2:17:51"),
"%Y-%m-%d %H:%M:%S")))
print(notowania)
transakcje <- data.table(
id_transakcji = c(32525, 32526),
cena = c(5.5, 9),
liczba = c(100, 200),
data = as.POSIXct(strptime(
c("2018-10-18 2:13:42",
"2018-10-18 2:19:20"),
"%Y-%m-%d %H:%M:%S")))
print(transakcje)
notowania[, data_notowan := data]
transakcje[ , data_transakcji := data ]
notowania[ transakcje, on = "data", roll = TRUE ][
, .(data_notowan, cena_ofertowa, cena, cena_kupna, id_transakcji, data_transakcji) ]
library("datasets")
library("xts")
# move the date index into a column
dates <- index(as.xts(time(Seatbelts)))
Seatbelts <- data.frame(Seatbelts)
Seatbelts$date <- dates
# restrict down to 1982 and 1983
Seatbelts <- Seatbelts[ (Seatbelts$date >= as.yearmon("Jan 1982")) &
(Seatbelts$date <= as.yearmon("Dec 1983")),
, drop = FALSE]
Seatbelts$date <- as.Date(Seatbelts$date)
# mark if the seatbelt law was in effect
Seatbelts$law <- ifelse(Seatbelts$law==1, "new law", "pre-law")
# limit down to the columns we want
Seatbelts <- Seatbelts[, c("date", "DriversKilled", "front", "rear", "law")]
head(Seatbelts)
View(Seatbelts)
library("datasets")
library("xts")
dates <- index(as.xts(time(Seatbelts)))
library("datasets")
library("xts")
dates <- index(as.xts(time(Seatbelts)))
Seatbelts <- data.frame(Seatbelts)
Seatbelts$date <- dates
eatbelts <- Seatbelts[ (Seatbelts$date >= as.yearmon("Jan 1982")) &
(Seatbelts$date <= as.yearmon("Dec 1983")),
, drop = FALSE]
Seatbelts <- Seatbelts[ (Seatbelts$date >= as.yearmon("Jan 1982")) &
(Seatbelts$date <= as.yearmon("Dec 1983")),
, drop = FALSE]
View(eatbelts)
View(Seatbelts)
View(eatbelts)
Seatbelts$date <- as.Date(Seatbelts$date)
Seatbelts$law <- ifelse(Seatbelts$law==1, "new law", "pre-law")
Seatbelts <- Seatbelts[, c("date", "DriversKilled", "front", "rear", "law")]
head(Seatbelts)
View(Seatbelts)
View(eatbelts)
View(eatbelts)
View(eatbelts)
View(eatbelts)
View(eatbelts)
datasets::Seatbelts
Seatbelts <- data.frame(Seatbelts)
View(Seatbelts)
dates <- index(as.xts(time(Seatbelts)))
Seatbelts$date <- dates
dates <- index(as.xts(time(Seatbelts)))
dates <- index(as.xts(time(Seatbelts)))
Seatbelts <- data.frame(Seatbelts)
View(Seatbelts)
Seatbelts$date <- dates
View(Seatbelts)
Seatbelts <- Seatbelts[ (Seatbelts$date >= as.yearmon("Jan 1982")) &
(Seatbelts$date <= as.yearmon("Dec 1983")),
, drop = FALSE]
View(Seatbelts)
dates <- index(as.xts(time(Seatbelts)))
Seatbelts <- data.frame(Seatbelts)
View(Seatbelts)
View(Seatbelts)
library("datasets")
library("xts")
dates <- index(as.xts(time(Seatbelts)))
Seatbelts <- data.frame(Seatbelts)
Seatbelts$date <- dates
dates
Seatbelts <- Seatbelts[(Seatbelts$date >= as.yearmon("Jan 1982")) &
(Seatbelts$date <= as.yearmon("Dec 1983")),
, drop = FALSE]
Seatbelts <- Seatbelts[ (Seatbelts$date >= as.yearmon("Jan 1982")) &
(Seatbelts$date <= as.yearmon("Dec 1983")),
, drop = FALSE]
dates <- index(as.xts(time(Seatbelts)))
Seatbelts <- data.frame(Seatbelts)
Seatbelts$date <- dates
View(Seatbelts)
Seatbelts <- Seatbelts[ (Seatbelts$date >= as.yearmon("Jan 1982")) &
(Seatbelts$date <= as.yearmon("Dec 1983")),
, drop = FALSE]
View(Seatbelts)
dates <- index(as.xts(time(Seatbelts)))
Seatbelts <- data.frame(Seatbelts)
Seatbelts$date <- dates
Seatbelts <- Seatbelts[(Seatbelts$date <= as.yearmon("Jan 1982")) &
(Seatbelts$date <= as.yearmon("Dec 1983")),
, drop = FALSE]
dates <- index(as.xts(time(Seatbelts)))
Seatbelts <- data.frame(Seatbelts)
Seatbelts$date <- dates
dates
Seatbelts <- Seatbelts[(Seatbelts$date >= as.yearmon("sty 1982")) &
(Seatbelts$date <= as.yearmon("gru 1983")),
, drop = FALSE]
Seatbelts$date <- as.Date(Seatbelts$date)
Seatbelts$law <- ifelse(Seatbelts$law==1, "new law", "pre-law")
Seatbelts <- Seatbelts[, c("date", "DriversKilled", "front", "rear", "law")]
head(Seatbelts)
pasy <- data.frame(Seatbelts)
datasets::Seatbelts
library("ggplot2")
ggplot(Seatbelts,
aes(x = date, y = DriversKilled, color = law, shape = law)) +
geom_point() +
geom_smooth(se=FALSE) +
ggtitle("Śmiertelność kierowców samochodów w poszczególnych miesiącach (Wielka Brytania)")
ibrary("data.table")
seatbelts_long2 <-
melt.data.table(as.data.table(Seatbelts),
id.vars = NULL,
measure.vars = c("DriversKilled", "front", "rear"),
variable.name = "victim_type",
value.name = "nvictims")
library("data.table")
seatbelts_long2 <-
melt.data.table(as.data.table(Seatbelts),
id.vars = NULL,
measure.vars = c("DriversKilled", "front", "rear"),
variable.name = "victim_type",
value.name = "nvictims")
library("cdata")
seatbelts_long3 <- unpivot_to_blocks(
Seatbelts,
nameForNewKeyColumn = "victim_type",
nameForNewValueColumn = "nvictims",
columnsToTakeFrom = c("DriversKilled", "front", "rear"))
library("tidyr")
seatbelts_long1 <- gather(
Seatbelts,
key = victim_type,
value = nvictims,
DriversKilled, front, rear)
head(seatbelts_long1)
ggplot(seatbelts_long1,
aes(x = date, y = nvictims, color = law, shape = law)) +
geom_point() +
geom_smooth(se=FALSE) +
facet_wrap(~victim_type, ncol=1, scale="free_y") +
ggtitle("Ofiary śmiertelne wypadków samochodowych w poszczególnych miesiącach i w zależności od miejsca w samochodzie (Wielka Brytania)")
library("datasets")
library("data.table")
library("ggplot2")
ChickWeight <- data.frame(ChickWeight) # get rid of attributes
ChickWeight$Diet <- NULL # remove the diet label
# pad names with zeros
padz <- function(x, n=max(nchar(x))) gsub(" ", "0", formatC(x, width=n))
# append "Chick" to the chick ids
ChickWeight$Chick <- paste0("Chick", padz(as.character(ChickWeight$Chick)))
head(ChickWeight)
ChickSummary <- as.data.table(ChickWeight)
ChickSummary <- ChickSummary[,
.(count = .N,
weight = mean(weight),
q1_weight = quantile(weight, probs = 0.25),
q2_weight = quantile(weight, probs = 0.75)),
by = Time]
head(ChickSummary)
library("ggplot2")
ChickSummary <- cdata::unpivot_to_blocks(                              	# Note: 1
ChickSummary,
nameForNewKeyColumn = "measurement",
nameForNewValueColumn = "value",
columnsToTakeFrom = c("count", "weight"))
ChickSummary$q1_weight[ChickSummary$measurement=="count"] <- NA    	# Note: 2
ChickSummary$q2_weight[ChickSummary$measurement=="count"] <- NA
CW <- ChickWeight
CW$measurement <- "weight"
ggplot(ChickSummary, aes(x = Time, y = value, color = measurement)) +   	# Note: 3
geom_line(data = CW, aes(x = Time, y = weight, group = Chick),
color="LightGray") +
geom_line(size=2) +
geom_ribbon(aes(ymin = q1_weight, ymax = q2_weight),
alpha = 0.3, colour = NA) +
facet_wrap(~measurement, ncol=1, scales = "free_y") +
theme(legend.position = "none") +
ylab(NULL) +
ggtitle("Waga kurczaków i pomiary liczebności w funkcji czasu",
subtitle = "Kwartyle od 25% do 75% wagi zostały zacienione wokół średniej")
library("ggplot2")
ChickSummary <- cdata::unpivot_to_blocks(                              	# Note: 1
ChickSummary,
nameForNewKeyColumn = "measurement",
nameForNewValueColumn = "value",
columnsToTakeFrom = c("count", "weight"))
ChickSummary$q1_weight[ChickSummary$measurement=="count"] <- NA    	# Note: 2
ChickSummary$q2_weight[ChickSummary$measurement=="count"] <- NA
CW <- ChickWeight
CW$measurement <- "weight"
ggplot(ChickSummary, aes(x = Time, y = value, color = measurement)) +   	# Note: 3
geom_line(data = CW, aes(x = Time, y = weight, group = Chick),
color="LightGray") +
geom_line(size=2) +
geom_ribbon(aes(ymin = q1_weight, ymax = q2_weight),
alpha = 0.3, colour = NA) +
facet_wrap(~measurement, ncol=1, scales = "free_y") +
theme(legend.position = "none") +
ylab(NULL) +
ggtitle("Waga kurczaków weight) i pomiary liczebności (count) w funkcji czasu",
subtitle = "Kwartyle od 25% do 75% wagi zostały zacienione wokół średniej")
ibrary("data.table")
ChickWeight_wide2 <- dcast.data.table(
as.data.table(ChickWeight),
Chick ~ Time,
value.var = "weight")
library("data.table")
ChickWeight_wide2 <- dcast.data.table(
as.data.table(ChickWeight),
Chick ~ Time,
value.var = "weight")
library("tidyr")
ChickWeight_wide1 <- spread(ChickWeight,
key = Time,
value = weight)
head(ChickWeight_wide1)
dane <- data.frame(przychody = c(2, 1, 2),    	# Note: 1
klucz_sortowania = c("b", "c", "a"),
stringsAsFactors = FALSE)
print(dane)
. <- dane                                     	# Note: 2
. <- .[order(.$klucz_sortowania), , drop = FALSE]     	# Note: 3
.$uporzadkowana_suma_przychodow <- cumsum(.$przychody)
.$ulamek_widzianych_przychodow <- .$uporzadkowana_suma_przychodow/sum(.$przychody)
wynik <- .                                   	# Note: 4
print(wynik)
library("dplyr")
wynik <- dane %>%
arrange(., klucz_sortowania) %>%
mutate(., uporzadkowana_suma_przychodow = cumsum(przychody)) %>%
mutate(., ulamek_widzianych_przychodow = uporzadkowana_suma_przychodow/sum(przychody))
wynik <- dane %>%
arrange(., klucz_sortowania) %>%
mutate(., uporzadkowana_suma_przychodow = cumsum(przychody)) %>%
mutate(., ulamek_widzianych_przychodow = uporzadkowana_suma_przychodow/sum(przychody))
d <- data.frame(kol1 = c(1, 2, 3), kol2 = c(-1, 0, 1))
d$kol3 <- d$kol1 + d$kol2
print(d)
set.seed(2019)                                               	# Note: 1
d <- data.frame(                                             	# Note: 2
x_zla = sample(letters, 100, replace = TRUE),
y = rnorm(100),
stringsAsFactors = FALSE
)
d$x_dobra <- ifelse(d$y > rnorm(100), "non-neg", "neg") 	# Note: 3
head(d)
View(d)
set.seed(2019)                                               	# Note: 1
d <- data.frame(                                             	# Note: 2
x_zla = sample(letters, 100, replace = TRUE),
y = rnorm(100),
stringsAsFactors = FALSE
)
d$x_dobra <- ifelse(d$y > rnorm(100), "nie-neg", "neg") 	# Note: 3
head(d)
plan5 <- vtreat::designTreatmentsN(d,                      	# Note: 1
varlist = c("x_zla", "x_dobra"),
outcomename = "y",
codeRestriction = "catN",
minFraction = 2,
verbose = FALSE)
class(plan5)
print(plan5)
dane_uczace1 <- vtreat::prepare(plan5, d)                  	# Note: 3
wyn1 <- vtreat::patch_columns_into_frame(d, dane_uczace1)    	# Note: 4
head(res1)
dane_uczace1 <- vtreat::prepare(plan5, d)                  	# Note: 3
wyn1 <- vtreat::patch_columns_into_frame(d, dane_uczace1)    	# Note: 4
head(wyn1)
sigr::wrapFTest(wyn1, "x_dobra_catN", "y")
sigr::wrapFTest(wyn1, "x_zla_catN", "y")
cfe <- vtreat::mkCrossFrameNExperiment(d,
varlist = c("x_zla", "x_dobra"),
outcomename = "y",
codeRestriction = "catN",
minFraction = 2,
verbose = FALSE)
plan6 <- cfe$treatments
dane_uczace2 <- cfe$crossFrame
wyn2 <- vtreat::patch_columns_into_frame(d, dane_uczace2)
head(wyn2)
sigr::wrapFTest(wyn2, "x_zla_catN", "y")
sigr::wrapFTest(wyn2, "x_dobra_catN", "y")
plan6$scoreFrame
load("~/PDSwR2-master/Bookdata/.RData")
measures <- interestMeasure(rules,                            	# Note: 1
measure=c("coverage", "fishersExactTest"),    	# Note: 2
transactions = bookbaskets_use)                	# Note: 3
summary(measures)
##     coverage        fishersExactTest
##  Min.   :0.002082   Min.   : 0.000e+00
##  1st Qu.:0.002511   1st Qu.: 0.000e+00
##  Median :0.002719   Median : 0.000e+00
##  Mean   :0.003039   Mean   :5.080e-138
##  3rd Qu.:0.003160   3rd Qu.: 0.000e+00
##  Max.   :0.006982   Max.   :9.702e-136
brules <- apriori(bookbaskets_use,
parameter = list(support = 0.001,                       	# Note: 1
confidence = 0.6),
appearance = list(rhs = c("The Lovely Bones: A Novel"),  	# Note: 2
default = "lhs"))                      	# Note: 3
summary(brules)
## set of 46 rules
##
## rule length distribution (lhs + rhs):sizes
##  3  4
## 44  2
##
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.
##   3.000   3.000   3.000   3.043   3.000   4.000
##
## summary of quality measures:
##     support           confidence          lift           count
##  Min.   :0.001004   Min.   :0.6000   Min.   :21.81   Min.   :41.00
##  1st Qu.:0.001029   1st Qu.:0.6118   1st Qu.:22.24   1st Qu.:42.00
##  Median :0.001102   Median :0.6258   Median :22.75   Median :45.00
##  Mean   :0.001132   Mean   :0.6365   Mean   :23.14   Mean   :46.22
##  3rd Qu.:0.001219   3rd Qu.:0.6457   3rd Qu.:23.47   3rd Qu.:49.75
##  Max.   :0.001396   Max.   :0.7455   Max.   :27.10   Max.   :57.00
##
## mining info:
##             data ntransactions support confidence
##  bookbaskets_use         40822   0.001        0.6
brules %>%
sort(., by = "confidence") %>%
lhs(.) %>%                                     	# Note: 1
head(., n = 5) %>%
inspect(.)
##   items
## 1 {Divine Secrets of the Ya-Ya Sisterhood: A Novel,
##    Lucky : A Memoir}
## 2 {Lucky : A Memoir,
##    The Notebook}
## 3 {Lucky : A Memoir,
##    Wild Animus}
## 4 {Midwives: A Novel,
##    Wicked: The Life and Times of the Wicked Witch of the West}
## 5 {Lucky : A Memoir,
##    Summer Sisters}
library(magrittr)                        	# Note: 1
rules %>%
sort(., by = "confidence") %>%           	# Note: 2
head(., n = 5) %>%                       	# Note: 3
inspect(.)                             	# Note: 4
brules %>%
sort(., by = "confidence") %>%
lhs(.) %>%                                     	# Note: 1
head(., n = 5) %>%
inspect(.)
##   items
## 1 {Divine Secrets of the Ya-Ya Sisterhood: A Novel,
##    Lucky : A Memoir}
## 2 {Lucky : A Memoir,
##    The Notebook}
## 3 {Lucky : A Memoir,
##    Wild Animus}
## 4 {Midwives: A Novel,
##    Wicked: The Life and Times of the Wicked Witch of the West}
## 5 {Lucky : A Memoir,
##    Summer Sisters}
brulesSub <- subset(brules, subset = !(lhs %in% "Lucky : A Memoir"))  	# Note: 1
brulesSub %>%
sort(., by = "confidence") %>%
lhs(.) %>%
head(., n = 5) %>%
inspect(.)
brulesConf <- sort(brulesSub, by="confidence")
inspect(head(lhs(brulesConf), n = 5))
##   items
## 1 {Midwives: A Novel,
##    Wicked: The Life and Times of the Wicked Witch of the West}
## 2 {She's Come Undone,
##    The Secret Life of Bees,
##    Wild Animus}
## 3 {A Walk to Remember,
##    The Nanny Diaries: A Novel}
## 4 {Beloved,
##    The Red Tent}
## 5 {The Da Vinci Code,
##    The Reader}
u <- c(1, 2)
v <- c(3, 4)
k <- function(u, v) {                       	# Note: 1
u[1] * v[1] +
u[2] * v[2] +
u[1] * u[1] * v[1] * v[1] +
u[2] * u[2] * v[2] * v[2] +
u[1] * u[2] * v[1] * v[2]
}
phi <- function(x) {                        	# Note: 2
x <- as.numeric(x)
c(x, x*x, combn(x, 2, FUN = prod))
}
print(k(u, v))                             	# Note: 3
## [1] 108
print(phi(u))
## [1] 1 2 1 4 2
print(phi(v))
## [1]  3  4  9 16 12
print(as.numeric(phi(u) %*% phi(v)))       	# Note: 4
## [1] 108
setwd("~/PDSwR2-master/Buzz")
paste('Ukończono dnia', date())
library(roxygen2)
roxygen2::
roxygenise()
roxygenise()
setwd("~/PDSwR2-master/PseudoLog10/R")
roxygenise(package.dir = )
roxygenise(package.dir = R)
roxygenise(package.dir = C:\Users\Krzysztof\OneDrive\Dokumenty\PDSwR2-master\PseudoLog10\R)
roxygenise(package.dir = C:/Users\Krzysztof\OneDrive\Dokumenty\PDSwR2-master\PseudoLog10\R)
roxygenise(package.dir = "C:\Users\Krzysztof\OneDrive\Dokumenty\PDSwR2-master\PseudoLog10\R")
roxygen2::roxygenise()
roxygen2::roxygenize()
setwd("~/PDSwR2-master/PseudoLog10/R")
roxygen2::roxygenise()
roxygen2::roxygenise()
roxygen2::roxygenise()
setwd("~/PDSwR2-master/PseudoLog10")
roxygen2::roxygenise()
roxygen2::roxygenise()
roxygen2::roxygenise()
roxygen2::roxygenise()
roxygen2::roxygenise()
roxygen2::roxygenise()
library('xlsx')
install.packages("xlsx")
library('xlsx')
setwd("C:/Users/Krzysztof/PDSwR2-master/PseudoLog10")
roxygen2::roxygenise(R/pseudoLog10.R)
roxygen2::roxygenise(pseudoLog10.R)
roxygen2::roxygenise(R)
roxygen2::roxygenise(pseudoLog10)
roxygen2::roxygenise(package.dir = "R")
roxygen2::roxygenise(package.dir = ".")
roxygen2::roxygenise(package.dir = ".")
roxygen2::roxygenise(package.dir = ".")
setwd("C:/Users/Krzysztof/OneDrive/Pulpit/Practical Data Science with R, 2nd Edition/PDSwR2-master")
setwd("C:/Users/Krzysztof/PDSwR2-master")
