Tugas Visdat Praktikum 10
Library
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ lubridate 1.9.3 ✔ tibble 3.2.1
## ✔ purrr 1.0.1 ✔ tidyr 1.3.0
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
## Linking to GEOS 3.11.0, GDAL 3.5.3, PROJ 9.1.0; sf_use_s2() is TRUE
##
## Attaching package: 'rnaturalearthdata'
##
## The following object is masked from 'package:rnaturalearth':
##
## countries110
##
## Attaching package: 'reshape2'
##
## The following object is masked from 'package:tidyr':
##
## smiths
##
## Attaching package: 'gridExtra'
##
## The following object is masked from 'package:dplyr':
##
## combine
##
## Attaching package: 'plotly'
##
## The following object is masked from 'package:ggplot2':
##
## last_plot
##
## The following object is masked from 'package:stats':
##
## filter
##
## The following object is masked from 'package:graphics':
##
## layout
Data
data <- read_excel("/Users/user/Downloads/Documents/Anreg /Tugas Akhir/DATASET ANREG2.xlsx")
data[] <- lapply(data, as.numeric)## Warning in lapply(data, as.numeric): NAs introduced by coercion
## # A tibble: 27 × 11
## IPKM melek miskin rumah_sakit kepadatan lama pengangguran upah PDRB
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 79.5 98.4 475. 30 1861 8.34 10.6 4217206 30173
## 2 79.3 99.5 186. 9 674 7.11 7.77 3125445. 17953
## 3 77.8 99.2 247. 5 700 7.2 8.41 2699814. 13590
## 4 83.1 99.5 259. 15 2136 9.08 6.98 3241930. 23782
## 5 79.8 99.6 277. 7 847 7.83 7.6 1975221. 15991
## 6 76.8 99.0 194. 2 705 7.73 4.17 2326772. 13829
## 7 80.5 98.6 94 6 782 8 3.75 1897867. 19169
## 8 83.1 98.0 140. 12 1003 7.88 9.81 1908102. 15426
## 9 80.7 94.8 266. 12 2150 7.4 8.11 2279983. 15342
## 10 78.1 98.2 147. 5 1004 7.49 4.16 2027619. 18197
## # ℹ 17 more rows
## # ℹ 2 more variables: sekolah <dbl>, sampah <dbl>
## Rows: 61 Columns: 7
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (6): Open, High, Low, Close, Adj Close, Volume
## date (1): Date
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
## spc_tbl_ [61 × 7] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ Date : Date[1:61], format: "2019-05-01" "2019-06-01" ...
## $ Open : num [1:61] 5750 5820 5995 6190 6100 ...
## $ High : num [1:61] 5895 6190 6290 6270 6105 ...
## $ Low : num [1:61] 5140 5790 5865 5765 5780 ...
## $ Close : num [1:61] 5820 5995 6190 6100 6070 ...
## $ Adj Close: num [1:61] 5229 5386 5562 5481 5454 ...
## $ Volume : num [1:61] 1.70e+09 1.18e+09 1.05e+09 1.53e+09 1.26e+09 ...
## - attr(*, "spec")=
## .. cols(
## .. Date = col_date(format = ""),
## .. Open = col_double(),
## .. High = col_double(),
## .. Low = col_double(),
## .. Close = col_double(),
## .. `Adj Close` = col_double(),
## .. Volume = col_double()
## .. )
## - attr(*, "problems")=<externalptr>
## tibble [4,996 × 5] (S3: tbl_df/tbl/data.frame)
## $ NO : num [1:4996] 1 2 3 4 5 6 7 8 9 10 ...
## $ Nilai : num [1:4996] 1 1 1 1 1 1 1 1 1 1 ...
## $ Kurs Jual: num [1:4996] 16283 16357 16330 16303 16289 ...
## $ Kurs Beli: num [1:4996] 16121 16195 16168 16141 16127 ...
## $ Tanggal : chr [1:4996] "5/3/2024 12:00:00 AM" "5/2/2024 12:00:00 AM" "4/30/2024 12:00:00 AM" "4/29/2024 12:00:00 AM" ...
Data Peubah Numerik
Korelasi
plot_X1 <- ggplot(data, aes(x = melek, y = IPKM)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
labs(x = "Angka Melek Huruf", y = "IPKM")
plot_X2 <- ggplot(data, aes(x = miskin, y = IPKM)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
labs(x = "Jumlah Penduduk Miskin", y = "IPKM")
plot_X3 <- ggplot(data, aes(x = rumah_sakit, y = IPKM)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
labs(x = "Jumlah Rumah Sakit", y = "IPKM")
plot_X4 <- ggplot(data, aes(x = kepadatan, y = IPKM)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
labs(x = "Kepadatan Penduduk", y = "IPKM")
# Menggabungkan scatter plot ke dalam satu layout
grid.arrange(plot_X1, plot_X2, plot_X3, plot_X4, nrow = 2)## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
Terlihat bahwa angka melek huruf, kepadatan penduduk, dan jumlah rumah
sakit menunjukkan hubungan linear positif yang menandakan bahwa semakin
tinggi angka melek huruf dan kepadatan penduduk, serta semakin banyak
jumlah rumah sakit, maka nilai IPKM cenderung meningkat. Sebaliknya,
jumlah penduduk miskin menunjukkan hubungan linear negatif yang
menandakan bahwa semakin sedikit jumlah penduduk miskin, maka nilai IPKM
cenderung menurun.
data$kategori <- ifelse(data$kepadatan >= 2500, "padat penduduk", "tidak padat penduduk")
ggplot(data, aes(x = sampah, y = IPKM, color = kategori)) +
geom_point() +
labs(title = "Scatter Plot Tingkatan IPKM vs. jumlah sampah ditangani", x = "Jumlah Sampah Ditangani", y = "IPKM", color = "Kategori") +
theme_minimal()
Scatter plot tersebut menggambarkan bahwa wilayah-wilayah dengan
kepadatan penduduk tinggi cenderung memiliki nilai IPKM yang lebih
tinggi dan menangani jumlah sampah yang lebih besar dibandingkan dengan
wilayah yang memiliki kepadatan penduduk rendah. Dari gambar tersebut
juga bisa diindikasikan bahwa jumlah sampah ditangani memiliki hubungan
linear positif dengan IPKM, yang berarti semakin banyak sampah yang
ditangani maka nilai IPKM juga akan meningkat.
Matrix Plot
## tibble [27 × 11] (S3: tbl_df/tbl/data.frame)
## $ IPKM : num [1:27] 79.5 79.3 77.8 83.1 79.8 ...
## $ melek : num [1:27] 98.4 99.5 99.2 99.5 99.6 ...
## $ miskin : num [1:27] 475 186 247 259 277 ...
## $ rumah_sakit : num [1:27] 30 9 5 15 7 2 6 12 12 5 ...
## $ kepadatan : num [1:27] 1861 674 700 2136 847 ...
## $ lama : num [1:27] 8.34 7.11 7.2 9.08 7.83 7.73 8 7.88 7.4 7.49 ...
## $ pengangguran: num [1:27] 10.64 7.77 8.41 6.98 7.6 ...
## $ upah : num [1:27] 4217206 3125445 2699814 3241930 1975221 ...
## $ PDRB : num [1:27] 30173 17953 13590 23782 15991 ...
## $ sekolah : num [1:27] 6513 5012 4398 422 3983 ...
## $ sampah : num [1:27] 397 352 457 560 330 ...
data_melt <- cor(data_numerik[sapply(data_numerik,is.numeric)])
data_melt <- melt(data_melt)
ggplot(data_melt, aes(x = Var1, y = Var2, fill = value)) +
geom_tile() +
labs(title = "Correlation Heatmap",
x = "Variable 1",
y = "Variable 2")ggplot(data_melt, aes(Var1, Var2, fill = value)) +
geom_tile(color = "white") +
scale_fill_gradient2(low = "blue", 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))Dari gambar-gambar di atas, dapat disimpulkan bahwa terdapat indikasi multikolinieritas antara beberapa variabel X, seperti antara kepadatan penduduk dan rata-rata lama sekolah. Korelasi yang cukup besar antara kedua variabel ini, yang ditunjukkan dengan warna yang lebih gelap atau lebih terang dalam plot, menandakan adanya hubungan yang signifikan di antara keduanya. Oleh karena itu, dapat disimpulkan bahwa kepadatan penduduk dan rata-rata lama sekolah saling mempengaruhi karena adanya korelasi yang signifikan.
Piecewise Constant
##
## Call:
## lm(formula = Sepal.Length ~ cut(Petal.Length, 3), data = iris)
##
## Residuals:
## Min 1Q Median 3Q Max
## -1.0111 -0.3111 -0.0060 0.2889 1.2261
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.00600 0.06913 72.409 <2e-16 ***
## cut(Petal.Length, 3)(2.97,4.93] 0.90511 0.09594 9.434 <2e-16 ***
## cut(Petal.Length, 3)(4.93,6.91] 1.66791 0.09987 16.700 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.4889 on 147 degrees of freedom
## Multiple R-squared: 0.6562, Adjusted R-squared: 0.6515
## F-statistic: 140.3 on 2 and 147 DF, p-value: < 2.2e-16
ggplot(iris,aes(x=Petal.Length, y=Sepal.Length)) +
geom_point(alpha=0.55, color="black") +
stat_smooth(method = "lm",
formula = y~cut(x,3),
lty = 1, col = "red",se = F)+
theme_bw()
Gambar tersebut menunjukkan scatter plot yang menggambarkan hubungan
antara petal length dan sepal length. Garis merah yang tergambar
mewakili fungsi berpotongan atau fungsi langkah untuk memodelkan atau
menginterpretasi distribusi titik-titik data. Terdapat tiga kelompok
titik abu-abu yang berbeda, menunjukkan adanya tiga kelompok bunga
dengan karakteristik yang berbeda berdasarkan panjang kelopak dan
kelopak daunnya.Teridentifikasi juga bahwa petal length dan sepal length
memiliki hubungan linear positif yang berarti semakin panjang kelopak
bunga maka semakin panjang pula kelompak daun.
ggplot(iris, aes(x = Petal.Length, y = Sepal.Length)) +
geom_point(color = "blue", size = 3, alpha = 0.6) +
geom_smooth(method = "loess", color = "red", linetype = "dashed", size = 1.5) +
labs(
x = "Petal Length",
y = "Sepal Length",
title = "LOESS Visualization of Petal Length vs. Sepal Length",
subtitle = "Smoothed scatterplot with LOESS curve",
caption = "Data Iris"
) +
theme_minimal() ## 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.
## `geom_smooth()` using formula = 'y ~ x'
Gambar tersebut menampilkan scatter plot yang telah disesuaikan dengan
kurva LOESS, yang menggambarkan hubungan antara kedua variabel dengan
lebih halus. Kurva ini mengidentifikasi korelasi positif antar kedua
variabel. Hal ini mengindikasikan hubungan yang sejalan antara dua
variabel tersebut, yang diperkuat oleh hasil smoothing menggunakan
metode LOESS, yang menyajikan pola hubungan dengan lebih halus dan
kontinu.
Data Time Series
Scatter Plot Time Series
data2 <- head(data2, -1)
ggplot(data2, aes(x =Date, y = Open)) +
geom_point() +
labs(title = "Scatter Plot of Time Series Data (BBCA)",
x = "Date",
y = "Value (open)")ggplot(data2, aes(x =Date, y = Open)) +
geom_point() +
geom_line() +
labs(title = "Scatter Plot of Time Series Data (BBCA)",
x = "Date",
y = "Value (open)")ggplot(data2, aes(x =Date, y = Open)) +
geom_line() +
labs(title = "Scatter Plot of Time Series Data (BBCA)",
x = "Date",
y = "Value (open)")calculate_moving_average <- function(data2, window_size) {
ma_values <- zoo::rollmean(data2$Open, k = window_size, align = "right", fill = NA)
ma_values_padded <- c(rep(NA, window_size - 1), ma_values)
data2$ma <- ma_values_padded[1:nrow(data2)] # Extract only the necessary number of rows
return(data2)
}
window_size <- 3
data2 <- calculate_moving_average(data2, window_size)
# Create the plot
ggplot(data2, aes(x = Date)) +
geom_line(aes(y = Open), color = "white", size = 1) +
geom_line(aes(y = ma), color = "red", linetype = "dashed", size = 1) + # emulusan
geom_ribbon(aes(ymin = -Inf, ymax = ma), fill = "red", alpha = 0.2) + # Area under curve
labs(title = paste("BBCA data with Moving Average (Window Size:", window_size, ")"),
x = "Date",
y = "Value (open)") +
theme_minimal()## Warning: Removed 4 rows containing missing values or values outside the scale range
## (`geom_line()`).
data_open <- data2$Open
data.ts <- ts(data_open)
plot(data.ts, xlab ="Waktu", ylab = "Data Open BBCA", col="red", main = "Plot Data Open BBCA")
points(data.ts)
Grafik-grafik tersebut menggambarkan pola kenaikan dan penurunan harga
saham BBCA seiring waktu. Terlihat bahwa saham BBCA mengalami fluktuasi
harga, namun secara keseluruhan mengalami tren kenaikan yang signifikan.
Titik-titik puncak pada grafik menunjukkan periode-periode di mana harga
saham mencapai level tertinggi, yang terlihat menurun pada akhir tahun
2020, 2021, dan mendekati pertengahan tahun 2022. Di sisi lain, terlihat
bahwa saham BBCA mengalami peningkatan yang cukup konsisten pada
pertengahan tahun 2021, awal hingga pertengahan tahun 2022, serta akhir
tahun 2023 hingga saat ini. Hal ini mencerminkan adanya pola tren
kenaikan yang berkelanjutan dalam jangka waktu tersebut.
Plot Perbandingan Time Series
## Rows: 61 Columns: 7
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (6): Open, High, Low, Close, Adj Close, Volume
## date (1): Date
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
## Rows: 61 Columns: 7
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## dbl (6): Open, High, Low, Close, Adj Close, Volume
## date (1): Date
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
data1 <- head(data1, -1)
data2 <- head(data2, -1)
# Memplot kedua seri waktu
ggplot() +
geom_line(data = data1, aes(x = Date, y = Open, color = "BBCA")) +
geom_line(data = data2, aes(x = Date, y = Open, color = "BBNI")) +
labs(title = "Perbandingan Dua Data Time Series (BBCA vs. BBNI)",
x = "Date",
y = "Value",
color = "Series") +
scale_color_manual(values = c("BBCA" = "blue", "BBNI" = "red")) +
theme_minimal()
Grafik di atas mengilustrasikan perbandingan harga saham pembukaan
(open) antara BBCA dan BBNI. Meskipun pola grafik keduanya hampir
serupa, terlihat bahwa harga saham BBCA selalu berada di atas harga
saham BBNI sepanjang rentang waktu dari awal tahun 2019 hingga awal
tahun 2024. Hal ini menunjukkan dominasi BBCA atas BBNI dalam hal nilai
harga saham pembukaannya selama periode yang diamati.
Data Spasial
## Warning in viridisLite::viridis(n, alpha, begin, end, direction, option):
## Option 'volcano' does not exist. Defaulting to 'viridis'.
spasial <- read.csv("/Users/user/Downloads/world_population.csv")
world_map <- map_data("world")
colnames(spasial)[colnames(spasial) == "Country.Territory"] <- "region"
merged_data <- left_join(world_map, spasial, by = c("region" = "region"))
ggplot(merged_data, aes(x = long, y = lat, group = group, fill = `X2022.Population`)) +
geom_polygon(color = "black") +
scale_fill_gradient(name = "Population (2022)", low = "pink", high = "red", guide = "legend") +
theme_void() +
labs(title = "World Population by Country/Territory (2022)")
Dari kumpulan map chart yang disajikan di atas, terlihat distribusi
populasi global pada tahun 2022. Warna kuning dan merah menunjukkan
negara-negara dengan populasi yang tinggi, sementara warna biru dan pink
menandakan populasi yang lebih rendah. Dari peta tersebut, terlihat
dengan jelas bahwa China dan India memiliki populasi yang sangat besar.
Namun, pada gambar ketiga, terdapat negara dengan warna abu-abu yang
menandakan adanya ketidaksesuaian dalam format nama negara dengan data
yang seharusnya.