Report HomeBudget

What

Tentukan tujuan atau informasi yang ingin ditampilkan dalam dashboard

Jawab Dashboard Expense Keluarga Ropii

Tujuan yang ingin dicapai atau informasi yang ingin disampaikan:

• Mengetahui komposisi pengeluaran biaya keluarga Ropii
• Mengetahui dan mengontrol biaya terbanyak yang dikeluarkan
• kategori dan subkategori apa yang mengeluarkan biaya terbanyak
• Biaya yang yang perlu dikontrol atau dikurangi dan ditingkatkan

Who

Untuk siapa dashboard ini dibuat? Siapa target pembaca dari dashboard ini?

Jawab

untuk saya sendiri, anggota keluarga dan khalayak yang sedang belajar

Why

Apakah data yang dibuat relevan atau sesuai dengan tujuan? Mengapa?

Jawab

relevan dengan tanggal dan kebutuhan kontrol biaya

When

Apakah data yang digunakan masih up to date atau masih relevan dengan kondisi sekarang? Apakah ada informasi tentang tanggal update terakhir dari data tersebut?

Jawab

tahun 2015 - 2019

How

Bagaimana Bapak/Ibu menggunakan visualisasi untuk menjawab tujuan yang telah disebutkan?

Buat plot yang akan dimasukkan ke dalam dashboard. Boleh dalam bentuk ggplot maupun plotly.

Jawab

library(readr)
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

menyiapkan data

report <- read_csv("Report HB.csv")

## Parsed with column specification:
## cols(
##   Date = col_date(format = ""),
##   Category = col_character(),
##   SubCategory = col_character(),
##   `Expense Amount` = col_number(),
##   Account = col_logical(),
##   Payee = col_character(),
##   Notes = col_character(),
##   Device = col_character()
## )

## Warning: 489 parsing failures.
## row   col           expected actual            file
##  29 Notes delimiter or quote        'Report HB.csv'
##  53 Notes delimiter or quote        'Report HB.csv'
##  53 Notes delimiter or quote        'Report HB.csv'
## 142 Notes delimiter or quote        'Report HB.csv'
## 146 Notes delimiter or quote        'Report HB.csv'
## ... ..... .................. ...... ...............
## See problems(...) for more details.

report

report1 <- select(report, -Account, -Payee)
report1

1. Kategori apa yang menempati jumlah terbanyak di Feb 2018 ?
2. SubCategory apa yang jumlahnya paling banyak di Februari 2018 ?
3. Dari SubCategory yang jumlahnya paling banyak di Februari 2018, ada di Notes apa ?
4. Kategori apa yang menempati jumlah terbanyak di tahun 2018 ?

library(lubridate)

## 
## Attaching package: 'lubridate'

## The following object is masked from 'package:base':
## 
##     date

library(scales)

## 
## Attaching package: 'scales'

## The following object is masked from 'package:readr':
## 
##     col_factor

report1 <- report1 %>% 
  mutate(tahun = year(Date), bulan = month(Date, label = T))
head(report1)

report2 <- filter(report1, bulan == "Feb", tahun == "2018" )
report2

report3 <- group_by(report2, Category) %>% 
   summarise(total_expense_amount = sum(`Expense Amount`)) %>% 
   na.omit()
report4 <- report3 %>% 
   mutate(total_expense_amount = total_expense_amount/100)
report4

library(ggplot2)
theme_algoritma <- theme(legend.key = element_rect(fill="black"),
           legend.background = element_rect(color="white", fill="#263238"),
           plot.subtitle = element_text(size=6, color="white"),
           panel.background = element_rect(fill="#dddddd"),
           panel.border = element_rect(fill=NA),
           panel.grid.minor.x = element_blank(),
           panel.grid.major.x = element_blank(),
           panel.grid.major.y = element_line(color="darkgrey", linetype=2),
           panel.grid.minor.y = element_blank(),
           plot.background = element_rect(fill="#263238"),
           text = element_text(color="white"),
           axis.text = element_text(color="white")
           
           )

library(plotly)

## 
## 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

# your code here
library(glue)

## 
## Attaching package: 'glue'

## The following object is masked from 'package:dplyr':
## 
##     collapse

plot1 <- ggplot(report4, mapping = aes(x = reorder(Category, total_expense_amount),
                                       y = total_expense_amount,
                                       text = glue("Category:{Category}
                                       Total Expense:{total_expense_amount}"))) +
   geom_col(fill = "Green4") +
   geom_col(data = filter(report4, Category == "TABUNGAN"),
   fill = "firebrick4") +
   labs(x = NULL,
        y = NULL,
        title = "EXPENSE IN CATEGORY") +
   scale_y_continuous(labels = unit_format(unit = "IDR", scale = 1.0)) +
coord_flip() +
   theme_algoritma

plot1_inter <- ggplotly(plot1, tooltip = "text")

report5 <- group_by(report2, SubCategory) %>% 
  summarise(total_expense_amount = sum(`Expense Amount`)) %>% 
na.omit()
report6 <- report5 %>% 
   mutate(total_expense_amount = total_expense_amount/100)

report7 <- report6[report6$total_expense_amount > 500000,]
head(report7, 7)

Plot untuk menjawab tujuan kedua

theme_algoritma_2 <- theme(legend.key = element_rect(fill="black"),
           legend.background = element_rect(color="white", fill="#263238"),
           plot.subtitle = element_text(size=12, color="white"),
           panel.background = element_rect(fill="#dddddd"),
           panel.border = element_rect(fill=NA),
           panel.grid.minor.x = element_blank(),
           panel.grid.major.x = element_blank(),
           panel.grid.major.y = element_line(color="darkgrey", linetype=2),
           panel.grid.minor.y = element_blank(),
           plot.background = element_rect(fill="#263238"),
           text = element_text(color="white"),
           axis.text = element_text(color="white")
           
           )

# your code here
plot2 <- ggplot(report7, mapping = aes(x = reorder(SubCategory, total_expense_amount),
                              y = total_expense_amount,
                              text = glue("SubCategory:{SubCategory}
                                          Total Expense:{total_expense_amount}"))) +
  geom_col(fill = "Blue") +
  geom_col(data = filter(report7, SubCategory == "Orang Tua"),
           fill = "gold") +
  labs(x = NULL,
       y = NULL,
       title = "EXPENSE IN SUBCATEGORY") +
   scale_y_continuous(labels = unit_format(unit = "IDR", scale = 0.01)) +
coord_flip()+
   theme_algoritma_2
plot2

plot2_inter <- ggplotly(plot2, tooltip = "text")

Arrange

library(ggpubr)

## Loading required package: magrittr

pub <- ggarrange(plot1,plot2, nrow = 2)
pub

subplot(plot1_inter, plot2_inter, nrows = 2, shareY = FALSE)

subplot

## function (..., nrows = 1, widths = NULL, heights = NULL, margin = 0.02, 
##     shareX = FALSE, shareY = FALSE, titleX = shareX, titleY = shareY, 
##     which_layout = "merge") 
## {
##     plots <- dots2plots(...)
##     for (i in seq_along(plots)) {
##         if (!is.null(plots[[i]][["frames"]])) {
##             warning(sprintf("`subplot()` detected plot #%s was 'pre-built' and already has registered\n", 
##                 i), "animation frames. This can cause problems and may happen by calling a \n", 
##                 "function like `animation_opts()` or `highlight()` (which returns a 'built' plot)\n", 
##                 "_before_ `subplot()`. Consider using such functions _after_ `subplot()`.", 
##                 call. = FALSE)
##         }
##     }
##     plotz <- lapply(plots, function(d) plotly_build(d, registerFrames = FALSE)[["x"]])
##     plots <- list()
##     for (i in seq_along(plotz)) {
##         p <- plots[[i]] <- plotz[[i]]
##         layoutAttrs <- c(names(p$layout), c("mapbox", "geo", 
##             "xaxis", "yaxis"))
##         xTraceAttrs <- sub("^x", "xaxis", sapply(p$data, function(tr) tr[["subplot"]] %||% 
##             tr[["geo"]] %||% tr[["xaxis"]] %||% "x"))
##         yTraceAttrs <- sub("^y", "yaxis", sapply(p$data, function(tr) tr[["subplot"]] %||% 
##             tr[["geo"]] %||% tr[["yaxis"]] %||% "y"))
##         missingAttrs <- setdiff(c(xTraceAttrs, yTraceAttrs), 
##             layoutAttrs)
##         if (!length(missingAttrs)) 
##             next
##         missingTraces <- xTraceAttrs %in% missingAttrs | yTraceAttrs %in% 
##             missingAttrs
##         plots[[i]]$data[missingTraces] <- NULL
##         for (j in missingAttrs) {
##             newPlot <- list(data = p$data[xTraceAttrs %in% j | 
##                 yTraceAttrs %in% j], layout = p$layout)
##             newPlot$data <- lapply(newPlot$data, function(tr) {
##                 for (k in c("mapbox", "geo", "xaxis", "yaxis")) {
##                   tr[[k]] <- sub("[0-9]+", "", tr[[k]]) %||% 
##                     NULL
##                 }
##                 tr
##             })
##             plots <- c(plots, list(newPlot))
##         }
##     }
##     traces <- lapply(plots, "[[", "data")
##     layouts <- lapply(plots, "[[", "layout")
##     shapes <- lapply(layouts, "[[", "shapes")
##     images <- lapply(layouts, "[[", "images")
##     annotations <- lapply(layouts, function(x) {
##         axes <- vapply(x$annotations, function(a) identical(a$annotationType, 
##             "axis"), logical(1))
##         x$annotations[!axes]
##     })
##     xAxes <- lapply(layouts, function(lay) {
##         keys <- grep("^geo|^mapbox|^xaxis", names(lay), value = TRUE) %||% 
##             "xaxis"
##         for (k in keys) {
##             dom <- lay[[k]]$domain %||% c(0, 1)
##             if ("x" %in% names(dom)) 
##                 dom <- dom[["x"]]
##         }
##         lay[keys]
##     })
##     yAxes <- lapply(layouts, function(lay) {
##         keys <- grep("^geo|^mapbox|^yaxis", names(lay), value = TRUE) %||% 
##             "yaxis"
##         for (k in keys) {
##             dom <- lay[[k]]$domain %||% c(0, 1)
##             if ("y" %in% names(dom)) 
##                 dom <- dom[["y"]]
##         }
##         lay[keys]
##     })
##     if (!titleX) {
##         xAxes <- lapply(xAxes, function(ax) lapply(ax, function(y) {
##             y$title <- NULL
##             y
##         }))
##     }
##     if (!titleY) {
##         yAxes <- lapply(yAxes, function(ax) lapply(ax, function(y) {
##             y$title <- NULL
##             y
##         }))
##     }
##     xAxisN <- vapply(xAxes, length, numeric(1))
##     yAxisN <- vapply(yAxes, length, numeric(1))
##     ncols <- ceiling(length(plots)/nrows)
##     xAxisID <- seq_len(sum(xAxisN))
##     if (shareX) {
##         if (length(unique(xAxisN)) > 1) {
##             warning("Must have a consistent number of axes per 'subplot' to share them.")
##         }
##         else {
##             xAxisID <- rep(rep(seq_len(ncols * unique(xAxisN)), 
##                 length.out = length(plots)), unique(xAxisN))
##         }
##     }
##     yAxisID <- seq_len(sum(yAxisN))
##     if (shareY) {
##         if (length(unique(yAxisN)) > 1) {
##             warning("Must have a consistent number of axes per 'subplot' to share them.")
##         }
##         else {
##             yAxisID <- rep(rep(seq_len(nrows * unique(xAxisN)), 
##                 each = ncols, length.out = length(plots)), unique(yAxisN))
##         }
##     }
##     xCurrentNames <- unlist(lapply(xAxes, names))
##     yCurrentNames <- unlist(lapply(yAxes, names))
##     xNewNames <- paste0(sub("[0-9]+$", "", xCurrentNames), sub("^1$", 
##         "", xAxisID))
##     yNewNames <- paste0(sub("[0-9]+$", "", yCurrentNames), sub("^1$", 
##         "", yAxisID))
##     xAxisMap <- setNames(xCurrentNames, xNewNames)
##     yAxisMap <- setNames(yCurrentNames, yNewNames)
##     xAxisMap <- split(xAxisMap, rep(seq_along(plots), xAxisN))
##     yAxisMap <- split(yAxisMap, rep(seq_along(plots), yAxisN))
##     domainInfo <- get_domains(length(plots), nrows, margin, widths = widths, 
##         heights = heights)
##     for (i in seq_along(plots)) {
##         xMap <- xAxisMap[[i]]
##         yMap <- yAxisMap[[i]]
##         xAxes[[i]] <- setNames(xAxes[[i]], names(xMap))
##         yAxes[[i]] <- setNames(yAxes[[i]], names(yMap))
##         for (j in seq_along(xAxes[[i]])) {
##             if (grepl("^geo|^mapbox", names(xAxes[[i]][j]))) 
##                 next
##             map <- yMap[yMap %in% sub("y", "yaxis", xAxes[[i]][[j]]$anchor %||% 
##                 "y")]
##             xAxes[[i]][[j]]$anchor <- sub("axis", "", names(map))
##         }
##         for (j in seq_along(yAxes[[i]])) {
##             if (grepl("^geo|^mapbox", names(yAxes[[i]][j]))) 
##                 next
##             map <- xMap[xMap %in% sub("x", "xaxis", yAxes[[i]][[j]]$anchor %||% 
##                 "x")]
##             yAxes[[i]][[j]]$anchor <- sub("axis", "", names(map))
##         }
##         for (key in c("geo", "subplot", "xaxis", "yaxis")) {
##             oldAnchors <- unlist(lapply(traces[[i]], "[[", key))
##             if (!length(oldAnchors)) 
##                 next
##             axisMap <- if (key == "yaxis") 
##                 yMap
##             else xMap
##             axisMap <- setNames(sub("axis", "", axisMap), sub("axis", 
##                 "", names(axisMap)))
##             newAnchors <- names(axisMap)[match(oldAnchors, axisMap)]
##             traces[[i]] <- Map(function(tr, a) {
##                 tr[[key]] <- a
##                 tr
##             }, traces[[i]], newAnchors)
##             ref <- list(xaxis = "xref", yaxis = "yref")[[key]]
##             if (is.null(ref)) 
##                 next
##             bump_axis_ref <- function(obj, ref_default = sub("ref", 
##                 "", ref)) {
##                 obj[[ref]] <- obj[[ref]] %||% ref_default
##                 if (identical(obj[[ref]], "paper")) 
##                   return(obj)
##                 refIdx <- match(obj[[ref]], axisMap)
##                 if (!is.na(refIdx)) 
##                   obj[[ref]] <- names(axisMap)[refIdx][1]
##                 obj
##             }
##             annotations[[i]] <- lapply(annotations[[i]], bump_axis_ref)
##             shapes[[i]] <- lapply(shapes[[i]], bump_axis_ref)
##             images[[i]] <- lapply(images[[i]], bump_axis_ref, 
##                 "paper")
##         }
##         xDom <- as.numeric(domainInfo[i, c("xstart", "xend")])
##         yDom <- as.numeric(domainInfo[i, c("yend", "ystart")])
##         reScale <- function(old, new) {
##             sort(scales::rescale(old %||% c(0, 1), new, from = c(0, 
##                 1)))
##         }
##         xAxes[[i]] <- lapply(xAxes[[i]], function(ax) {
##             if (all(c("x", "y") %in% names(ax$domain))) {
##                 ax$domain$x <- reScale(ax$domain$x, xDom)
##                 ax$domain$y <- reScale(ax$domain$y, yDom)
##             }
##             else {
##                 ax$domain <- reScale(ax$domain, xDom)
##             }
##             ax
##         })
##         yAxes[[i]] <- lapply(yAxes[[i]], function(ax) {
##             if (all(c("x", "y") %in% names(ax$domain))) {
##                 ax$domain$x <- reScale(ax$domain$x, xDom)
##                 ax$domain$y <- reScale(ax$domain$y, yDom)
##             }
##             else {
##                 ax$domain <- reScale(ax$domain, yDom)
##             }
##             ax
##         })
##     }
##     p <- list(data = unlist(traces, recursive = FALSE), layout = Reduce(modify_list, 
##         c(xAxes, rev(yAxes))))
##     annotations <- Map(reposition, annotations, split(domainInfo, 
##         seq_along(plots)))
##     shapes <- Map(reposition, shapes, split(domainInfo, seq_along(plots)))
##     images <- Map(reposition, images, split(domainInfo, seq_along(plots)))
##     p$layout$annotations <- unlist(annotations, recursive = FALSE)
##     p$layout$shapes <- unlist(shapes, recursive = FALSE)
##     p$layout$images <- unlist(images, recursive = FALSE)
##     layouts <- lapply(layouts, function(x) {
##         x[!grepl("^[x-y]axis|^geo|^mapbox|annotations|shapes|images", 
##             names(x))] %||% list()
##     })
##     if (which_layout != "merge") {
##         if (!is.numeric(which_layout)) 
##             warning("which_layout must be numeric")
##         if (!all(idx <- which_layout %in% seq_along(plots))) {
##             warning("which_layout is referencing non-existant layouts")
##             which_layout <- which_layout[idx]
##         }
##         layouts <- layouts[which_layout]
##     }
##     p$attrs <- unlist(lapply(plots, "[[", "attrs"), recursive = FALSE)
##     p$layout <- Reduce(modify_list, layouts, p$layout)
##     p$source <- ensure_one(plots, "source")
##     p$config <- ensure_one(plots, "config")
##     p$highlight <- ensure_one(plots, "highlight")
##     p$data <- colorway_retrain(p$data, p$layout$colorway %||% 
##         colorway())
##     p$subplot <- TRUE
##     as_widget(p)
## }
## <bytecode: 0x000000000e1543f8>
## <environment: namespace:plotly>

# your code here
library(flexdashboard)

Buat chunk baru apabila ada lebih dari 3 plot.

Where

Bagaimana desain layout atau tata letak dashboard yang akan dibuat?

Jawab

Contoh penulisan layout.

Tab atau halaman pertama

Tab atau halaman kedua