Tugas VISDAT PRAKTIKUM
Eliza Rahmadania
2024-05-13
Package Installation
library(tidyverse) #Include beberapa packages termasuk ggplot
library(dplyr)
library(reshape2)
library(readxl)
library(plotly)
library(ggcorrplot)
library(psych)
library(ggplot2)
library(sf)
library(gridExtra)
library(ggforce)#Visualisasi Antar Peubah Numerik
Data
data <- read_excel("C:/Users/DEVINA/OneDrive/DOKUMEN EJA/ANREG/PROJECT ANREG/Data Tanpa Peubah.xlsx")
str(data)## tibble [27 × 9] (S3: tbl_df/tbl/data.frame)
## $ Y : num [1:27] 15.35 14.48 12.19 12.99 8.52 ...
## $ X1: num [1:27] 2585 1650 2929 4238 4194 ...
## $ X2: num [1:27] 1.3 4.9 2.4 2.3 3 4.2 4 5.5 3.6 3.8 ...
## $ X3: num [1:27] 53 82.3 87.2 95.4 89.1 ...
## $ X4: num [1:27] 59040 32883 35113 40368 19828 ...
## $ X5: num [1:27] 4217206 3125445 2534799 3241930 1961086 ...
## $ X6: num [1:27] 573352 362219 442503 367264 282908 ...
## $ X7: num [1:27] 87.5 100 100 74.6 81.5 ...
## $ X8: num [1:27] 23.8 39.6 60.3 30.5 55.1 ...Data Peubah Numerik
Korelasi
plot_X1 <- ggplot(data, aes(x = X1, y = Y )) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
labs(x = "Jumlah Posyandu AKtif", y = "Gizi Buruk Bayi")
plot_X2 <- ggplot(data, aes(x = X2, y = Y)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
labs(x = "Berat Bayi Lahir Rendah", y = "Gizi Buruk Bayi")
plot_X3 <- ggplot(data, aes(x = X3, y = Y)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
labs(x = "Inisiasi Menyusui Dini", y = "Gizi Buruk Bayi")
plot_X4 <- ggplot(data, aes(x = X4, y = Y)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
labs(x = "Bayi Penerima ASI Ekslusif", y = "Gizi Buruk Bayi")
plot_X5 <- ggplot(data, aes(x = X5, y = Y)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
labs(x = "Besaran Upah Minimum", y = "Gizi Buruk Bayi")
plot_X6 <- ggplot(data, aes(x = X6, y = Y)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
labs(x = "Perilaku Hidup Bersih", y = "Gizi Buruk Bayi")
plot_X7 <- ggplot(data, aes(x = X7, y = Y)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
labs(x = "Akses Penduduk Terhadap Air Minum Memenuhi Syarat", y = "Gizi Buruk Bayi")
plot_X8 <- ggplot(data, aes(x = X8, y = Y)) +
geom_point() +
geom_smooth(method = "lm", se = FALSE) +
labs(x = "Tempat Pengelolaan Makanan Memenuhi Syarat Kesehatan", y = "Gizi Buruk Bayi")
# Menggabungkan scatter plot ke dalam satu layout
grid.arrange(plot_X1, plot_X2, plot_X3, plot_X4, plot_X6, plot_X7, plot_X8, nrow = 4)## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
## `geom_smooth()` using formula = 'y ~ x'
Interpretasi
Dari data yang ditampilkan dalam eksplorasi scatter plot di atas, terlihat bahwa Berat Bayi Lahir Rendah (BBLR) menunjukan hubungan linear positif dimana semakin banyak berat bayi lahir rendah maka gizi buruk pada bayi semakin tinggi. Sebaliknya, Jumlah Posyandu, Inisiasi Menyusui Dini, Bayi Penerima ASI Ekslusif, Besaran Upah Minimum, Perilaku Hidup Bersih, Akses Penduduk Terhadap Air Minum Memenuhi Syarat, dan Tempat Pengelolaan Makanan Memenuhi Syarat Kesehatan menunjukan hubungan yang linear negatif dimana semakin tinggi variabel-variabel tersebut maka gizi buruk pada bayi semakin rendah.
Matrix Plot
data_numerik <- select_if(data, is.numeric)
str(data_numerik)## tibble [27 × 9] (S3: tbl_df/tbl/data.frame)
## $ Y : num [1:27] 15.35 14.48 12.19 12.99 8.52 ...
## $ X1: num [1:27] 2585 1650 2929 4238 4194 ...
## $ X2: num [1:27] 1.3 4.9 2.4 2.3 3 4.2 4 5.5 3.6 3.8 ...
## $ X3: num [1:27] 53 82.3 87.2 95.4 89.1 ...
## $ X4: num [1:27] 59040 32883 35113 40368 19828 ...
## $ X5: num [1:27] 4217206 3125445 2534799 3241930 1961086 ...
## $ X6: num [1:27] 573352 362219 442503 367264 282908 ...
## $ X7: num [1:27] 87.5 100 100 74.6 81.5 ...
## $ X8: num [1:27] 23.8 39.6 60.3 30.5 55.1 ...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")
model <- lm (Y ~ X1+X2+X3+X4+X5+X6+X7+X8, data=data)
library(corrplot)## corrplot 0.92 loadedcor_mat <- cor(model$model)
corrplot(cor_mat, method = 'number')
Note: X1: Jumlah Posyandu Aktif X2: Berat Bayi Lahir Rendah X3: Inisiasi Menyusui Dini X4: Bayi Penerima ASI Ekslusif X5: Besar Upah Minimum X6: Perilaku Hidup Bersih X7: Akses Penduduk Terhadap Air Minum Memenuhi Syarat X8: Tempat Pengelolaan Makanan Memenuhi Syarat Kesehatan
Interpretasi
Dari hasil di atas, dapat disimpulkan bahwa terdapat indikasi adanya multikolinearitas dibeberapa variabel X. Seperti dilihat dari angka pada heat map kedua bahwa Variabel X4 dan X1, X6 dan X4, X6 dan X1 mengeluarkan nilai korelasi yang cukup tinggi yang menandakan adanya hubungan signifikan diantara keduanya. Oleh karena itu, dapat disimpulkan bahwa Variabel X4 dan X1, X6 dan X4, X6 dan X1 saling mempengarui karena adanya korelasi yang signifikan.
Visualisasi Time Series
library(tidyverse) #Include beberapa packages termasuk ggplot
library(dplyr)
library(reshape2)
library(ggforce)
library(readxl)
library(ggplot2)Data
data <- read.csv("C:/Users/DEVINA/Downloads/PG (2) (1).csv", header = TRUE, sep=",")
str(data)## 'data.frame': 1258 obs. of 7 variables:
## $ Date : chr "2019-04-17" "2019-04-18" "2019-04-22" "2019-04-23" ...
## $ Open : num 106 106 106 104 103 ...
## $ High : num 107 107 107 104 105 ...
## $ Low : num 105 106 106 102 103 ...
## $ Close : num 106 106 106 103 104 ...
## $ Adj.Close: num 94.1 94.3 94.2 91.7 92.2 ...
## $ Volume : int 6778100 7248900 9057200 15979800 10094800 6085300 7747400 4787600 8251300 6733800 ...data <- head(data)
ggplot(data, aes(x = Date, y = Close)) +
geom_point() +
labs(title = "Scatter Plot of Time Series Data Saham PG",
x = "Date",
y = "Close")
Perbandingan Dua Harga Saham Buka dan Tutup Unilever PLC
ggplot() +
geom_point(data = data, aes(x = Date, y = Open, color = "Open")) +
geom_point(data = data, aes(x = Date, y = Close, color = "Close")) +
labs(title = "Perbandingan Dua Data Time Series (Open vs. Close)",
x = "Date",
y = "Value",
color = "Series") +
scale_color_manual(values = c("Open" = "blue", "Close" = "red")) +
theme_minimal()
Interpretasi
Pada grafik time series pertama menunjukkan hasil penurunan harga penutupan saham pigeon dilihat secara perhari tahun 2019 dibulan april.
Untuk grafik time series kedua menunjukan hasil perbandingan harga penutupan dan pembukaan saham pigeon perhari dibulan april.
Data Spasial
library("ggplot2")
library("sf")
library("rnaturalearth")
library("rnaturalearthdata")##
## Attaching package: 'rnaturalearthdata'## The following object is masked from 'package:rnaturalearth':
##
## countries110library(sf)
library(ggspatial)
library(dplyr)
library(reshape2)
library(ggcorrplot)
library(ggforce)
library(readxl)
library(gridExtra)
library(plotly)world <- ne_countries(scale = "medium", returnclass = "sf")
ggplot(data = world) +
geom_sf()
ggplot(data = world) +
geom_sf(aes(fill = pop_est)) +
scale_fill_viridis_c(option = "inferno")
spasial <- read.csv("C:/Users/DEVINA/Downloads/2019.csv")
world_map <- map_data("world")
colnames(spasial)[colnames(spasial) == "Country.Territory"] <- "region"
merged_data <- left_join(world_map, spasial, by = c("region" = "Country.or.region"))
ggplot(merged_data, aes(x = long, y = lat, group = group, fill = `Healthy.life.expectancy`)) +
geom_polygon(color = "black") +
scale_fill_gradient(name = "Population (2019)", low = "pink", high = "red", guide = "legend") +
theme_void() +
labs(title = "Healthy Life Expectancy 2019")
Interpretasi
Pada map chart di atas dapat dilihat bahwa negara yang terisi dengan warna merah gelap merupakan negara dengan healthy life expectancy yang tinggi sebesar 0.9. Lalu negara dengan warna pink merupakan negara dengan healthy life expectancy yang rendah. sementara itu negara yang terisi dengan warna abu-abu menandakan adanyak ketidaksesuaian dalam format nama negata dengan data yang seharusnya.