Tugas Praktikum Visualisasi Data UAS
Adinda Shabrina Putri Salsabila
2024-05-14
Input Data
data <- read_xlsx("C:/Users/hp/Documents/KULIAH/SEMESTER 4/VISDAT/PRAK/Data IPM.xlsx")
data <- data[-c(1),]
dataY <- mutate(data, Y = as.numeric(Y))dataX1 <- mutate(dataY, X1 = as.numeric(X1))data1 <- mutate(dataX1, X3 = as.numeric(X3))
str(data1)## tibble [34 × 5] (S3: tbl_df/tbl/data.frame)
## $ Provinsi: chr [1:34] "Aceh" "Sumatera Utara" "Sumatera Barat" "Riau" ...
## $ Y : num [1:34] 73.4 73.4 73.8 74 72.8 ...
## $ X1 : num [1:34] 9.44 9.71 9.18 9.22 8.68 ...
## $ X2 : num [1:34] 227110 1050995 312770 1026472 293729 ...
## $ X3 : num [1:34] 78415 760325 79.7 75.9 72985 ...data2 <- read_xlsx("C:/Users/hp/Documents/KULIAH/SEMESTER 4/VISDAT/PRAK/DataAdobe.xlsx")
data2 <- data2[-c(1),]
str(data2)## tibble [262 × 7] (S3: tbl_df/tbl/data.frame)
## $ Date : POSIXct[1:262], format: "2019-04-29" "2019-05-06" ...
## $ Open : num [1:262] 2.86e+08 2.78e+08 2.71e+08 2.76e+08 2.76e+08 ...
## $ High : num [1:262] 2.92e+08 2.84e+08 2.86e+08 2.83e+08 2.81e+08 ...
## $ Low : num [1:262] 2.78e+08 2.70e+08 2.67e+08 2.72e+08 2.69e+08 ...
## $ Close : num [1:262] 2.86e+08 2.78e+08 2.80e+08 2.75e+08 2.71e+08 ...
## $ Adj Close: num [1:262] 2.86e+08 2.78e+08 2.80e+08 2.75e+08 2.71e+08 ...
## $ Volume : num [1:262] 15178400 11137600 13090100 10340700 8409500 ...Visualisasi Antar Peubah
Scatter Plot
plot1 <- ggplot(data1, aes(x = X1, y = Y)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
labs(x = "Rata-Rata Lama Sekolah", y = "IPM")
plot2 <- ggplot(data1, aes(x = X2, y = Y)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
labs(x = "PDRB", y = "IPM")
plot3 <- ggplot(data1, aes(x = X3, y = Y)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
labs(x = "Angka Partisipasi Sekolah", y = "IPM")
plot1## `geom_smooth()` using formula = 'y ~ x'
plot2## `geom_smooth()` using formula = 'y ~ x'
plot3## `geom_smooth()` using formula = 'y ~ x'
Dari ketiga plot hubungan antar peubah X1 (Rataan Lama Sekolah), X2 (PDRB), X3 (Angka Partisipasi Sekolah) terhadap peubah Y (Indeks Pembangunan Manusia) terlihat hubungan linear yang positif dimana setiap kenaikan angka peubah X maka nilai Y juga cenderung naik. Amatan pada X3 cenderung lebih menyebar dibandingkan kedua peubah X lainnya.
Heatmap Plot
data_numerik <- select_if(data1, is.numeric)
str(data_numerik)## tibble [34 × 4] (S3: tbl_df/tbl/data.frame)
## $ Y : num [1:34] 73.4 73.4 73.8 74 72.8 ...
## $ X1: num [1:34] 9.44 9.71 9.18 9.22 8.68 ...
## $ X2: num [1:34] 227110 1050995 312770 1026472 293729 ...
## $ X3: num [1:34] 78415 760325 79.7 75.9 72985 ...data_melt <- cor(data_numerik[sapply(data_numerik,is.numeric)])
data_melt <- melt(data_melt)ggplot(data_melt, aes(Var1, Var2, fill = value)) +
geom_tile(color = "white") +
scale_fill_gradient2(low = "purple", mid = "white", high = "red", midpoint = 0, limits = c(-1,1), name="Korelasi") +
labs(title = "Corellogram") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, vjust = 1, hjust=1))
Matriks korelasi diatas menunjukkan bahwa korelasi tertinggi dan positif ada pada peubah Y dengan X1, korelasi negatif ada pada peubah Y dengan X3 dan hubungan antar peubah X cenderung tak berkorelasi. Hal tersebut dapat dilihat dari warna di dalam kotak antar peubah dimana semakin merah warnanya berarti korelasi semakin kuat positif dan semakin ungu warnanya berarti semakin kuat negatif, sedangkan putih menandakan tak ada korelasi antar peubah.
Visualisasi Time Series
data2$Date <- as.Date(data2$Date)
ggplot(data2, aes(x = Date, y = High)) +
geom_point() +
labs(title = "Scatter Plot of Time Series Data",
x = "Date",
y = "High Price") +
scale_x_date(date_breaks = "12 months")
ggplot(data2, aes(x = Date, y = High)) +
geom_point() + # Add points
geom_line() + # Connect points with lines
labs(title = "Scatter Plot Harga tertinggi produk Adobe",
x = "Date",
y = "High Price") +
scale_x_date(date_breaks = "12 months")
ggplot(data2, aes(x = Date, y = High)) +
geom_line() +
labs(title = "Time Series Plot Harga Tertinggi Produk Adobe",
x = "Date",
y = "High Price") +
scale_x_date(date_breaks = "12 months")
calculate_moving_average <- function(data, window_size) {
ma_values <- zoo::rollmean(data2$High, k = window_size, align = "right", fill = NA)
return(ma_values)
}
window_size <- 10
data2$ma <- calculate_moving_average(data2, window_size)
# Create the plot
ggplot(data2, aes(x = Date)) +
geom_line(aes(y = High), color = "white", size = 1) +
geom_line(aes(y = ma), color = "purple", linetype = "dashed", size = 1) + # emulusan
geom_ribbon(aes(ymin = -Inf, ymax = ma), fill = "purple", alpha = 0.2) + # Area under curve
labs(title = paste("Time Series Data with Moving Average (Window Size:", window_size, ")"),
x = "Date",
y = "High Price") +
theme_minimal() +
scale_x_date(date_breaks = "12 months")## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## Warning: Removed 9 rows containing missing values (`geom_line()`).
Berdasarkan grafik time series di atas dapat terlihat bahwa pergerakan harga tertinggi produk adobe cukup fluktuatif dalam empat tahun terakhir dengan harga tertinggi berada di awal tahun 2022 dan 2024 serta harga terendah berada di awal tahun 2023.
Visualisasi Geospasial
dataworld <- map_data("world")arrests <- USArrests
arrests$region <- tolower(rownames(USArrests))
states_map <- map_data("state")
arrests_map <- left_join(states_map, arrests, by = "region")
ggplot(arrests_map, aes(long, lat, group = group))+
geom_polygon(aes(fill = Rape), color = "white")+
scale_fill_viridis_c(option = "C") +
theme_classic() 
Grafik di atas adalah sebaran kasus tindak kejahatan yaitu pemerkosaan di amerika. Dapat diketahui bahwa bagian timur atau lebih tepatnya di Calfornia dan Nevada terdapat kasus pemerkosaan terbanyak sedangkan wilayah utara dan timur amerika cenderung memiliki lebih sedikit kasus pemerkosaan.