Demo20170926
David Chiu
2017年9月26日
R Basic
a <- 3
b <- 2
a + b## [1] 5data()
data(iris)
class(iris)## [1] "data.frame"View(iris)
str(iris)## 'data.frame': 150 obs. of 5 variables:
## $ Sepal.Length: num 5.1 4.9 4.7 4.6 5 5.4 4.6 5 4.4 4.9 ...
## $ Sepal.Width : num 3.5 3 3.2 3.1 3.6 3.9 3.4 3.4 2.9 3.1 ...
## $ Petal.Length: num 1.4 1.4 1.3 1.5 1.4 1.7 1.4 1.5 1.4 1.5 ...
## $ Petal.Width : num 0.2 0.2 0.2 0.2 0.2 0.4 0.3 0.2 0.2 0.1 ...
## $ Species : Factor w/ 3 levels "setosa","versicolor",..: 1 1 1 1 1 1 1 1 1 1 ...summary(iris)## Sepal.Length Sepal.Width Petal.Length Petal.Width
## Min. :4.300 Min. :2.000 Min. :1.000 Min. :0.100
## 1st Qu.:5.100 1st Qu.:2.800 1st Qu.:1.600 1st Qu.:0.300
## Median :5.800 Median :3.000 Median :4.350 Median :1.300
## Mean :5.843 Mean :3.057 Mean :3.758 Mean :1.199
## 3rd Qu.:6.400 3rd Qu.:3.300 3rd Qu.:5.100 3rd Qu.:1.800
## Max. :7.900 Max. :4.400 Max. :6.900 Max. :2.500
## Species
## setosa :50
## versicolor:50
## virginica :50
##
##
## head(iris)## Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1 5.1 3.5 1.4 0.2 setosa
## 2 4.9 3.0 1.4 0.2 setosa
## 3 4.7 3.2 1.3 0.2 setosa
## 4 4.6 3.1 1.5 0.2 setosa
## 5 5.0 3.6 1.4 0.2 setosa
## 6 5.4 3.9 1.7 0.4 setosahead(iris, 10)## Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1 5.1 3.5 1.4 0.2 setosa
## 2 4.9 3.0 1.4 0.2 setosa
## 3 4.7 3.2 1.3 0.2 setosa
## 4 4.6 3.1 1.5 0.2 setosa
## 5 5.0 3.6 1.4 0.2 setosa
## 6 5.4 3.9 1.7 0.4 setosa
## 7 4.6 3.4 1.4 0.3 setosa
## 8 5.0 3.4 1.5 0.2 setosa
## 9 4.4 2.9 1.4 0.2 setosa
## 10 4.9 3.1 1.5 0.1 setosahelp(head)## starting httpd help server ... done?head
tail(iris)## Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 145 6.7 3.3 5.7 2.5 virginica
## 146 6.7 3.0 5.2 2.3 virginica
## 147 6.3 2.5 5.0 1.9 virginica
## 148 6.5 3.0 5.2 2.0 virginica
## 149 6.2 3.4 5.4 2.3 virginica
## 150 5.9 3.0 5.1 1.8 virginicaDataFrame
iris[ 1 , ]## Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1 5.1 3.5 1.4 0.2 setosairis[c(1,2,3), ]## Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1 5.1 3.5 1.4 0.2 setosa
## 2 4.9 3.0 1.4 0.2 setosa
## 3 4.7 3.2 1.3 0.2 setosairis[1:3 , ]## Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1 5.1 3.5 1.4 0.2 setosa
## 2 4.9 3.0 1.4 0.2 setosa
## 3 4.7 3.2 1.3 0.2 setosairis[1:3 , 1 ]## [1] 5.1 4.9 4.7iris[1:3 , c(1,2) ]## Sepal.Length Sepal.Width
## 1 5.1 3.5
## 2 4.9 3.0
## 3 4.7 3.2iris[1:3 , 1:2 ]## Sepal.Length Sepal.Width
## 1 5.1 3.5
## 2 4.9 3.0
## 3 4.7 3.2iris[1:3 ,c('Sepal.Length', 'Sepal.Width')]## Sepal.Length Sepal.Width
## 1 5.1 3.5
## 2 4.9 3.0
## 3 4.7 3.2head(iris$Sepal.Length)## [1] 5.1 4.9 4.7 4.6 5.0 5.4filter.cond <- iris$Species == 'setosa'
head(iris[filter.cond , ])## Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1 5.1 3.5 1.4 0.2 setosa
## 2 4.9 3.0 1.4 0.2 setosa
## 3 4.7 3.2 1.3 0.2 setosa
## 4 4.6 3.1 1.5 0.2 setosa
## 5 5.0 3.6 1.4 0.2 setosa
## 6 5.4 3.9 1.7 0.4 setosa# & => AND, | => OR
filter.cond2 <- (iris$Species == 'setosa') & (iris$Sepal.Length >= 5)
head(iris[filter.cond2, c('Sepal.Length', 'Species')])## Sepal.Length Species
## 1 5.1 setosa
## 5 5.0 setosa
## 6 5.4 setosa
## 8 5.0 setosa
## 11 5.4 setosa
## 15 5.8 setosaheight <- 180
heights <- c(180, 178, 162, 175, 168)
sort(heights)## [1] 162 168 175 178 180sort(heights, decreasing = TRUE)## [1] 180 178 175 168 162order(heights)## [1] 3 5 4 2 1order(heights, decreasing = TRUE)## [1] 1 2 4 5 3head(sort(iris$Sepal.Length))## [1] 4.3 4.4 4.4 4.4 4.5 4.6head(sort(iris$Sepal.Length, decreasing = TRUE))## [1] 7.9 7.7 7.7 7.7 7.7 7.6rank <- order(iris$Sepal.Length, decreasing = TRUE)
head(iris[ rank , ])## Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 132 7.9 3.8 6.4 2.0 virginica
## 118 7.7 3.8 6.7 2.2 virginica
## 119 7.7 2.6 6.9 2.3 virginica
## 123 7.7 2.8 6.7 2.0 virginica
## 136 7.7 3.0 6.1 2.3 virginica
## 106 7.6 3.0 6.6 2.1 virginicarank2 <- order(iris$Sepal.Length)
head(iris[ rank2 , c('Species') ])## [1] setosa setosa setosa setosa setosa setosa
## Levels: setosa versicolor virginica資料繪圖
data("anscombe")
View(anscombe)
plot(y1 ~ x1, data = anscombe)
plot(y2 ~ x1, data = anscombe)
plot(y3 ~ x1, data = anscombe)
plot(y4 ~ x1, data = anscombe)
tb <- table(iris$Species)
tb##
## setosa versicolor virginica
## 50 50 50pie(tb)
barplot(tb, col="blue")
hist(iris$Sepal.Length)
boxplot(iris$Sepal.Length)
boxplot(iris$Petal.Length~ iris$Species)
plot(iris$Petal.Length, iris$Petal.Width)
plot(iris$Petal.Length, iris$Petal.Width, col=iris$Species)
資料探索
#download.file('https://raw.githubusercontent.com/ywchiu/cathayr/master/data/lvr_prices.csv', 'lvr_prices.csv')
getwd()## [1] "D:/OS DATA/Desktop"library(readr)
lvr_prices <- read_csv("D:/OS DATA/Desktop/lvr_prices.csv")## Warning: Missing column names filled in: 'X1' [1]## Parsed with column specification:
## cols(
## .default = col_character(),
## X1 = col_integer(),
## land_sqmeter = col_double(),
## trading_ymd = col_date(format = ""),
## finish_ymd = col_date(format = ""),
## building_sqmeter = col_double(),
## room = col_integer(),
## living_room = col_integer(),
## bath = col_integer(),
## total_price = col_integer(),
## price_per_sqmeter = col_double(),
## parking_sqmeter = col_double(),
## parking_price = col_integer()
## )## See spec(...) for full column specifications.## Warning in rbind(names(probs), probs_f): number of columns of result is not
## a multiple of vector length (arg 1)## Warning: 32 parsing failures.
## row # A tibble: 5 x 5 col row col expected actual expected <int> <chr> <chr> <chr> actual 1 1282 total_price an integer 6700000000 file 2 2243 total_price an integer 3882685600 row 3 2244 total_price an integer 3373314400 col 4 4629 total_price an integer 3050000000 expected 5 5890 total_price an integer 3133800000 actual # ... with 1 more variables: file <chr>
## ... ................. ... ......................................... ........ ......................................... ...... ......................................... .... ......................................... ... ......................................... ... ......................................... ........ ......................................... ...... .......................................
## See problems(...) for more details.#View(lvr_prices)
class(lvr_prices)## [1] "tbl_df" "tbl" "data.frame"str(lvr_prices)## Classes 'tbl_df', 'tbl' and 'data.frame': 102054 obs. of 29 variables:
## $ X1 : int 0 1 2 3 4 5 6 7 8 9 ...
## $ area : chr "大安區" "中正區" "大同區" "大同區" ...
## $ trading_target : chr "房地(土地+建物)" "房地(土地+建物)" "土地" "房地(土地+建物)" ...
## $ address : chr "臺北市大安區和平東路三段1巷72弄1~30號" "臺北市中正區忠孝東路二段121~150號" "橋北段二小段601~630地號" "臺北市大同區重慶北路一段61~90號" ...
## $ land_sqmeter : num 19.39 8.46 5.5 3.88 32.41 ...
## $ city_land_type : chr "住" "商" "其他" "商" ...
## $ non_city_land_type: chr NA NA NA NA ...
## $ non_city_code : chr NA NA NA NA ...
## $ trading_ymd : Date, format: "2012-06-29" "2012-07-18" ...
## $ trading_num : chr "土地1建物2車位0" "土地3建物1車位0" "土地1建物0車位0" "土地4建物1車位0" ...
## $ floor : chr "五層" "九層" NA "六層" ...
## $ total_floor : chr "十七層" "十二層" NA "十一層" ...
## $ building_type : chr "住宅大樓(11層含以上有電梯)" "辦公商業大樓" "其他" "住宅大樓(11層含以上有電梯)" ...
## $ main_purpose : chr "國民住宅" "商業用" NA "商業用" ...
## $ built_with : chr "鋼筋混凝土造" "鋼筋混凝土造" NA "鋼筋混凝土造" ...
## $ finish_ymd : Date, format: "1985-05-22" "1982-04-08" ...
## $ building_sqmeter : num 101 93.4 0 36.7 104.1 ...
## $ room : int 3 0 0 1 3 0 0 3 2 3 ...
## $ living_room : int 2 0 0 1 1 0 0 2 1 2 ...
## $ bath : int 1 0 0 1 1 0 0 2 1 2 ...
## $ compartment : chr "有" "有" "有" "有" ...
## $ management : chr "有" "有" "無" "有" ...
## $ total_price : int 18680000 20300000 132096 4200000 14000000 255000 50000 25800000 19000000 28000000 ...
## $ price_per_sqmeter : num 184999 217307 24017 114317 134473 ...
## $ parking_type : chr NA NA NA NA ...
## $ parking_sqmeter : num 0 0 0 0 0 0 0 0 0 0 ...
## $ parking_price : int 0 0 0 0 0 0 0 0 0 0 ...
## $ comments : chr NA NA NA NA ...
## $ numbers : chr "RPQNMLSJQHHFFFA08CA" "RPQOMLKLQHHFFBA17CA" "RPUNMLLMQHHFFBA67CA" "RPOPMLRKJHIFFBA07CA" ...
## - attr(*, "problems")=Classes 'tbl_df', 'tbl' and 'data.frame': 32 obs. of 5 variables:
## ..$ row : int 1282 2243 2244 4629 5890 7153 7522 9777 10596 10714 ...
## ..$ col : chr "total_price" "total_price" "total_price" "total_price" ...
## ..$ expected: chr "an integer" "an integer" "an integer" "an integer" ...
## ..$ actual : chr "6700000000" "3882685600" "3373314400" "3050000000" ...
## ..$ file : chr "'D:/OS DATA/Desktop/lvr_prices.csv'" "'D:/OS DATA/Desktop/lvr_prices.csv'" "'D:/OS DATA/Desktop/lvr_prices.csv'" "'D:/OS DATA/Desktop/lvr_prices.csv'" ...
## - attr(*, "spec")=List of 2
## ..$ cols :List of 29
## .. ..$ X1 : list()
## .. .. ..- attr(*, "class")= chr "collector_integer" "collector"
## .. ..$ area : list()
## .. .. ..- attr(*, "class")= chr "collector_character" "collector"
## .. ..$ trading_target : list()
## .. .. ..- attr(*, "class")= chr "collector_character" "collector"
## .. ..$ address : list()
## .. .. ..- attr(*, "class")= chr "collector_character" "collector"
## .. ..$ land_sqmeter : list()
## .. .. ..- attr(*, "class")= chr "collector_double" "collector"
## .. ..$ city_land_type : list()
## .. .. ..- attr(*, "class")= chr "collector_character" "collector"
## .. ..$ non_city_land_type: list()
## .. .. ..- attr(*, "class")= chr "collector_character" "collector"
## .. ..$ non_city_code : list()
## .. .. ..- attr(*, "class")= chr "collector_character" "collector"
## .. ..$ trading_ymd :List of 1
## .. .. ..$ format: chr ""
## .. .. ..- attr(*, "class")= chr "collector_date" "collector"
## .. ..$ trading_num : list()
## .. .. ..- attr(*, "class")= chr "collector_character" "collector"
## .. ..$ floor : list()
## .. .. ..- attr(*, "class")= chr "collector_character" "collector"
## .. ..$ total_floor : list()
## .. .. ..- attr(*, "class")= chr "collector_character" "collector"
## .. ..$ building_type : list()
## .. .. ..- attr(*, "class")= chr "collector_character" "collector"
## .. ..$ main_purpose : list()
## .. .. ..- attr(*, "class")= chr "collector_character" "collector"
## .. ..$ built_with : list()
## .. .. ..- attr(*, "class")= chr "collector_character" "collector"
## .. ..$ finish_ymd :List of 1
## .. .. ..$ format: chr ""
## .. .. ..- attr(*, "class")= chr "collector_date" "collector"
## .. ..$ building_sqmeter : list()
## .. .. ..- attr(*, "class")= chr "collector_double" "collector"
## .. ..$ room : list()
## .. .. ..- attr(*, "class")= chr "collector_integer" "collector"
## .. ..$ living_room : list()
## .. .. ..- attr(*, "class")= chr "collector_integer" "collector"
## .. ..$ bath : list()
## .. .. ..- attr(*, "class")= chr "collector_integer" "collector"
## .. ..$ compartment : list()
## .. .. ..- attr(*, "class")= chr "collector_character" "collector"
## .. ..$ management : list()
## .. .. ..- attr(*, "class")= chr "collector_character" "collector"
## .. ..$ total_price : list()
## .. .. ..- attr(*, "class")= chr "collector_integer" "collector"
## .. ..$ price_per_sqmeter : list()
## .. .. ..- attr(*, "class")= chr "collector_double" "collector"
## .. ..$ parking_type : list()
## .. .. ..- attr(*, "class")= chr "collector_character" "collector"
## .. ..$ parking_sqmeter : list()
## .. .. ..- attr(*, "class")= chr "collector_double" "collector"
## .. ..$ parking_price : list()
## .. .. ..- attr(*, "class")= chr "collector_integer" "collector"
## .. ..$ comments : list()
## .. .. ..- attr(*, "class")= chr "collector_character" "collector"
## .. ..$ numbers : list()
## .. .. ..- attr(*, "class")= chr "collector_character" "collector"
## ..$ default: list()
## .. ..- attr(*, "class")= chr "collector_guess" "collector"
## ..- attr(*, "class")= chr "col_spec"summary(lvr_prices)## X1 area trading_target address
## Min. : 0 Length:102054 Length:102054 Length:102054
## 1st Qu.:1649 Class :character Class :character Class :character
## Median :3363 Mode :character Mode :character Mode :character
## Mean :3539
## 3rd Qu.:5188
## Max. :9683
##
## land_sqmeter city_land_type non_city_land_type
## Min. : 0.00 Length:102054 Length:102054
## 1st Qu.: 9.33 Class :character Class :character
## Median : 22.13 Mode :character Mode :character
## Mean : 54.32
## 3rd Qu.: 35.73
## Max. :46193.00
##
## non_city_code trading_ymd trading_num
## Length:102054 Min. :1973-08-29 Length:102054
## Class :character 1st Qu.:2013-04-17 Class :character
## Mode :character Median :2014-01-02 Mode :character
## Mean :2014-02-11
## 3rd Qu.:2014-12-29
## Max. :2016-05-16
## NA's :20
## floor total_floor building_type
## Length:102054 Length:102054 Length:102054
## Class :character Class :character Class :character
## Mode :character Mode :character Mode :character
##
##
##
##
## main_purpose built_with finish_ymd
## Length:102054 Length:102054 Min. :1911-05-06
## Class :character Class :character 1st Qu.:1983-03-30
## Mode :character Mode :character Median :1997-01-20
## Mean :1996-04-21
## 3rd Qu.:2010-03-01
## Max. :2016-03-11
## NA's :21992
## building_sqmeter room living_room bath
## Min. : 0.00 Min. : 0.000 Min. : 0.000 Min. : 0.000
## 1st Qu.: 43.45 1st Qu.: 0.000 1st Qu.: 0.000 1st Qu.: 1.000
## Median : 90.79 Median : 2.000 Median : 1.000 Median : 1.000
## Mean : 124.51 Mean : 1.938 Mean : 1.208 Mean : 1.248
## 3rd Qu.: 144.22 3rd Qu.: 3.000 3rd Qu.: 2.000 3rd Qu.: 2.000
## Max. :69125.53 Max. :168.000 Max. :80.000 Max. :174.000
##
## compartment management total_price
## Length:102054 Length:102054 Min. :0.000e+00
## Class :character Class :character 1st Qu.:7.500e+06
## Mode :character Mode :character Median :1.450e+07
## Mean :2.399e+07
## 3rd Qu.:2.615e+07
## Max. :2.029e+09
## NA's :32
## price_per_sqmeter parking_type parking_sqmeter
## Min. : 0 Length:102054 Min. :0.00e+00
## 1st Qu.: 120832 Class :character 1st Qu.:0.00e+00
## Median : 166859 Mode :character Median :0.00e+00
## Mean : 184978 Mean :2.54e+01
## 3rd Qu.: 222266 3rd Qu.:0.00e+00
## Max. :62685714 Max. :1.45e+06
## NA's :5199
## parking_price comments numbers
## Min. : 0 Length:102054 Length:102054
## 1st Qu.: 0 Class :character Class :character
## Median : 0 Mode :character Mode :character
## Mean : 488509
## 3rd Qu.: 0
## Max. :240000000
## head(lvr_prices, 10)## # A tibble: 10 x 29
## X1 area trading_target address
## <int> <chr> <chr> <chr>
## 1 0 大安區 房地(土地+建物) 臺北市大安區和平東路三段1巷72弄1~30號
## 2 1 中正區 房地(土地+建物) 臺北市中正區忠孝東路二段121~150號
## 3 2 大同區 土地 橋北段二小段601~630地號
## 4 3 大同區 房地(土地+建物) 臺北市大同區重慶北路一段61~90號
## 5 4 內湖區 房地(土地+建物) 臺北市內湖區民權東路六段90巷6弄1~30號
## 6 5 信義區 土地 福德段一小段661~690地號
## 7 6 松山區 土地 寶清段一小段31~60地號
## 8 7 松山區 房地(土地+建物) 臺北市松山區三民路68巷1~30號
## 9 8 士林區 房地(土地+建物) 臺北市士林區承德路四段10巷1~30號
## 10 9 大安區 房地(土地+建物) 臺北市大安區敦化南路一段270巷1~30號
## # ... with 25 more variables: land_sqmeter <dbl>, city_land_type <chr>,
## # non_city_land_type <chr>, non_city_code <chr>, trading_ymd <date>,
## # trading_num <chr>, floor <chr>, total_floor <chr>,
## # building_type <chr>, main_purpose <chr>, built_with <chr>,
## # finish_ymd <date>, building_sqmeter <dbl>, room <int>,
## # living_room <int>, bath <int>, compartment <chr>, management <chr>,
## # total_price <int>, price_per_sqmeter <dbl>, parking_type <chr>,
## # parking_sqmeter <dbl>, parking_price <int>, comments <chr>,
## # numbers <chr>184978 / 0.3025## [1] 611497.5filter.cond <- lvr_prices$area == '大安區'
daan <- lvr_prices[ filter.cond , ]
sum(as.numeric(daan$total_price), na.rm=TRUE)## [1] 2.79477e+11?sum
mean(as.numeric(daan$total_price), na.rm=TRUE)## [1] 29798170filter.cond3 <- (lvr_prices$area == '大安區') & (lvr_prices$trading_target == '房地(土地+建物)') & (lvr_prices$city_land_type == '住')
daan2 <- lvr_prices[ filter.cond3 , ]
mean(as.numeric(daan2$total_price), na.rm=TRUE)## [1] 26559742mean(as.numeric(daan2$price_per_sqmeter), na.rm=TRUE)## [1] 254814.4254814.4 / 0.3025## [1] 842361.7zhongshan <- lvr_prices[lvr_prices$area == '中山區' , c('total_price', 'address') ]
head(zhongshan)## # A tibble: 6 x 2
## total_price address
## <int> <chr>
## 1 5960000 臺北市中山區合江街31~60號
## 2 20200000 臺北市中山區中山北路二段183巷1~30號
## 3 4050000 臺北市中山區吉林路361~390號
## 4 1900000 長安段三小段271~300地號
## 5 14800000 臺北市中山區林森北路485巷1~30號
## 6 10200000 臺北市中山區建國北路三段93巷5弄1~30號res <- zhongshan[order(zhongshan$total_price, decreasing = TRUE), ]
res[1:3, ]## # A tibble: 3 x 2
## total_price address
## <int> <chr>
## 1 1850000000 臺北市中山區建國北路一段138巷1~30號
## 2 1400000000 臺北市中山區南京東路三段1~30號
## 3 1084948034 中山段二小段31~60地號getTopThree <- function(area){
zhongshan <- lvr_prices[lvr_prices$area == area , c('total_price', 'address') ]
res <- zhongshan[order(zhongshan$total_price, decreasing = TRUE), ]
return(res[1:3, ])
}
getTopThree('大安區')## # A tibble: 3 x 2
## total_price address
## <int> <chr>
## 1 1869781219 臺北市大安區羅斯福路三段283巷4弄1~30號
## 2 971340000 臺北市大安區忠孝東路四段241~270號
## 3 966660000 學府段三小段31~60地號getTopThree('文山區')## # A tibble: 3 x 2
## total_price address
## <int> <chr>
## 1 1550000000 景美段四小段601~630地號
## 2 836350000 萬芳段二小段241~270地號
## 3 581500000 興安段四小段271~300地號a <- c(2,3,5,7,1)
b <- c(1,1,2,2,2)
tapply(a, b ,sum)## 1 2
## 5 13price_per_sec <- tapply(lvr_prices$total_price, lvr_prices$area, function(e) mean(e, na.rm=TRUE))
sort(price_per_sec, decreasing = TRUE)## 中正區 大安區 內湖區 中山區 松山區 南港區 信義區 士林區
## 30154011 29798170 27905514 26708805 25652125 25235793 24725051 24139903
## 北投區 大同區 文山區 萬華區
## 20626410 18063872 16953869 13642289barplot(price_per_sec)
barplot(sort(price_per_sec, decreasing = TRUE), xlab = '區域', ylab = '平均價格', main = '各區平均房價', col = 'blue')
a <- c(10,20,30,40,50,60,70)
# get average
sum(a)/ length(a)## [1] 40mean(a)## [1] 40#median
median(a)## [1] 40a <- c(1, 10,20,30,40,50,60,70,800)
mean(a)## [1] 120.1111median(a)## [1] 40quantile(a, 0.25)## 25%
## 20quantile(a, 0.75)## 75%
## 60IQR(a)## [1] 40max(1, median(a) - 1.5 * IQR(a))## [1] 1min(800, median(a) + 1.5 * IQR(a))## [1] 100boxplot(a)
a <- c(1, 10,20,30,40,50,60,70,80)
boxplot(a)
boxplot(total_price ~ area, data = lvr_prices)## Warning in x[floor(d)] + x[ceiling(d)]: 整數向上溢位產生了 NA## Warning in x[floor(d)] + x[ceiling(d)]: 整數向上溢位產生了 NA
## Warning in x[floor(d)] + x[ceiling(d)]: 整數向上溢位產生了 NA
## Warning in x[floor(d)] + x[ceiling(d)]: 整數向上溢位產生了 NA
## Warning in x[floor(d)] + x[ceiling(d)]: 整數向上溢位產生了 NA
## Warning in x[floor(d)] + x[ceiling(d)]: 整數向上溢位產生了 NA
## Warning in x[floor(d)] + x[ceiling(d)]: 整數向上溢位產生了 NA
## Warning in x[floor(d)] + x[ceiling(d)]: 整數向上溢位產生了 NA
## Warning in x[floor(d)] + x[ceiling(d)]: 整數向上溢位產生了 NA
boxplot(log(total_price) ~ area, data = lvr_prices, main= "房價箱型圖", xlab = "區域", ylab = "價格(log)")## Warning in bplt(at[i], wid = width[i], stats = z$stats[, i], out = z$out[z
## $group == : Outlier (-Inf) in boxplot 1 is not drawn## Warning in bplt(at[i], wid = width[i], stats = z$stats[, i], out = z$out[z
## $group == : Outlier (-Inf) in boxplot 2 is not drawn## Warning in bplt(at[i], wid = width[i], stats = z$stats[, i], out = z$out[z
## $group == : Outlier (-Inf) in boxplot 3 is not drawn## Warning in bplt(at[i], wid = width[i], stats = z$stats[, i], out = z$out[z
## $group == : Outlier (-Inf) in boxplot 4 is not drawn## Warning in bplt(at[i], wid = width[i], stats = z$stats[, i], out = z$out[z
## $group == : Outlier (-Inf) in boxplot 6 is not drawn
## DPLYR
# install.packages('dplyr')
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union# R Style Filter
head(lvr_prices[lvr_prices$area == '中山區',])## # A tibble: 6 x 29
## X1 area trading_target address
## <int> <chr> <chr> <chr>
## 1 13 中山區 房地(土地+建物) 臺北市中山區合江街31~60號
## 2 14 中山區 房地(土地+建物) 臺北市中山區中山北路二段183巷1~30號
## 3 16 中山區 房地(土地+建物) 臺北市中山區吉林路361~390號
## 4 17 中山區 土地 長安段三小段271~300地號
## 5 24 中山區 房地(土地+建物) 臺北市中山區林森北路485巷1~30號
## 6 39 中山區 房地(土地+建物) 臺北市中山區建國北路三段93巷5弄1~30號
## # ... with 25 more variables: land_sqmeter <dbl>, city_land_type <chr>,
## # non_city_land_type <chr>, non_city_code <chr>, trading_ymd <date>,
## # trading_num <chr>, floor <chr>, total_floor <chr>,
## # building_type <chr>, main_purpose <chr>, built_with <chr>,
## # finish_ymd <date>, building_sqmeter <dbl>, room <int>,
## # living_room <int>, bath <int>, compartment <chr>, management <chr>,
## # total_price <int>, price_per_sqmeter <dbl>, parking_type <chr>,
## # parking_sqmeter <dbl>, parking_price <int>, comments <chr>,
## # numbers <chr># dplyr Style Filter
head(filter(lvr_prices, area == '中山區'))## # A tibble: 6 x 29
## X1 area trading_target address
## <int> <chr> <chr> <chr>
## 1 13 中山區 房地(土地+建物) 臺北市中山區合江街31~60號
## 2 14 中山區 房地(土地+建物) 臺北市中山區中山北路二段183巷1~30號
## 3 16 中山區 房地(土地+建物) 臺北市中山區吉林路361~390號
## 4 17 中山區 土地 長安段三小段271~300地號
## 5 24 中山區 房地(土地+建物) 臺北市中山區林森北路485巷1~30號
## 6 39 中山區 房地(土地+建物) 臺北市中山區建國北路三段93巷5弄1~30號
## # ... with 25 more variables: land_sqmeter <dbl>, city_land_type <chr>,
## # non_city_land_type <chr>, non_city_code <chr>, trading_ymd <date>,
## # trading_num <chr>, floor <chr>, total_floor <chr>,
## # building_type <chr>, main_purpose <chr>, built_with <chr>,
## # finish_ymd <date>, building_sqmeter <dbl>, room <int>,
## # living_room <int>, bath <int>, compartment <chr>, management <chr>,
## # total_price <int>, price_per_sqmeter <dbl>, parking_type <chr>,
## # parking_sqmeter <dbl>, parking_price <int>, comments <chr>,
## # numbers <chr># R Style Select
head(lvr_prices[, c('total_price')])## # A tibble: 6 x 1
## total_price
## <int>
## 1 18680000
## 2 20300000
## 3 132096
## 4 4200000
## 5 14000000
## 6 255000# dplyr Style Select
head(select(lvr_prices, total_price))## # A tibble: 6 x 1
## total_price
## <int>
## 1 18680000
## 2 20300000
## 3 132096
## 4 4200000
## 5 14000000
## 6 255000# R Style Data Manipulation
sum(tail(head(iris), 3)$Sepal.Length)## [1] 15# magrittr style data manipulation
iris %>% head() %>% tail(3) %>% .$Sepal.Length %>% sum()## [1] 15lvr_prices %>%
filter(area == '中山區') %>%
select(total_price, address) %>%
head()## # A tibble: 6 x 2
## total_price address
## <int> <chr>
## 1 5960000 臺北市中山區合江街31~60號
## 2 20200000 臺北市中山區中山北路二段183巷1~30號
## 3 4050000 臺北市中山區吉林路361~390號
## 4 1900000 長安段三小段271~300地號
## 5 14800000 臺北市中山區林森北路485巷1~30號
## 6 10200000 臺北市中山區建國北路三段93巷5弄1~30號lvr_prices %>%
filter(area == '中山區') %>%
select(total_price, address) %>%
arrange(total_price)%>%
head()## # A tibble: 6 x 2
## total_price address
## <int> <chr>
## 1 0 中山段一小段691~720地號
## 2 0 中山段一小段691~720地號
## 3 10860 榮星段四小段211~240地號
## 4 16000 中山段四小段211~240地號
## 5 18060 榮星段四小段211~240地號
## 6 21244 榮星段二小段361~390地號lvr_prices %>%
filter(area == '中山區') %>%
select(total_price, address) %>%
arrange(desc(total_price)) %>%
head()## # A tibble: 6 x 2
## total_price address
## <int> <chr>
## 1 1850000000 臺北市中山區建國北路一段138巷1~30號
## 2 1400000000 臺北市中山區南京東路三段1~30號
## 3 1084948034 中山段二小段31~60地號
## 4 1011136500 中山段三小段301~330地號
## 5 952875000 金泰段61~90地號
## 6 903865500 中山段一小段361~390地號help(package='dplyr')
lvr_prices$trading_ym <- as.Date(format(lvr_prices$trading_ymd, '%Y-%m-01'))
lvr_prices %>%
select(trading_ym) %>%
arrange(trading_ym) %>%
head()## # A tibble: 6 x 1
## trading_ym
## <date>
## 1 1973-08-01
## 2 1973-08-01
## 3 1973-08-01
## 4 1975-10-01
## 5 1989-03-01
## 6 1989-06-01lvr_stat <- lvr_prices %>%
select(area, trading_ym, total_price) %>%
filter(trading_ym >= '2012-01-01') %>%
group_by(area, trading_ym) %>%
summarise(overall_price = sum(as.numeric(total_price), na.rm = TRUE ))
lvr_stat$area <- as.factor(lvr_stat$area)
levels(lvr_stat$area)## [1] "士林區" "大同區" "大安區" "中山區" "中正區" "內湖區" "文山區"
## [8] "北投區" "松山區" "信義區" "南港區" "萬華區"par(mfrow= c(3,4))
for (a in levels(lvr_stat$area)){
plot(overall_price ~ trading_ym
,lvr_stat[lvr_stat$area == a,]
, type='l', main = a)
}
lvr_stat %>% head()## # A tibble: 6 x 3
## # Groups: area [1]
## area trading_ym overall_price
## <fctr> <date> <dbl>
## 1 士林區 2012-01-01 661140000
## 2 士林區 2012-02-01 231680000
## 3 士林區 2012-03-01 359891504
## 4 士林區 2012-04-01 205481036
## 5 士林區 2012-05-01 2539010528
## 6 士林區 2012-06-01 514470692Pivot Table
#install.packages('tidyr')
library(tidyr)
price_pivot <- spread(lvr_stat, trading_ym, overall_price, fill=0)
write.csv(price_pivot, 'taipei_house_price.csv')Classfication
#download.file('https://raw.githubusercontent.com/ywchiu/cathayr/master/data/Training50.csv', 'Training50.csv')
trainset <- read.csv('Training50.csv')
class(trainset)## [1] "data.frame"head(trainset)## X Creditability Account.Balance Duration.of.Credit..month.
## 1 497 1 3 6
## 2 756 0 1 15
## 3 580 0 1 42
## 4 833 0 3 36
## 5 602 1 3 24
## 6 734 1 1 15
## Payment.Status.of.Previous.Credit Purpose Credit.Amount
## 1 2 3 2108
## 2 1 4 950
## 3 2 3 7174
## 4 3 4 7980
## 5 3 2 2028
## 6 2 4 2511
## Value.Savings.Stocks Length.of.current.employment Instalment.per.cent
## 1 1 3 2
## 2 1 4 4
## 3 4 3 4
## 4 4 1 4
## 5 1 3 2
## 6 1 1 1
## Sex...Marital.Status Guarantors Duration.in.Current.address
## 1 3 1 2
## 2 2 1 3
## 3 1 1 3
## 4 2 1 4
## 5 2 1 2
## 6 1 1 4
## Most.valuable.available.asset Age..years. Concurrent.Credits
## 1 1 29 2
## 2 3 33 2
## 3 3 30 2
## 4 3 27 2
## 5 2 30 2
## 6 3 23 2
## Type.of.apartment No.of.Credits.at.this.Bank Occupation No.of.dependents
## 1 1 1 1 1
## 2 1 2 1 2
## 3 2 1 1 1
## 4 1 2 1 1
## 5 2 2 1 1
## 6 1 1 1 1
## Telephone Foreign.Worker
## 1 1 1
## 2 1 1
## 3 2 1
## 4 2 1
## 5 1 1
## 6 1 1# install.packages('rpart')
library(rpart)
trainset$X <- NULL
model <- rpart(Creditability ~ ., data = trainset, method = 'class')
#summary(model)
plot(model, margin = 0.1)
text(model)
#download.file('https://raw.githubusercontent.com/ywchiu/cathayr/master/data/Test50.csv', 'Test50.csv')
testset <- read.csv('Test50.csv')
testset$X <- NULL
head(predict(model, testset))## 0 1
## 1 0.2134831 0.7865169
## 2 0.2134831 0.7865169
## 3 0.8000000 0.2000000
## 4 0.2134831 0.7865169
## 5 0.2134831 0.7865169
## 6 0.2134831 0.7865169predicted <- predict(model, testset, type = 'class')
sum(predicted == testset$Creditability) / length(testset$Creditability)## [1] 0.71tb <- table(predicted, testset$Creditability)
TP <- tb[1]
FN <- tb[2]
FP <- tb[3]
TN <- tb[4]
(TP + TN) / (TP + TN + FP + FN)## [1] 0.71FPR <- FP / (FP + TN)
TPR <- TP / (TP + FN)Evaluation
# type = class, when probability is over 0.5
predicted <- predict(model, testset)
res <- ifelse(predicted[,2] >=0.5, 1, 0 )
table(res,testset$Creditability)##
## res 0 1
## 0 64 52
## 1 93 291predicted <- predict(model, testset)
res <- ifelse(predicted[,2] >=0.2, 1, 0 )
table(res,testset$Creditability)##
## res 0 1
## 0 19 16
## 1 138 327ROC Curve
predicted <- predict(model, testset, type = "prob")
roc_x <- c(0)
roc_y <- c(0)
for(i in seq(0,1,0.01)){
res <- as.factor(ifelse(predicted[,1] >= i, 0, 1))
tb <- table(testset$Creditability, res)
if (ncol(tb) == 2){
TP <- tb[1]
FN <- tb[2]
FP <- tb[3]
TN <- tb[4]
FPR <- FP / (FP + TN)
TPR <- TP / (TP + FN)
x <- FPR
y <- TPR
roc_x <- c(roc_x, x)
roc_y <- c(roc_y, y)
}
}
roc_x <- c(roc_x, 1)
roc_y <- c(roc_y, 1)
plot(roc_x, roc_y, type='b')
# install.packages('ROCR')
library(ROCR)## Loading required package: gplots##
## Attaching package: 'gplots'## The following object is masked from 'package:stats':
##
## lowesspredictions <- predict(model, testset, type="prob")
pred.to.roc <- predictions[, 2]
pred.rocr <- prediction(pred.to.roc, as.factor(testset$Creditability))
perf.rocr <- performance(pred.rocr, measure = "auc", x.measure = "cutoff")
perf.tpr.rocr <- performance(pred.rocr, "tpr","fpr")
plot(perf.tpr.rocr, colorize=T,main=paste("AUC:",(perf.rocr@y.values)))
## RadomForest
#install.pacakges('randomForest')
library(randomForest)## randomForest 4.6-12## Type rfNews() to see new features/changes/bug fixes.##
## Attaching package: 'randomForest'## The following object is masked from 'package:dplyr':
##
## combinetrainset$Creditability <- as.factor(trainset$Creditability)
testset $Creditability <- as.factor(testset$Creditability)
forest <- randomForest(Creditability~., data = trainset, ntree = 200, importance=T, proximity = T)
predicted <- predict(forest, testset, type = 'class')
table(predicted, testset$Creditability)##
## predicted 0 1
## 0 50 24
## 1 107 319predictions1 <- predict(model, testset, type="prob")
pred.to.roc1 <- predictions1[, 2]
pred.rocr1 <- prediction(pred.to.roc1, as.factor(testset$Creditability))
perf.rocr1 <- performance(pred.rocr1, measure = "auc", x.measure = "cutoff")
perf.tpr.rocr1 <- performance(pred.rocr1, "tpr","fpr")
predictions2 <- predict(forest, testset, type="prob")
pred.to.roc2 <- predictions2[, 2]
pred.rocr2 <- prediction(pred.to.roc2, as.factor(testset$Creditability))
perf.rocr2 <- performance(pred.rocr2, measure = "auc", x.measure = "cutoff")
perf.tpr.rocr2 <- performance(pred.rocr2, "tpr","fpr")
plot(perf.tpr.rocr1,main='ROC Curve', col=1)
legend(0.7, 0.2, c('rpart', 'randomforest'), 1:2)
plot(perf.tpr.rocr2, col=2, add=TRUE)
## Clustering
#download.file('https://raw.githubusercontent.com/ywchiu/cathayr/master/data/customers.csv', 'customers.csv')
customers <- read.csv('customers.csv')
class(customers)## [1] "data.frame"summary(customers)## CustomerID Genre Age Annual_Income
## Min. : 1.00 Female:112 Min. :18.00 Min. : 15.00
## 1st Qu.: 50.75 Male : 88 1st Qu.:28.75 1st Qu.: 41.50
## Median :100.50 Median :36.00 Median : 61.50
## Mean :100.50 Mean :38.85 Mean : 60.56
## 3rd Qu.:150.25 3rd Qu.:49.00 3rd Qu.: 78.00
## Max. :200.00 Max. :70.00 Max. :137.00
## Spending_Score
## Min. : 1.00
## 1st Qu.:34.75
## Median :50.00
## Mean :50.20
## 3rd Qu.:73.00
## Max. :99.00customers <- customers[ , c('Annual_Income', 'Spending_Score')]
set.seed(123)
kc <- kmeans(customers, 5)
kc$cluster## [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [36] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
## [71] 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3
## [106] 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 4 2 4 2 4 2 4 2 4 2 4 2 4 2 4 2 4
## [141] 2 4 3 4 2 4 2 4 2 4 2 4 2 4 2 4 2 4 2 4 2 4 2 4 2 4 2 4 2 4 2 4 2 4 2
## [176] 4 2 4 2 4 5 4 5 4 5 4 5 4 5 4 5 4 5 4 5 4 5 4 5 4set.seed(123)
sample.int(42,6)## [1] 13 33 17 35 36 2kc$centers## Annual_Income Spending_Score
## 1 27.40000 49.48000
## 2 79.00000 16.59259
## 3 55.90541 49.93243
## 4 86.53846 82.12821
## 5 109.70000 22.00000plot(customers$Annual_Income, customers$Spending_Score, col = kc$cluster)
points(kc$centers[,1], kc$centers[,2], col = "yellow")
silhouette
# install.packages('cluster')
library(cluster)
kcs = silhouette(kc$cluster,dist(customers))
summary(kcs)## Silhouette of 200 units in 5 clusters from silhouette.default(x = kc$cluster, dist = dist(customers)) :
## Cluster sizes and average silhouette widths:
## 50 27 74 39 10
## 0.04103987 0.47253618 0.63162169 0.48851396 0.35704613
## Individual silhouette widths:
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## -0.4401 0.2089 0.5292 0.4209 0.6421 0.7556plot(kcs)
# install.packages('fpc')
library(fpc)
nk <- 2:10
sapply(nk, function(e) e^2)## [1] 4 9 16 25 36 49 64 81 100nk <- 2:10
set.seed(123)
SW <- sapply(nk, function(k){
cluster.stats(dist(customers), kmeans(customers, centers=k)$cluster)$avg.silwidth
})
plot(nk, SW, type="l", xlab="number of clusers", ylab="average silhouette width")