7.3 加強基本圖表
library(ggplot2)
# Load our data, which lives in intl.csv
intl = read.csv("data/intl.csv")
str(intl)
'data.frame': 8 obs. of 2 variables:
$ Region : Factor w/ 8 levels "Africa","Asia",..: 2 3 6 4 5 1 7 8
$ PercentOfIntl: num 0.531 0.201 0.098 0.09 0.054 0.02 0.015 0.002
7.3.1 Bar Plot with Quantities
# We want to make a bar plot with region on the X axis
# and Percentage on the y-axis.
ggplot(intl, aes(x=Region, y=PercentOfIntl)) +
geom_bar(stat="identity") +
geom_text(aes(label=PercentOfIntl))

7.3.2 Reorder by Column
# Make Region an ordered factor
# We can do this with the re-order command and transform command.
intl = transform(intl, Region = reorder(Region, -PercentOfIntl))
# Make the percentages out of 100 instead of fractions
intl$PercentOfIntl = intl$PercentOfIntl * 100
# Make the plot
ggplot(intl, aes(x=Region, y=PercentOfIntl)) +
geom_bar(stat="identity", fill="dark blue") +
geom_text(aes(label=PercentOfIntl), vjust=-0.4) +
ylab("Percent of International Students") +
theme(axis.title.x = element_blank(),
axis.text.x = element_text(angle = 45, hjust = 1))

7.3 全球國際學生數量
7.3.3 Data for Intl’ Students
library(ggmap)
# Load in the international student data
intlall = read.csv("data/intlall.csv",stringsAsFactors=FALSE)
# Lets look at the first few rows
# head(intlall)
# Those NAs are really 0s, and we can replace them easily
intlall[is.na(intlall)] = 0
# Now lets look again
head(intlall)
Citizenship UG G SpecialUG SpecialG ExhangeVisiting
1 Albania 3 1 0 0 0
2 Antigua and Barbuda 0 0 0 1 0
3 Argentina 0 19 0 0 0
4 Armenia 3 2 0 0 0
5 Australia 6 32 0 0 1
6 Austria 0 11 0 0 5
Total
1 4
2 1
3 19
4 5
5 39
6 16
7.3.4 World Map
# Load the world map
world_map = map_data("world")
str(world_map)
'data.frame': 99338 obs. of 6 variables:
$ long : num -69.9 -69.9 -69.9 -70 -70.1 ...
$ lat : num 12.5 12.4 12.4 12.5 12.5 ...
$ group : num 1 1 1 1 1 1 1 1 1 1 ...
$ order : int 1 2 3 4 5 6 7 8 9 10 ...
$ region : chr "Aruba" "Aruba" "Aruba" "Aruba" ...
$ subregion: chr NA NA NA NA ...
7.3.5 Merge Map with Data
# Lets merge intlall into world_map using the merge command
world_map = merge(world_map, intlall, by.x ="region", by.y = "Citizenship") #merge完之後obs變少,X對不到的就丟掉
str(world_map)
'data.frame': 63634 obs. of 12 variables:
$ region : chr "Albania" "Albania" "Albania" "Albania" ...
$ long : num 20.5 20.4 19.5 20.5 20.4 ...
$ lat : num 41.3 39.8 42.5 40.1 41.5 ...
$ group : num 6 6 6 6 6 6 6 6 6 6 ...
$ order : int 789 822 870 815 786 821 818 779 879 795 ...
$ subregion : chr NA NA NA NA ...
$ UG : num 3 3 3 3 3 3 3 3 3 3 ...
$ G : num 1 1 1 1 1 1 1 1 1 1 ...
$ SpecialUG : num 0 0 0 0 0 0 0 0 0 0 ...
$ SpecialG : num 0 0 0 0 0 0 0 0 0 0 ...
$ ExhangeVisiting: num 0 0 0 0 0 0 0 0 0 0 ...
$ Total : int 4 4 4 4 4 4 4 4 4 4 ...
7.3.6 Plot the Map
ggplot(world_map, aes(x=long, y=lat, group=group)) +
geom_polygon(fill="white", color="black") +
coord_map("mercator")

7.3.7 Polygon points need to be ordered by Group
# Reorder the data
world_map = world_map[order(world_map$group, world_map$order),]
# Redo the plot
ggplot(world_map, aes(x=long, y=lat, group=group)) +
geom_polygon(fill="white", color="black")

# + coord_map("mercator")
7.3.8 Identify and Fix Mismatchs between Map and Data
# Lets look for China
grep("China", intlall$Citizenship, ignore.case=T, value=T) #搜尋有China這個詞的,大小寫不管
[1] "China (People's Republic Of)"
grep("China", unique(map_data("world")$region), ignore.case=T, value=T)
[1] "China"
# Lets "fix" that in the intlall dataset
intlall$Citizenship[intlall$Citizenship=="China (People's Republic Of)"] =
"China"
# We'll repeat our merge and order from before
world_map = merge(map_data("world"), intlall,
by.x ="region",
by.y = "Citizenship")
world_map = world_map[order(world_map$group, world_map$order),]
ggplot(world_map, aes(x=long, y=lat, group=group)) +
geom_polygon(aes(fill=Total), color="black") #+

#coord_map("mercator")
7.3.9 Different Orientations
# We can try other projections - this one is visually interesting
ggplot(world_map, aes(x=long, y=lat, group=group)) +
geom_polygon(aes(fill=Total), color="black") +
coord_map("ortho", orientation=c(20, 30, 0))

ggplot(world_map, aes(x=long, y=lat, group=group)) +
geom_polygon(aes(fill=Total), color="black") +
coord_map("ortho", orientation=c(-37, 175, 0))

7.3 資料結構轉換
7.3.10 Reshaping before Ploting
library(ggplot2)
library(reshape2)
# Now lets load our dataframe
households = read.csv("data/households.csv")
str(households)
'data.frame': 8 obs. of 7 variables:
$ Year : int 1970 1980 1990 1995 2000 2005 2010 2012
$ MarriedWChild : num 40.3 30.9 26.3 25.5 24.1 22.9 20.9 19.6
$ MarriedWOChild: num 30.3 29.9 29.8 28.9 28.7 28.3 28.8 29.1
$ OtherFamily : num 10.6 12.9 14.8 15.6 16 16.7 17.4 17.8
$ MenAlone : num 5.6 8.6 9.7 10.2 10.7 11.3 11.9 12.3
$ WomenAlone : num 11.5 14 14.9 14.7 14.8 15.3 14.8 15.2
$ OtherNonfamily: num 1.7 3.6 4.6 5 5.7 5.6 6.2 6.1
# Plot it
melt(households, id="Year") %>%
ggplot(aes(x=Year, y=value, color=variable)) +
geom_line(size=2) + geom_point(size=5) +
ylab("Percentage of Households")

LS0tDQp0aXRsZTogIkFTNy0wQyDkuJbnlYzlnLDlnJYiDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KDQo8YnI+DQoNCmBgYHtyIGVjaG89VCwgbWVzc2FnZT1GLCBjYWNoZT1GLCB3YXJuaW5nPUZ9DQpybShsaXN0PWxzKGFsbD1UKSkNCm9wdGlvbnMoZGlnaXRzPTQsIHNjaXBlbj0xMikNCmxpYnJhcnkoZHBseXIpDQpsaWJyYXJ5KGdncGxvdDIpDQpsaWJyYXJ5KG1hcHMpDQpsaWJyYXJ5KGdnbWFwKQ0KbGlicmFyeShyZXNoYXBlMikNCmBgYA0KDQotIC0gLQ0KDQojIyMgNy4zIOWKoOW8t+WfuuacrOWcluihqA0KDQpgYGB7cn0NCmxpYnJhcnkoZ2dwbG90MikNCg0KIyBMb2FkIG91ciBkYXRhLCB3aGljaCBsaXZlcyBpbiBpbnRsLmNzdg0KaW50bCA9IHJlYWQuY3N2KCJkYXRhL2ludGwuY3N2IikNCnN0cihpbnRsKQ0KYGBgDQoNCiMjIyMjIDcuMy4xIEJhciBQbG90IHdpdGggUXVhbnRpdGllcw0KYGBge3J9DQojIFdlIHdhbnQgdG8gbWFrZSBhIGJhciBwbG90IHdpdGggcmVnaW9uIG9uIHRoZSBYIGF4aXMNCiMgYW5kIFBlcmNlbnRhZ2Ugb24gdGhlIHktYXhpcy4NCmdncGxvdChpbnRsLCBhZXMoeD1SZWdpb24sIHk9UGVyY2VudE9mSW50bCkpICsNCiAgZ2VvbV9iYXIoc3RhdD0iaWRlbnRpdHkiKSArDQogIGdlb21fdGV4dChhZXMobGFiZWw9UGVyY2VudE9mSW50bCkpDQpgYGANCg0KIyMjIyMgNy4zLjIgUmVvcmRlciBieSBDb2x1bW4NCmBgYHtyfQ0KIyBNYWtlIFJlZ2lvbiBhbiBvcmRlcmVkIGZhY3Rvcg0KIyBXZSBjYW4gZG8gdGhpcyB3aXRoIHRoZSByZS1vcmRlciBjb21tYW5kIGFuZCB0cmFuc2Zvcm0gY29tbWFuZC4gDQppbnRsID0gdHJhbnNmb3JtKGludGwsIFJlZ2lvbiA9IHJlb3JkZXIoUmVnaW9uLCAtUGVyY2VudE9mSW50bCkpDQoNCiMgTWFrZSB0aGUgcGVyY2VudGFnZXMgb3V0IG9mIDEwMCBpbnN0ZWFkIG9mIGZyYWN0aW9ucw0KaW50bCRQZXJjZW50T2ZJbnRsID0gaW50bCRQZXJjZW50T2ZJbnRsICogMTAwDQoNCiMgTWFrZSB0aGUgcGxvdA0KZ2dwbG90KGludGwsIGFlcyh4PVJlZ2lvbiwgeT1QZXJjZW50T2ZJbnRsKSkgKw0KICBnZW9tX2JhcihzdGF0PSJpZGVudGl0eSIsIGZpbGw9ImRhcmsgYmx1ZSIpICsNCiAgZ2VvbV90ZXh0KGFlcyhsYWJlbD1QZXJjZW50T2ZJbnRsKSwgdmp1c3Q9LTAuNCkgKw0KICB5bGFiKCJQZXJjZW50IG9mIEludGVybmF0aW9uYWwgU3R1ZGVudHMiKSArDQogIHRoZW1lKGF4aXMudGl0bGUueCA9IGVsZW1lbnRfYmxhbmsoKSwgDQogICAgICAgIGF4aXMudGV4dC54ID0gZWxlbWVudF90ZXh0KGFuZ2xlID0gNDUsIGhqdXN0ID0gMSkpDQpgYGANCjxicj4NCg0KLSAtIC0NCg0KIyMjIDcuMyDlhajnkIPlnIvpmpvlrbjnlJ/mlbjph48NCg0KIyMjIyMgNy4zLjMgRGF0YSBmb3IgSW50bCcgU3R1ZGVudHMNCmBgYHtyfQ0KbGlicmFyeShnZ21hcCkNCg0KIyBMb2FkIGluIHRoZSBpbnRlcm5hdGlvbmFsIHN0dWRlbnQgZGF0YQ0KaW50bGFsbCA9IHJlYWQuY3N2KCJkYXRhL2ludGxhbGwuY3N2IixzdHJpbmdzQXNGYWN0b3JzPUZBTFNFKQ0KDQojIExldHMgbG9vayBhdCB0aGUgZmlyc3QgZmV3IHJvd3MNCiMgaGVhZChpbnRsYWxsKQ0KDQojIFRob3NlIE5BcyBhcmUgcmVhbGx5IDBzLCBhbmQgd2UgY2FuIHJlcGxhY2UgdGhlbSBlYXNpbHkNCmludGxhbGxbaXMubmEoaW50bGFsbCldID0gMA0KDQojIE5vdyBsZXRzIGxvb2sgYWdhaW4NCmhlYWQoaW50bGFsbCkgDQpgYGANCg0KIyMjIyMgNy4zLjQgV29ybGQgTWFwDQpgYGB7cn0NCiMgTG9hZCB0aGUgd29ybGQgbWFwDQp3b3JsZF9tYXAgPSBtYXBfZGF0YSgid29ybGQiKQ0Kc3RyKHdvcmxkX21hcCkNCmBgYA0KDQojIyMjIyA3LjMuNSBNZXJnZSBNYXAgd2l0aCBEYXRhDQpgYGB7cn0NCiMgTGV0cyBtZXJnZSBpbnRsYWxsIGludG8gd29ybGRfbWFwIHVzaW5nIHRoZSBtZXJnZSBjb21tYW5kDQp3b3JsZF9tYXAgPSBtZXJnZSh3b3JsZF9tYXAsIGludGxhbGwsIGJ5LnggPSJyZWdpb24iLCBieS55ID0gIkNpdGl6ZW5zaGlwIikgI21lcmdl5a6M5LmL5b6Mb2Jz6K6K5bCRLFjlsI3kuI3liLDnmoTlsLHkuJ/mjokNCnN0cih3b3JsZF9tYXApDQpgYGANCg0KIyMjIyMgNy4zLjYgUGxvdCB0aGUgTWFwDQpgYGB7cn0NCmdncGxvdCh3b3JsZF9tYXAsIGFlcyh4PWxvbmcsIHk9bGF0LCBncm91cD1ncm91cCkpICsNCiAgZ2VvbV9wb2x5Z29uKGZpbGw9IndoaXRlIiwgY29sb3I9ImJsYWNrIikgKw0KICBjb29yZF9tYXAoIm1lcmNhdG9yIikNCmBgYA0KDQojIyMjIyA3LjMuNyBQb2x5Z29uIHBvaW50cyBuZWVkIHRvIGJlIG9yZGVyZWQgYnkgR3JvdXANCmBgYHtyfQ0KIyBSZW9yZGVyIHRoZSBkYXRhDQp3b3JsZF9tYXAgPSB3b3JsZF9tYXBbb3JkZXIod29ybGRfbWFwJGdyb3VwLCB3b3JsZF9tYXAkb3JkZXIpLF0NCg0KIyBSZWRvIHRoZSBwbG90DQpnZ3Bsb3Qod29ybGRfbWFwLCBhZXMoeD1sb25nLCB5PWxhdCwgZ3JvdXA9Z3JvdXApKSArDQogIGdlb21fcG9seWdvbihmaWxsPSJ3aGl0ZSIsIGNvbG9yPSJibGFjayIpDQogICMgKyBjb29yZF9tYXAoIm1lcmNhdG9yIikNCmBgYA0KDQojIyMjIyA3LjMuOCBJZGVudGlmeSBhbmQgRml4IE1pc21hdGNocyBiZXR3ZWVuIE1hcCBhbmQgRGF0YQ0KYGBge3J9DQojIExldHMgbG9vayBmb3IgQ2hpbmENCmdyZXAoIkNoaW5hIiwgaW50bGFsbCRDaXRpemVuc2hpcCwgaWdub3JlLmNhc2U9VCwgdmFsdWU9VCkgI+aQnOWwi+aciUNoaW5h6YCZ5YCL6Kme55qELOWkp+Wwj+Wvq+S4jeeuoQ0KZ3JlcCgiQ2hpbmEiLCB1bmlxdWUobWFwX2RhdGEoIndvcmxkIikkcmVnaW9uKSwgaWdub3JlLmNhc2U9VCwgdmFsdWU9VCkgDQpgYGANCg0KYGBge3J9DQojIExldHMgImZpeCIgdGhhdCBpbiB0aGUgaW50bGFsbCBkYXRhc2V0DQppbnRsYWxsJENpdGl6ZW5zaGlwW2ludGxhbGwkQ2l0aXplbnNoaXA9PSJDaGluYSAoUGVvcGxlJ3MgUmVwdWJsaWMgT2YpIl0gPSANCiAgIkNoaW5hIg0KDQojIFdlJ2xsIHJlcGVhdCBvdXIgbWVyZ2UgYW5kIG9yZGVyIGZyb20gYmVmb3JlDQp3b3JsZF9tYXAgPSBtZXJnZShtYXBfZGF0YSgid29ybGQiKSwgaW50bGFsbCwgDQogICAgICAgICAgICAgICAgICBieS54ID0icmVnaW9uIiwNCiAgICAgICAgICAgICAgICAgIGJ5LnkgPSAiQ2l0aXplbnNoaXAiKQ0Kd29ybGRfbWFwID0gd29ybGRfbWFwW29yZGVyKHdvcmxkX21hcCRncm91cCwgd29ybGRfbWFwJG9yZGVyKSxdDQoNCmdncGxvdCh3b3JsZF9tYXAsIGFlcyh4PWxvbmcsIHk9bGF0LCBncm91cD1ncm91cCkpICsNCiAgZ2VvbV9wb2x5Z29uKGFlcyhmaWxsPVRvdGFsKSwgY29sb3I9ImJsYWNrIikgIysNCiAgI2Nvb3JkX21hcCgibWVyY2F0b3IiKQ0KYGBgDQoNCiMjIyMjIDcuMy45IERpZmZlcmVudCBPcmllbnRhdGlvbnMNCmBgYHtyfQ0KIyBXZSBjYW4gdHJ5IG90aGVyIHByb2plY3Rpb25zIC0gdGhpcyBvbmUgaXMgdmlzdWFsbHkgaW50ZXJlc3RpbmcNCmdncGxvdCh3b3JsZF9tYXAsIGFlcyh4PWxvbmcsIHk9bGF0LCBncm91cD1ncm91cCkpICsNCiAgZ2VvbV9wb2x5Z29uKGFlcyhmaWxsPVRvdGFsKSwgY29sb3I9ImJsYWNrIikgKw0KICBjb29yZF9tYXAoIm9ydGhvIiwgb3JpZW50YXRpb249YygyMCwgMzAsIDApKQ0KYGBgDQoNCmBgYHtyfQ0KZ2dwbG90KHdvcmxkX21hcCwgYWVzKHg9bG9uZywgeT1sYXQsIGdyb3VwPWdyb3VwKSkgKw0KICBnZW9tX3BvbHlnb24oYWVzKGZpbGw9VG90YWwpLCBjb2xvcj0iYmxhY2siKSArDQogIGNvb3JkX21hcCgib3J0aG8iLCBvcmllbnRhdGlvbj1jKC0zNywgMTc1LCAwKSkNCmBgYA0KPGJyPg0KDQotIC0gLQ0KDQojIyMgNy4zIOizh+aWmee1kOani+i9ieaPmw0KDQojIyMjIyA3LjMuMTAgUmVzaGFwaW5nIGJlZm9yZSBQbG90aW5nDQpgYGB7cn0NCmxpYnJhcnkoZ2dwbG90MikNCmxpYnJhcnkocmVzaGFwZTIpDQojIE5vdyBsZXRzIGxvYWQgb3VyIGRhdGFmcmFtZQ0KaG91c2Vob2xkcyA9IHJlYWQuY3N2KCJkYXRhL2hvdXNlaG9sZHMuY3N2IikNCnN0cihob3VzZWhvbGRzKQ0KYGBgDQoNCmBgYHtyfQ0KIyBQbG90IGl0DQptZWx0KGhvdXNlaG9sZHMsIGlkPSJZZWFyIikgJT4lIA0KICBnZ3Bsb3QoYWVzKHg9WWVhciwgeT12YWx1ZSwgY29sb3I9dmFyaWFibGUpKSArDQogIGdlb21fbGluZShzaXplPTIpICsgZ2VvbV9wb2ludChzaXplPTUpICsgIA0KICB5bGFiKCJQZXJjZW50YWdlIG9mIEhvdXNlaG9sZHMiKQ0KYGBgDQo8YnI+DQoNCi0gLSAtDQoNCjxicj48YnI+PGJyPjxicj48YnI+DQoNCjxzdHlsZT4NCi5jYXB0aW9uIHsNCiAgY29sb3I6ICM3Nzc7DQogIG1hcmdpbi10b3A6IDEwcHg7DQp9DQpwIGNvZGUgew0KICB3aGl0ZS1zcGFjZTogaW5oZXJpdDsNCn0NCnByZSB7DQogIHdvcmQtYnJlYWs6IG5vcm1hbDsNCiAgd29yZC13cmFwOiBub3JtYWw7DQogIGxpbmUtaGVpZ2h0OiAxOw0KfQ0KcHJlIGNvZGUgew0KICB3aGl0ZS1zcGFjZTogaW5oZXJpdDsNCn0NCnAsbGkgew0KICBmb250LWZhbWlseTogIlRyZWJ1Y2hldCBNUyIsICLlvq7ou5/mraPpu5Hpq5QiLCAiTWljcm9zb2Z0IEpoZW5nSGVpIjsNCn0NCg0KLnJ7DQogIGxpbmUtaGVpZ2h0OiAxLjI7DQp9DQoNCnRpdGxlew0KICBjb2xvcjogI2NjMDAwMDsNCiAgZm9udC1mYW1pbHk6ICJUcmVidWNoZXQgTVMiLCAi5b6u6Luf5q2j6buR6auUIiwgIk1pY3Jvc29mdCBKaGVuZ0hlaSI7DQp9DQoNCmJvZHl7DQogIGZvbnQtZmFtaWx5OiAiVHJlYnVjaGV0IE1TIiwgIuW+rui7n+ato+m7kemrlCIsICJNaWNyb3NvZnQgSmhlbmdIZWkiOw0KfQ0KDQpoMSxoMixoMyxoNCxoNXsNCiAgY29sb3I6ICMwMDg4MDA7DQogIGZvbnQtZmFtaWx5OiAiVHJlYnVjaGV0IE1TIiwgIuW+rui7n+ato+m7kemrlCIsICJNaWNyb3NvZnQgSmhlbmdIZWkiOw0KfQ0KDQpoM3sNCiAgY29sb3I6ICNiMzZiMDA7DQogIGJhY2tncm91bmQ6ICNmZmUwYjM7DQogIGxpbmUtaGVpZ2h0OiAyOw0KICBmb250LXdlaWdodDogYm9sZDsNCn0NCg0KaDV7DQogIGNvbG9yOiAjMDA2MDAwOw0KICBiYWNrZ3JvdW5kOiAjZmZmZmUwOw0KICBsaW5lLWhlaWdodDogMjsNCiAgZm9udC13ZWlnaHQ6IGJvbGQ7DQp9DQoNCmVtew0KICBjb2xvcjogIzAwMDBjMDsNCiAgYmFja2dyb3VuZDogI2YwZjBmMDsNCiAgfQ0KPC9zdHlsZT4NCg0K