第 5 章 Programming

5.1 Pipe

範例1
threeHeigths <- c(Gary=178, John=182, Cam=175)

• 先排序由大到小，

• 接著取出第一個位置的人名

# 先排序由大到小，
sort(threeHeigths, decreasing=T) -> sorted_heights

# 把排好的人名取出
names(sorted_heights) -> sorted_persons

# 接著取出第一個位置的人名
sorted_persons[[1]] -> highestPerson

names(sort(threeHeigths, decreasing = T))[[1]] -> highestPerson

library(magrittr)

sort(threeHeigths, decreasing=T) %>%
names(.) %>%
.[[1]] -> highestPerson
• -> 中間物件 換成%>%

• 再把其他有用到中間物件的位置換成.

5.1.1 原則

Pipe原則：

f(w) -> x
g(x) -> y
h(y) -> z

f(w) %>%
g(.) %>%
h(.) -> z

w %>%
f(.) %>%
g(.) %>%
h(.) -> z

%>% 把左邊產生的output，接過去成為下一段函數的input

範例2
# 由cities創出每個元素對應的北部、東部、中部region factor
cities <- factor(c("台北","花蓮","台東","台中"))
levels(cities)
region <- cities

# 以下為一連串的pipe operation
levels(region) -> currentLevels
str_replace(currentLevels,"台北","北部") -> currentLevels1
str_replace(currentLevels1,"花蓮|台東","東部") -> currentLevels2
str_replace(currentLevels2,"台中","中部") -> regionLevels
regionLevels -> levels(region)
levels(region) %>%
str_replace(.,"台北","北部") %>%
str_replace(.,"花蓮|台東","東部") %>%
str_replace(.,"台中","中部") ->
levels(region)

5.1.2 元素粹取

example是第一個input，而name是第二個input。

num <- c(2,97,22,15,7)

# 選出大於50的數字
(num > 50) -> pick_big
num[pick_big]
(num > 50) %>%
num[.]

5.1.3 執行順序

R在面對pipe時會先把pipe走完最後才去做值assign給最後物件的動作，例如：

threeHeights %>%
.sort(., decreasing=T) %>%
names(.) %>%
.[[1]] -> highestPerson

pipe部份為

.sort(threeHeigths, decreasing=T) %>%
names(.) %>%
.[[1]]

highestPerson <-
threeHeights %>%
.sort(., decreasing=T) %>%
names(.) %>%
.[[1]]

5.1.4.省略原則

levels(region) %>%
str_replace(.,"台北","北部") %>%
str_replace(.,"花蓮|台東","東部") %>%
str_replace(.,"台中","中部") ->
levels(region)

levels(region) %>%
str_replace("台北","北部") %>%
str_replace("花蓮|台東","東部") %>%
str_replace("台中","中部") ->
levels(region)

# 資料
population <- c(cityA=500,cityB=1500, cityC=399)
cities <- c("cityA","cityA","cityB","cityB","cityC")

# 分析步驟
names(sort(population)) -> setLevels
factor(cities, levels = setLevels) -> cities 

population %>%
names(sort(.)) %>%
factor(cities, levels=.) -> cities

population %>% names(sort(.))

%>%是把population放到names()的input裡，而非sort()，但names()的input位置已被sort佔走。要改成

population %>%
sort() %>%
names() %>%
factor(cities, levels=.) -> cities

5.1.5 串接非單純函數程序

範例3
dataList <- list(
num=c(2,97,22,15,7),
chr=c("2","97","22","15","7")
)

map(dataList, is.numeric) -> results
unlist(results) -> pick_numeric

dataList[pick_numeric] -> num_element
(num_element[[1]] > 50) -> pick_big
num_element[[1]][pick_big] -> bigNumber
map(dataList, is.numeric) %>%
unlist(.) %>%

dataList[.] %>%
{(.[[1]] > 50)} %>%
num_element[[1]][.] -> bigNumber
5.1.5.0.0.1 範例4
population %>%
names(sort(.)) %>%
factor(cities, levels=.) -> cities
population %>%
{names(sort(.))} %>%
factor(cities, levels=.) -> cities

5.1.6 綜合練習

jsonlite::fromJSON("https://od.cdc.gov.tw/eic/Day_Confirmation_Age_County_Gender_19CoV.json") -> covid19

jsonlite::fromJSON(
"https://www.dropbox.com/s/jckqryeh5zeat5w/regionPopulation.json?dl=1"
) -> population
unlist(population) -> population

covid19$縣市 <- factor(covid19$縣市)

levels(covid19$縣市) -> levelsInData population[levelsInData] -> population population <- sort(population, decreasing=T) population newLevels <- names(population) newLevels covid19$縣市 <-
factor(
covid19$縣市, levels=newLevels ) levels(covid19$縣市)

5.2 Function

5.2.1 需求函數

$q_d=10-5p$

# p=1.2的需求量
p=1.2
qd <- 10-5*p # 小心是5*p, 不能寫5p
# p=1.3的需求量
p=1.3
qd <- 10-5*p
# p=1.4的需求量
p=1.4
qd <- 10-5*p

• p=1.2, p=1.3, p=1.4

• qd <- 10-5*p

demand <- # 創造一個物件叫demand
function(p){ # 定義這個物件為函數
q_d <- 10-5*p # 小心是5*p, 不能寫5p
}
# p=1.2的需求量
demand(1.2)
# p=1.3的需求量
demand(1.3)
# p=1.4的需求量
demand(1.4)

return

demand_return <-
function(p){
q_d <- 10-5*p
return(q_d)
}
# 印在螢幕，但Global Environment並不會有q_d
demand_return(1.2)
## [1] 4

.Last.value
# 要長久存在Global Environment要指定物件名稱（不要求與q_d同名）
demand_return(1.2) -> q_d1.2

demand_return(1.2) # 相當於
4
## [1] 4
## [1] 4
demand_return(1.2) -> q_d1.2 # 相當於
4 -> q_d1.2
• return(q_d)只會回傳q_d的「值」但不會回傳整個q_d物件在global environment裡。

• 實際上，{...}裡所創造的物件都只是「暫時的」且「不放在global environment」，函數運作完就刪除，所以global environment裡就算有同名物件，也不會因函數運作而被不小心更動。

q_d <- 5
demand_return(p=1.2)

print(q_d)

5.2.2 今日天氣

Silly需要知道什麼：

• 日期、地點
dateInput <- today()
locationInput <- "新北市"

Silly找答案的策略：

• 政府開放資料平台：
jsonlite::fromJSON("https://opendata.cwb.gov.tw/fileapi/v1/opendataapi/F-C0032-001?Authorization=rdec-key-123-45678-011121314&format=JSON") ->
weather_next36hours
• 給定日期，地點找出預報資訊
# 找出符合地點的天氣資訊：weatherAtLocation
(weather_next36hours$cwbopendata$dataset$location$locationName == locationInput) -> pick_location # 可挑出locationInput的「要/不要」向量

weather_next36hours$cwbopendata$dataset$location$weatherElement[pick_location][[1]] -> weatherAtLocation

# 在weatherAtLocation找出符合時間的天氣資訊

(weatherAtLocation$elementName=="MaxT") -> pick_MaxT (weatherAtLocation$elementName=="MinT") ->
pick_MinT
weatherAtLocation$time[pick_MaxT][[1]]$parameter$parameterName[[1]] -> maxT weatherAtLocation$time[pick_MinT][[1]]$parameter$parameterName[[1]] -> minT

glue::glue("{locationInput} {dateInput} 氣溫，最高{maxT}度，最低{minT}度。")

askSilly_weather <- function(locationInput,dateInput){
jsonlite::fromJSON("https://opendata.cwb.gov.tw/fileapi/v1/opendataapi/F-C0032-001?Authorization=rdec-key-123-45678-011121314&format=JSON") ->
weather_next36hours

(weather_next36hours$cwbopendata$dataset$location$locationName == locationInput) -> pick_location

weather_next36hours$cwbopendata$dataset$location$weatherElement[pick_location][[1]] -> weatherAtLocation
(weatherAtLocation$elementName=="MaxT") -> pick_MaxT (weatherAtLocation$elementName=="MinT") ->
pick_MinT
weatherAtLocation$time[pick_MaxT][[1]]$parameter$parameterName[[1]] -> maxT weatherAtLocation$time[pick_MinT][[1]]$parameter$parameterName[[1]] -> minT

glue::glue("{locationInput} {dateInput} 氣溫，最高{maxT}度，最低{minT}度。")
}
askSilly_weather("臺中市",today())
askSilly_weather("花蓮縣",today())

what_time_it_is("Europe/Paris")

5.2.3 函數的組成

class(demand_return)
# 查詢函數formals arguments要求
formals(askSilly_weather)
## $locationInput ## ## ##$dateInput
# 查詢函數主體
body(askSilly_weather)
## {
##     weather_next36hours <- jsonlite::fromJSON("https://opendata.cwb.gov.tw/fileapi/v1/opendataapi/F-C0032-001?Authorization=rdec-key-123-45678-011121314&format=JSON")
##     pick_location <- (weather_next36hours$cwbopendata$dataset$location$locationName ==
##         locationInput)
##     weatherAtLocation <- weather_next36hours$cwbopendata$dataset$location$weatherElement[pick_location][[1]]
##     pick_MaxT <- (weatherAtLocation$elementName == "MaxT") ## pick_MinT <- (weatherAtLocation$elementName == "MinT")
##     maxT <- weatherAtLocation$time[pick_MaxT][[1]]$parameter$parameterName[[1]] ## minT <- weatherAtLocation$time[pick_MinT][[1]]$parameter$parameterName[[1]]
##     glue::glue("{locationInput} {dateInput} 氣溫，最高{maxT}度，最低{minT}度。")
## }

learning_topics <-
list(
subject="函數",
date=lubridate::ymd("2020-06-03"),
functionsCreated=list(
demand=demand_return # 等號右邊是呼叫demand_return的定義值，也就是function(...){...}值定義本身。
)
)
learning_topics$functionsCreated$demand(1.2)

5.2.4 Environment

typeof(demand_return)
## [1] "closure"

function本身的運作並不能只靠它的定義值function(...){...}，還要有適當的環境（environment）條件才能生存。若物件的生存運作需要有適當的環境，表示電腦要存這個物件時還需要包含（enclose）它的（生存）環境一起存。這種儲存型態叫closure（閉包）。

# 查詢函數執行所要求環境
environment(demand_return)
## <environment: R_GlobalEnv>
# 若函數執行需要Global environment已存在某些物件，查詢需要哪些物件
codetools::findGlobals(demand_return)
## [1] "-"      "{"      "*"      "<-"     "return"
intercept <- 10
slope <- -5
myDemand <- function(p){
q_d <- intercept + slope*p
return(q_d)
}
environment(demand_return)
environment(myDemand)
codetools::findGlobals(demand_return)
codetools::findGlobals(myDemand)

# myDemand對Global environment的要求多了intercept及slope
# 移除global environment裡的intercept及slope
rm(intercept, slope)
demand_return(1.2) # 維持正常運作
myDemand(1.2) # 無法運作

myDemand的運作需要global environment裡的intercept, slope物件。這表示

• 沒有intercept, slope在global environment裡它無法運作。

• global environment裡的intercept, slope值若有改變，它的運作結果也會不同。(這種「要運作才去呼叫值」的特性叫Lazy evaluation，惰性求值)

intercept <- 10
slope <- -5
myDemand(1.2)
slope <- -1
myDemand(1.2)
intercept <- 5
slope <- -1.2
myDemand(1.2)

5.2.5 預設值

• 具有隨時可改變運作狀態的彈性； 但

• 該工具若落在電腦知識不足的使用者手上會有誤動global environment而產生運作錯誤的危機。

myDemand2 <- function(p, intercept=10, slope=-5){
q_d <- intercept + slope*p
return(q_d)
}
environment(myDemand2)
findGlobals(myDemand2) # 不依靠global env裡的intercept/slope
myDemand2(1.2)
myDemand2(1.2, slope=-1)
myDemand2(1.2, intercept=5, slope=-1.2)

5.2.6 綜合練習

library(httr)
library(magrittr)
route <- "916"

GET(glue::glue("https://ptx.transportdata.tw/MOTC/v2/Bus/EstimatedTimeOfArrival/City/NewTaipei/{route}?$top=30&$format=JSON")) %>%
content -> estimatedArrivalTime

GET(glue::glue("https://ptx.transportdata.tw/MOTC/v2/Bus/Route/City/NewTaipei/{route}?$top=30&$format=JSON")) %>%
content -> routeInfo

when_busArrives("916","臺北大學正門")
when_busArrives("939","學勤路")

5.3 Conditional Execution

5.3.1 if

• 用在「某個條件符合才執行」的狀況。
if(condition){
Body for TRUE
}
• condition: 它是個「是/否」問句。 (使用條件判斷來產生答案T/F，是個logical。)

readline()在Rmd裡只有當它單獨執行時才能正常運作，因為readline是個即時互動（interactive）函數，Rmd不是個即時互動環境。

# 先執行此行輸入學號

# rstudioapi::showPrompt(title="學號驗證",message="請輸入你的學號") -> studentId

# 之後才執行以下程式
if(
str_detect(studentId,'^[43](1[01][0-9]|9[0-9])[0-9]{5}$',negate=T) # condition: 是否輸入學號正確？ ) { warning("你所輸入的學號不正確") } 確認使用者有安裝需要套件 if(!require(lubridate)){ # condition: 是否「沒安裝lubridate」？ install.packages("lubridate") } lubridate::ymd_hms("2020-07-01 13:00:00 GMT") 一節，我們可以把它形成一個 twDate <- c("民國108年12月5日","民國98年10月5日") library(stringr) # 準備regex: ## 取出：「前有」民國，「後有」年的「數字」「們」 ## "(?<={A_regex}){target_regex}(?={B_regex})" target_regex <- "[0-9]+" A_regex <- "民國" B_regex <- "年" regex_pattern <- glue::glue( "(?<={A_regex}){target_regex}(?={B_regex})" ) print(regex_pattern) ## 如果同學已經很熟就可以直接寫 regex_pattern <- "(?<=民國)[0-9]+(?=年)" # 取出民國年，計算西元年 year <- str_extract( twDate, regex_pattern) westernYear <- as.integer(year)+1911 # 替換民國xx年的xx成西元年數字 str_replace( twDate, regex_pattern, # 要換掉的文字 as.character(westernYear) # 要替換的內容 ) -> twDate_reformat print(twDate_reformat) lubridate::ymd(twDate_reformat) convert_TaiwanDate2WesternDate()函數： convert_TaiwanDate2WesternDate <- function(twDate){ library(stringr) regex_pattern <- "(?<=民國)[0-9]+(?=年)" # 取出民國年，計算西元年 year <- str_extract( twDate, regex_pattern) westernYear <- as.integer(year)+1911 # 替換民國xx年的xx成西元年數字 str_replace( twDate, regex_pattern, # 要換掉的文字 as.character(westernYear) # 要替換的內容 ) -> twDate_reformat lubridate::ymd(twDate_reformat) -> westernDate return(westernDate) } twDate <- c("民國108年12月5日","民國98年10月5日") convert_TaiwanDate2WesternDate(twDate) 這函數需要stringr及lubridate convert_TaiwanDate2WesternDate <- function(twDate){ if(!require("stringr")){ install.packages("stringr") } if(!require("lubridate")){ install.packages("lubridate") } library(stringr) regex_pattern <- "(?<=民國)[0-9]+(?=年)" # 取出民國年，計算西元年 year <- str_extract( twDate, regex_pattern) westernYear <- as.integer(year)+1911 # 替換民國xx年的xx成西元年數字 str_replace( twDate, regex_pattern, # 要換掉的文字 as.character(westernYear) # 要替換的內容 ) -> twDate_reformat lubridate::ymd(twDate_reformat) -> westernDate return(westernDate) } 1. 寫一個check_package(pkgName)函數，它會檢查使用者是否有安裝pkgName值（class character，length=1）的套件，如果沒有就安裝 # 測試 check_package("clipr") check_package("SOAR") 1. check_package()一次只能偵測一個套件是否有安裝。寫一個check_packages(pkgNames) (packages是複數)，它以給pkgNames input, pkgNames為class character, length任意。 # 測試 check_packages(c("clipr","SOAR")) 1. 將convert_TaiwanDate2WesternDate的body有關套件檢查的部份改成你設計的check_package/check_packages。 先前的，如果使用者 askSilly_weather <- function(locationInput,dateInput){ jsonlite::fromJSON("https://opendata.cwb.gov.tw/fileapi/v1/opendataapi/F-C0032-001?Authorization=rdec-key-123-45678-011121314&format=JSON") -> weather_next36hours (weather_next36hours$cwbopendata$dataset$location$locationName == locationInput) -> pick_location weather_next36hours$cwbopendata$dataset$location$weatherElement[pick_location][[1]] -> weatherAtLocation (weatherAtLocation$elementName=="MaxT") ->
pick_MaxT
(weatherAtLocation$elementName=="MinT") -> pick_MinT weatherAtLocation$time[pick_MaxT][[1]]$parameter$parameterName[[1]] -> maxT
weatherAtLocation$time[pick_MinT][[1]]$parameter$parameterName[[1]] -> minT glue::glue("{locationInput} {dateInput} 氣溫，最高{maxT}度，最低{minT}度。") } • 沒有安裝jsonlite；或 • 縣市裡的「臺」使用簡體「台」 都會產生錯誤訊息。請修改askSilly_weather讓使用者不關有沒有安裝jsonlite或使用簡體「台」都沒問題。 不重覆下載 # 檢視步驟耗時elapse time system.time( jsonlite::fromJSON("https://opendata.cwb.gov.tw/fileapi/v1/opendataapi/F-C0032-001?Authorization=rdec-key-123-45678-011121314&format=JSON") -> weather_next36hours ) if(!exists("weather_next36hours")){ jsonlite::fromJSON("https://opendata.cwb.gov.tw/fileapi/v1/opendataapi/F-C0032-001?Authorization=rdec-key-123-45678-011121314&format=JSON") -> weather_next36hours SOAR::Store(weather_next36hours) # 存在.R_cache environment中 } SOAR::Store(weather_next36hours) • 創造一個.R_Cache環境並把weather_next36hours移到那裡放。 askSilly_weather2 <- function(locationInput,dateInput){ if(!exists("weather_next36hours")){ jsonlite::fromJSON("https://opendata.cwb.gov.tw/fileapi/v1/opendataapi/F-C0032-001?Authorization=rdec-key-123-45678-011121314&format=JSON") -> weather_next36hours SOAR::Store(weather_next36hours) # 存在.R_cache environment中 } (weather_next36hours$cwbopendata$dataset$location$locationName == locationInput) -> pick_location weather_next36hours$cwbopendata$dataset$location$weatherElement[pick_location][[1]] -> weatherAtLocation (weatherAtLocation$elementName=="MaxT") ->
pick_MaxT
(weatherAtLocation$elementName=="MinT") -> pick_MinT weatherAtLocation$time[pick_MaxT][[1]]$parameter$parameterName[[1]] -> maxT
student_i_time <- examSubmissionTime$time[[i]] ===流程分歧點開始=== deadline <- lubridate::ymd_hms("2020-05-27 15:00:00", tz="Asia/Taipei")  deadline <- lubridate::ymd_hms("2020-05-27 17:00:00", tz="Asia/Taipei")  ===流程分歧點結束=== howEarly <- deadline - lubridate::ymd_hms(student_i_time, tz="Asia/Taipei") print(howEarly) 使用if…else控制情境分歧 Condition設計： student_i_section=="56" if…else…組合： i<-1 student_i_section <- examSubmissionTime$section[[i]]
student_i_time <- examSubmissionTime$time[[i]] if(student_i_section=="56"){ deadline <- lubridate::ymd_hms("2020-05-27 15:00:00", tz="Asia/Taipei") } else { deadline <- lubridate::ymd_hms("2020-05-27 17:00:00", tz="Asia/Taipei") } howEarly <- deadline - lubridate::ymd_hms(student_i_time, tz="Asia/Taipei") print(howEarly) 我們可以使用function＋map算出每位同學提早時間： compute_howEarly <- function(student_i_section, student_i_time){ # student_i_section <- examSubmissionTime$section[[i]]
# student_i_time <- examSubmissionTime$time[[i]] if(student_i_section=="56"){ deadline <- lubridate::ymd_hms("2020-05-27 15:00:00", tz="Asia/Taipei") } else { deadline <- lubridate::ymd_hms("2020-05-27 17:00:00", tz="Asia/Taipei") } howEarly <- deadline - lubridate::ymd_hms(student_i_time, tz="Asia/Taipei") # print(howEarly) return(howEarly) } compute_howEarly(examSubmissionTime$section[[1]],examSubmissionTime$time[[1]]) compute_howEarly(examSubmissionTime$section[[2]],examSubmissionTime$time[[2]]) compute_howEarly(examSubmissionTime$section[[3]],examSubmissionTime$time[[3]]) studentSequence <- 1:length(examSubmissionTime$section)

map(studentSequence,
~compute_howEarly(
examSubmissionTime$section[[.x]], examSubmissionTime$time[[.x]])
) -> list_howEarly

78節和56節交卷提早時間比較

library(magrittr)
list_howEarly %>%
unlist() -> examSubmissionTime$howEarly pick_56 <- examSubmissionTime$section=="56"
mean(examSubmissionTime$howEarly[pick_56]) median(examSubmissionTime$howEarly[pick_56])

pick_78 <- examSubmissionTime$section=="78" mean(examSubmissionTime$howEarly[pick_78])
median(examSubmissionTime$howEarly[pick_78]) ## [1] 4.926104 ## [1] 3.883333 ## [1] 9.105044 ## [1] 6.166667 5.3.3 if…else if… else 有時流程需要的分歧不只兩種情境，這時可以使用： if(condition A){ body for A } else if(condition B){ body for B } else if(condition C){ body for C } else { body for none of the above } • 依需要可以不斷增加else if(...){....}的部份在中間。 • else ifelse前面一定要保有前一段情境的結束} 成績等級： • >=90: 優 # condition A • 80-89：良 # condition B • 70-79：尚可 # condition C • 70以下：待加強 # else readline("請輸入你的成績（整數）： ") -> grade # 單獨執行 if(grade >=90){ print("優") } else if(grade>=80 & grade<=89){ print("良") } else if(grade>=70 & grade<=79){ print("尚可") } else { print("待加強") } 各情境一定要互斥，即不可以有兩個情境有可能同時為TRUE，如果發生多個情境吻合會以第一個結果的body來執行。 grade <- 80 if(grade >=90){ print("優") } else if(grade>=75 & grade<=89){ print("良") } else if(grade>=70 & grade<=85){ print("尚可") } else { print("待加強") } grade <- 80 if(grade >=90){ print("優") } else if(grade>=70 & grade<=85){ print("尚可") } else if(grade>=75 & grade<=89){ print("良") } else { print("待加強") } 5.3.4 switch 另一種條件式執行常用在condition種類煩雜或要全部以「是/否」問句來切出所有互斥condition情境不容易設計時。 • condition改成用文字描述，即conditionExpression。 • 不同conditionExpression與對應body內容改成使用一對對的: • "conditionExpression文字"={body 內容} 的name=value pair switch(實現的conditionExpression, "conditionExpression1"= { }, "conditionExpression2"= { }, : : "conditionExpressionN"= { }, { }) Mathematical function $f(n) = \begin{cases} n/2 & \quad \text{if } n \text{ is even}\\ -(n+1)/2 & \quad \text{if } n \text{ is odd} \end{cases}$ n<- 540 conditionExpression_outcome= ifelse(n %% 2==0, "even", "odd") switch( conditionExpression_outcome, "even"={fvalue <- n/2}, # 偶數 "odd"=fvalue <- -(n+1)/2, # 奇數；只有一行指令可省略{} warning("n要整數喔") ) print(fvalue) ifelse(test, yes, no)是超級好用/常用的函數： • test: class logical. 測試條件的結果 • yes: 結果為T 時你希望的回傳值 • no: 結果為F 時你希望的回傳值 grades <- c(52, 77, 59, 88, 90) ifelse(grades >= 60, "及格", "不及格") 在R裡{...}（大括號, brace）： • 若只有一行指令則{}符號可省略。 • 依照上一個特性，function(...){....}的body若只有一行指令可省略{...}改寫成function(...) ..., 只是要小心body … 要接在function(...)之後不可換行。 miniFun <- function(){ lubridate::now() } miniFun() miniFun2 <- function() lubridate::now() miniFun2() • 若最後一個被執行的指令會產生print在螢幕的效果，則可以用{...}-><-{...}將這print的值存出來。 result <- { x <- 2 y <- 3 x**y+15 } print(result) result2 <- { x <- 2 y <- 3 if(x< 3){ warning("x值太小") } else { x**y+15 } } print(result2) • 依照上一個特性，function(...){....}的body若最後一個「被執行」的指令是會印在螢幕的值，如該值要當回傳值可以不用return(...)就可以產生值回傳效果。 myFun <- function(x,y){ return(x**y+15) } # 等同於 myFun2 <- function(x,y){ x**y+15 } myFun(5,3) -> outcome myFun2(5,3) -> outcome2 print(outcome) print(outcome2) cut：連續轉類別 可適當使用cut()函數將與「連續型」數值變數有關的condition轉成需要的字串表示， cut(x, c(a,b,c)) 會將x分成(a,b], (b,c], 及NA 三大類。 • x只要type是integer, double的資料都可使用，所以日期，時間都可以 • (a,b]在數學上是a< . <=b，所以左側a值是「不包含」在裡面的 • 其中最小值可以是負無窮-Inf, 最大值可以是正無窮Inf a <- c(1,2,3) cut(a, c(1,2,3)) 數字成績轉英文字母成績 成績等級： • >=90: A 同時螢幕出現“好棒棒” （89<…<=100） • 80-89：B 同時螢幕出現“好棒” （79<…<=89） • 70-79：C 同時螢幕出現“棒” （69<…<=79） • 70以下：F 同時螢幕出現"-_-" (-1<…<=69) grade <- sample(1:100, 10, replace=T) grade %>% cut(c(-1,69,79,89,100)) -> grade levels(grade) switch( as.character(grade[[1]]), "(-1,69]"={ print("-_-") "F"}, "(69,79]"={ print("棒") "C" }, "(79,89]"={ print("好棒") "B" }, "(89,100]"={ print("好棒棒") "A" } ) -> letterGrade # 有回存時要螢幕印出的訊息一定要加print 寫一個compute_letterGrade(myGrade)函數, 可以依myGrade不同而回傳letterGrade且出現要求文字。 管家機器人: 一家三口， • 早上(06:00-09:00)： 媽媽讀《經濟學人》，爸爸讀《WSJ》，提醒小明“檢查書包東西都有帶嗎？” • 晚上(17:00-19:00)： 媽媽準備全家晚餐點foodpanda，爸爸瀏覽tripadvisor(https://www.tripadvisor.com/)規劃週末全家旅行，提醒小明“作業寫好了嗎？” • 晚上(23:30-次日淩晨1點)： 媽媽聆聽Spotify Jazz Classics(https://open.spotify.com/playlist/37i9dQZF1DXbITWG1ZJKYt) • 其他時段：“機器人要休息，饒了我吧～～” nowtime <- glue::glue("{today()} 18:00:00") %>% ymd_hms(tz="Asia/Taipei") library(lubridate) library(glue) # 建立可當cutpoints的一天時間點 cutpoints <- c( glue("{today()} 06:00:00"), glue("{today()} 09:00:00"), glue("{today()} 17:00:00"), glue("{today()} 19:00:00"), glue("{today()} 23:30:00"), glue("{today()+days(1)} 01:00:00") ) cutpoints %>% ymd_hms(tz="Asia/Taipei") -> cutpoints ## 將nowtime轉成它對應的時段是"morning", "evening", 或其他。 cut(nowtime, cutpoints) -> nowtime levels(nowtime)[c(1,3,5)] <- c("morning","evening","jazz time") ## 使用switch決定要做什麼事 switch( as.character(nowtime), "morning"={ print("要不要來閱讀點國際時事？") browseURL("https://economist.com") }, "evening"={ print("需不需要點餐呢？") browseURL("https://www.foodpanda.com.tw/") }, "jazz time"={ print("放鬆聽點Jazz。") browseURL("https://open.spotify.com/playlist/37i9dQZF1DXbITWG1ZJKYt") }, { print("機器人要休息，饒了我吧～～") } ) whatNeedToDo_butler_mom <- function(nowtime=now()){ library(lubridate) library(glue) cutpoints <- c( glue("{today()} 06:00:00"), glue("{today()} 09:00:00"), glue("{today()} 17:00:00"), glue("{today()} 19:00:00"), glue("{today()} 23:30:00"), glue("{today()+days(1)} 01:00:00") ) cutpoints %>% ymd_hms(tz="Asia/Taipei") -> cutpoints cut(nowtime, cutpoints) -> nowtime levels(nowtime)[c(1,3,5)] <- c("morning","evening","jazz time") switch( as.character(nowtime), "morning"={ print("要不要來閱讀點國際時事？") browseURL("https://economist.com") }, "evening"={ print("需不需要點餐呢？") browseURL("https://www.foodpanda.com.tw/") }, "jazz time"={ print("放鬆聽點Jazz。") browseURL("https://open.spotify.com/playlist/37i9dQZF1DXbITWG1ZJKYt") }, { print("機器人要休息，饒了我吧～～") } ) } ymd_hms(glue::glue("{today()} 08:00:00"),tz="Asia/Taipei") %>% whatNeedToDo_butler_mom() ymd_hms(glue::glue("{today()} 14:00:00"),tz="Asia/Taipei") %>% whatNeedToDo_butler_mom() ymd_hms(glue::glue("{today()} 18:00:00"),tz="Asia/Taipei") %>% whatNeedToDo_butler_mom() ymd_hms(glue::glue("{today()+days(1)} 00:20:00"),tz="Asia/Taipei") %>% whatNeedToDo_butler_mom() 上面的流程其實也可以用if… else if… else來做而不用switch，請用if… else if… else來創造whatNeedToDo_butler_mom。 請完成給爸爸和小明的管家機器人，whatNeedToDo_butler_dad和whatNeedToDo_butler_ming。 5.3.5 logical condition 由於if, if…else, if…if else…else, 都是用來決定要不要執行某個body，所以(condition) 必需要是「一個」T/F logical value。 比對答案 myAnswer <- c(2,3,6) correctAnswer <- c(2,3,5) if(myAnswer == correctAnswer){ # 只取用第一個T/F print("你答對了") } R3.5以上版本可以設定 Sys.setenv("_R_CHECK_LENGTH_1_CONDITION_" = "true") 禁止length>1的logical condition. all, any myAnswer <- c(2,3,6) correctAnswer <- c(2,3,5) if(all(myAnswer == correctAnswer)){ # 要全TRUE print("你答對了") } if(any(myAnswer == correctAnswer)){ # 只要有一個TRUE print("裡頭有數字是對的") } 寫一個grading(myAnswer, correctAnswer)函數可以用來比對兩者是否class及所有元素都相同，是才回傳10分，不是回傳0分。 && || 有時「資訊到這裡就夠判斷情境」會產生，這時可以用&&或｜｜ 對答案： • class, 內容都要對 myAnswer <- c(1,2,3) correctAnswer <- factor(c(1,2,3)) if(is.factor(myAnswer) && all(myAnswer==correctAnswer)){ print("答對了") 10 } else { print("答錯了") 0 }-> myGrade myGrade if(is.factor(myAnswer) & all(myAnswer==correctAnswer)){ print("答對了") 10 } else { print("答錯了") 0 }-> myGrade myGrade • &會計算所有relations，&&只計算到第一個出現FALSE的relation. • &&用在「有一個錯就算錯」的情境。 • |會計算所有relations，||只計算到第一個出現TRUE的relation. • ||用在「有一個對就算對」的情境。 在進行condition execution時，使用&&, ||會比&, |更有運算效率。 condition最好少使用&|因為兩邊relations若為logical向量長度>1，結果也會是個logical向量長度>1。 只要符合以下資格均可申請補助： • 年齡>=65 • 家庭子孩數>3 myAge <- 40 myChildrenNumber <- 5 if(myAge >=65 | myChildrenNumber >3){ "符合申請資格" } else { warning("不符合申請資格") } if(myAge >=65 || myChildrenNumber >3){ "符合申請資格" } else { warning("不符合申請資格") } 那改成 myAge <- 67 myChildrenNumber <- 5 5.3節主要在介紹「依情境執行不同body」的conditional execution，另外還有「依情境不同產生不同值」的conditional assignment。 一個logical relation: x <- c(2,5,10,-21,3,8) ifelse(x %% 2==0, "even", "odd") 多個logical relations: y <- sample(40:100,20, replace=T) dplyr::case_when( y < 60 ~ "F", 60<=y & y < 70 ~"D", 71<=y & y < 80 ~"C", 80<=y & y < 90 ~"B", 90<=y ~ "A" ) 將5.4.3小節中whatNeedToDo_butler_mom body裡的cut改成使用dplyr::case_when. 5.3.6 斷句 關於R的斷句： 只要指令不完整就繼續往下一行找。 在if-else if-else的使用下，只要 • } else 有同時出現 其他部份的斷句時機可自由決定。 # if... else例子 flag=1 if(flag==1){ print("flag 1.") } else { print("else.") } stop("以下有誤") if(flag==1){ print("flag 1.") } else { print("else.") } # if else if else例子 flag=1 if(flag==1){ print("flag 1.") } else if(flag==2){ print("flag 2.") } else { print("else.") } if(flag==1){ print("flag 1.") } else if(flag==2){ print("flag 2.") } else { print("else.") } stop("以下有誤") if(flag==1){ print("flag 1.") } else if(flag==2){ print("flag 2.") } else { print("else.") } 一般推薦的斷句模式： if(){ # 條件情境描述 } if(){ # 條件情境描述 } else { # 條件情境描述 } if(){ # 條件情境描述 } else if(){ # 條件情境描述 } else { # 條件情境描述 } 5.3.7 綜合練習 1. 消費者選擇 效用函數： $U(a1,a2)=a1^\alpha * a2^{(1-\alpha)}-m$ a1是該商品提供之服務所帶來的愉快程度，a2是該商品操作簡便性，$$\alpha$$是個介於0與1之間的數字，$$m$$則是購買此商品所要付出的金額。 想像有一系列類似的App你在考慮購買且只買一次、只買一個，每個App可用一組$$(a1,a2,m)$$的數字組合來代表，n個App可表示成一個集合$${(a1_1,a2_1,m_1),(a1_2,a2_2,m_2),... ,(a1_n,a2_n,m_n)}$$，消費者只選擇這些App中效用函數值最高的那個。 1.1 創造Ufun(a1, a2, m, alpha=0.5)函數，其中 Arguments： a1, a2, m, alpha: 均為class numeric Value: 回傳arugment values下所對應的效用函數值(class numeric) 1.2 以下10個App計算並回傳它們的效用值(class numeric, length=10) Apps_10 <- list( c(0.38,0.74,0.19), c(0.39,0.46,0.26), c(0.56,0.3,0.32), c(0.54,0.31,0.40), c(0.90,0.56,0.43), c(0.39,0.13,0.23), c(0.83,0.74,0.39), c(0.66,0.84,0.37), c(0.41,0.49,0.35), c(0.49,0.35,0.20)) 1.3 最大效用下消費者會買那一個App? 1.4 若alpha=0.3，消費者要買那一個App? 1.5 若alpha=0.95，消費者要買那一個App? 2. 中文組距 原始資料收回後常會依某些數值區間來分成不同組別，且描述手法均類似： • “未滿200,000元”, “200,000～299,999元”, “300,000元及以上” 描述手法：「區間」會有上下限兩個數字，最低與最高的組均只有一個數字。 請寫一個str_cut(x, cutpoints)函數，它能萬用的將x轉成依中文組距描述的類別資料 Arguement: • x: class integer. • cutpoints: class character, 如c(“未滿200,000元”, “200,000～299,999元”, “300,000元及以上”) Value: 回傳值為x依中文組距描述分類後的factor。 5.4 Iteration Rule of thumb: never copy and paste more than twice. • 重覆兩次（包含第一個）okay. 三次…考慮一下迴圈吧！ 但在設計迴圈時可以copy/paste 3 times來理解body如何設計 找出哪幾筆為“男”： sampleData <- list( list("男", 45), list("女", 32), list("男",50), list("男",33), list("女", 21) ) • 男女只在sampleData每一個元素底下的第一個元素 # 前三筆性別 sampleData[[1]][[1]] sampleData[[2]][[1]] sampleData[[3]][[1]] 5.4.1 Iteration components 我們在使用map時寫copy/paste程序3次，目的在確認： • Sequence: 即[[1]], [[2]], [[3]]出現的位置。 • Body: 要重覆做的SOP，即~.x[[1]] 而map最後會把每次Body的執行結果存在： • Output: 每次body執行完要存的形式，即map最後的list class output。 5.4.2 Two types of sequence 反覆要做的事 sampleData[[1]][[1]] sampleData[[2]][[1]] sampleData[[3]][[1]]  使用pipe寫法可以清楚分離sequence及body(SOP)。兩種sequence表示： # 串接寫法(I): external dispatch sampleData[[1]] %>% {.[[1]]} sampleData[[2]] %>% {.[[1]]} sampleData[[3]] %>% {.[[1]]} map(sampleData, ~{.x[[1]]}) # 串接寫法(II): internal dispatch 1 %>% {sampleData[[.]][[1]]} 2 %>% {sampleData[[.]][[1]]} 3 %>% {sampleData[[.]][[1]]} map(1:5, ~{sampleData[[.x]][[1]]}) # map在單維度遞迴時，.x也可以只寫. map(1:5, ~{sampleData[[.]][[1]]}) eggs <- rep("雞蛋x1", 8) fryEgg <- function(egg){ str_replace(egg, "雞蛋", "荷包蛋") } # external dispatch eggs[[1]] %>% fryEgg(.) eggs[[2]] %>% fryEgg(.) eggs[[3]] %>% fryEgg(.) map(eggs, ~fryEgg(.x)) -> friedEggs1 # internal dispatch 1 %>% {fryEgg(eggs[[.]])} 2 %>% {fryEgg(eggs[[.]])} 3 %>% {fryEgg(eggs[[.]])} map(1:8, ~{fryEgg(eggs[[.]])}) -> friedEggs2 vectorized function grade <- c(45, 74, NA) i<-3 grade_i <- grade[[i]] if(!is.na(grade_i)){ if(grade_i >= 60){ "P" } else if(grade_i < 60 ) { "F" } } else { "缺考" } pass_or_fail <- function(grade_i){ if(!is.na(grade_i)){ if(grade_i >= 60){ "P" } else if(grade_i < 60 ) { "F" } } else { "缺考" } } pass_or_fail(grade[[1]]) pass_or_fail(grade[[2]]) pass_or_fail(grade[[3]]) # 可否直接input整個grade vector warning("不是vectorised function") pass_or_fail(grade) 函數使用時若出現output value assigned動作時（即pass_fail_i <-），相當於執行了函數body pass_fail_i <-{...}，依switch小節的{...}處理原則： • 若最後一個被執行的指令會產生print在螢幕的效果，則可以用{…}->或<-{…}將這print的值存出來。 此時可以省略return() 可: • use map to wrap around non-vectorized function 產生vectorized function grade[[1]] %>% {pass_or_fail(.)} grade[[2]] %>% {pass_or_fail(.)} grade[[3]] %>% {pass_or_fail(.)} map(grade, ~{pass_or_fail(.)}) # map to list map_chr(grade, ~{pass_or_fail(.)}) # map to atom. vectof of class character map_pass_fail <- function(grade){ map_chr(grade, ~{pass_or_fail(.)}) } map_pass_fail(grade) 若你確信你map的list輸出每個元素只有一個值，且大家都相同class，則你可以依class的類形使用： • map_chr • map_lgl • map_dbl, map_int 省了unlist那一步。 請問map_pass_fail的定義是否受global environment裡的grade元素「值」影響？即執行rm(grade)刪除grade物件，以下程序執行上會不會有問題？ map_pass_fail(c(77,43,68,NA)) 常被拿來針對物件元素進行一一計算的函數建議可以將它改成vectorized function，以後在維護時比較容易。 Internal dispatching的優勢 當Body要同時對多個物件同時進行「元素一一處理」時，internal dispatch便顯得便利： eggs <- rep("雞蛋x1",10) ham <- rep("火腿x1", 10) toast <- rep("土司2片",10) toast_withEggHam <- function(toast=NULL, egg=NULL, ham=NULL){ if(is.null(toast) || !str_detect(toast, "土司")){stop("少了土司")} if(is.null(egg) || !str_detect(egg, "蛋")){stop("少了蛋")} if(is.null(ham) || !str_detect(ham, "火腿")){stop("少了火腿")} "火腿蛋三明治" } # 土司、火腿、蛋 第一份出列 1 %>% {toast_withEggHam(toast=toast[[.]], egg=eggs[[.]], ham=ham[[.]])} # 土司、火腿、蛋 第二份出列 2 %>% {toast_withEggHam(toast=toast[[.]], egg=eggs[[.]], ham=ham[[.]])} # 土司、火腿、蛋 第三份出列 3 %>% {toast_withEggHam(toast=toast[[.]], egg=eggs[[.]], ham=ham[[.]])} map(1:10, ~toast_withEggHam(toast=toast[[.x]], egg=eggs[[.x]], ham=ham[[.x]])) 各系課程規劃 執行以下程序可以得到臺北大學100-107學年的開課資料courseStructure： jsonlite::fromJSON("https://www.dropbox.com/s/7myzzdnoor21hye/courseStructure2.json?dl=1") -> courseStructure 一位剛入學的經濟系新生想大致了解他系上對他未來四年的課程規劃是什麼？於是他想先看一下過去狀況。 以100學年入學之經濟系學生為對象，找出這群學生大一到大四的系上課程規劃是什麼？ entranceYear <- 100 major <- "經濟系" allGrades <- paste0(major, 1:4) academicYears <- entranceYear+0:3 # 100學年 1年級 acadYear_i <- academicYears[[1]] grade_i <- allGrades[[1]] pick <- (courseStructure$學年==acadYear_i
&
str_detect(courseStructure$應修系級, grade_i)) unique(courseStructure$科目名稱[pick])

# 101學年 2年級
pick <-
(courseStructure$學年==acadYear_i & str_detect(courseStructure$應修系級, grade_i))
unique(courseStructure$科目名稱[pick]) # 102學年 3年級 acadYear_i <- academicYears[[3]] grade_i <- allGrades[[3]] pick <- (courseStructure$學年==acadYear_i
&
str_detect(courseStructure$應修系級, grade_i)) unique(courseStructure$科目名稱[pick])

# 103學年 4年級
pick <-
(courseStructure$學年==acadYear_i & str_detect(courseStructure$應修系級, grade_i))
unique(courseStructure$科目名稱[pick]) 1. 100學年1年級-103學年4年級，有哪幾行是一模一樣的？ pick <- (courseStructure$學年==acadYear_i
&
str_detect(courseStructure$應修系級, grade_i)) unique(courseStructure$科目名稱[pick])
1. 以上的SOP要能運作，哪些物件要存在執行環境？

get_courses <- function(acadYear_i, grade_i, courseStructure){
pick <-
(courseStructure$學年==acadYear_i & str_detect(courseStructure$應修系級, grade_i))

return(
unique(courseStructure$科目名稱[pick]) ) } 重寫100學年1年級-103學年4年級 # 100學年 1年級 acadYear_i <- academicYears[[1]] grade_i <- allGrades[[1]] get_courses(acadYear_i, grade_i, courseStructure) # 101學年 2年級 acadYear_i <- academicYears[[2]] grade_i <- allGrades[[2]] get_courses(acadYear_i, grade_i, courseStructure) # 102學年 3年級 acadYear_i <- academicYears[[3]] grade_i <- allGrades[[3]] get_courses(acadYear_i, grade_i, courseStructure) # 103學年 4年級 acadYear_i <- academicYears[[4]] grade_i <- allGrades[[4]] get_courses(acadYear_i, grade_i, courseStructure) 濃縮 # 100學年 1年級 get_courses(academicYears[[1]], allGrades[[1]], courseStructure) # 101學年 2年級 get_courses(academicYears[[2]], allGrades[[2]], courseStructure) # 102學年 3年級 get_courses(academicYears[[3]], allGrades[[3]], courseStructure) # 103學年 4年級 get_courses(academicYears[[4]], allGrades[[4]], courseStructure) 使用pipe 1 %>% {get_courses(academicYears[[.]], allGrades[[.]], courseStructure)} 2 %>% {get_courses(academicYears[[.]], allGrades[[.]], courseStructure)} 3 %>% {get_courses(academicYears[[.]], allGrades[[.]], courseStructure)} 4 %>% {get_courses(academicYears[[.]], allGrades[[.]], courseStructure)} 使用map 1:4 %>% map(~{get_courses(academicYears[[.]], allGrades[[.]], courseStructure)}) Iteration in functional: map 1:4 %>% map(~{ get_courses(academicYears[[.]], allGrades[[.]], courseStructure)}) • Sequence: 1:4 • Body: {get_courses(academicYears[[.]], allGrades[[.]], courseStructure)}, 以formula（另一種function形式）包裝。 • Output: list class, length=Sequence length 5.4.3 for loop output <- vector("{type}", length={len}) for(.x in {sequence}){ {body} } 這裡"{…}" 均是需要視情況定義的部份。 vector(mode, length): • mode: character class，代表container所要用來裝的值之type。 • length: integer class，代表container要有幾個空位。 map範例： map iteration：(請先跑) ### 前置作業 entranceYear <- 100 major <- "經濟系" allGrades <- paste0(major, 1:4) academicYears <- entranceYear+0:3 jsonlite::fromJSON("https://www.dropbox.com/s/7myzzdnoor21hye/courseStructure2.json?dl=1") -> courseStructure get_courses <- function(acadYear_i, grade_i, courseStructure){ pick <- (courseStructure$學年==acadYear_i
&
str_detect(courseStructure$應修系級, grade_i)) return( unique(courseStructure$科目名稱[pick])
)
}
# 前置作業，接map iteration
map(1:4,
~{
courseStructure)})

for iteration：（請先跑前置作業）

# 前置作業，接for iteration
output <- vector("list", length=4)
for(.x in 1:4){
courseStructure) -> output[[.x]]
}

eggs <- rep("雞蛋x1",10)
ham <- rep("火腿x1", 10)
toast <- rep("土司2片",10)

toast_withEggHam <- function(toast=NULL, egg=NULL, ham=NULL){
if(is.null(toast) || !str_detect(toast, "土司")){stop("少了土司")}
if(is.null(egg) || !str_detect(egg, "蛋")){stop("少了蛋")}
if(is.null(ham) || !str_detect(ham, "火腿")){stop("少了火腿")}
"火腿蛋三明治"
}

map approach:

map(1:10,
~toast_withEggHam(toast=toast[[.x]], egg=eggs[[.x]], ham=ham[[.x]]))

for approach:

output <- vector("character", 10)
for(.x in 1:10){
toast_withEggHam(toast=toast[[.x]], egg=eggs[[.x]], ham=ham[[.x]]) -> output[[.x]]
}

累計型output

Summation

$\sum_{i=1}^N a_i$

a <- sample(1:100, 10, replace=T)
print(a)
• Sequence: 1:10

• body: 到目前sequence .x前已經加總的值+ a[[.x]]

• output: .x到10最後算完的值。

sum <- 0
for(.x in 1:10){
sum <- sum+a[[.x]]
}

print(sum)

長度不定型output

output <- c()
for(.x in 1:10){
new <- sample(0:100,1)
if(new %% 3==0){
output <- c(output, new)
}
}

print(output)

5.4.4 while loop

sum <- 0
for(i in 1:10){
newToss <- sample(c("正","反"), 1, replace=T)
if(newToss == "正"){
sum <- sum+1
}
print(glue::glue("已擲{i}次得到{sum}次正面"))
}

for loop用很長的sequence再加上條件式break：

sum <- 0
for(i in 1:100){
newToss <- sample(c("正","反"), 1, replace=T)
if(newToss == "正"){
sum <- sum+1
}
print(glue::glue("已擲{i}次得到{sum}次正面"))
if(sum==5){
break
}
}

break會完全終止迴圈，而之前學到的next是不執行其以下的body直接跳下一個sequence值。

while會一直反覆執行body直到conditionCondition為FALSE:

while(continueCondition){
body
}
sum <- 0
count <- 0 # 計數器
while(sum<5){
count <- count+1 # 計數器+1
newToss <- sample(c("正","反"), 1, replace=T)
if(newToss == "正"){
sum <- sum+1
}
print(glue::glue("已擲{count}次得到{sum}次正面"))
}

count <- 0 # 計數器開始值
max_count <- 500 # 計數上限
while(continueCondition && count <= max_count){ # 增加計數上限條件
count <- count+1 # 計數器加1
body
}

set.seed(1000) # 控制sample抽出的數字sequence固定，通常進行方法比對用

output <- c()
for(.x in 1:10){
new <- sample(0:100,1)
if(new %% 3==0){
output <- c(output, new)
}
}

print(output)
set.seed(1000) # 控制sample抽出的數字sequence固定，通常進行方法比對用

count <- 0 # 計數器起始值
output <- c()
while(count <= 10){ # 計數上限條件
count <- count+1 # 計數器+1
new <- sample(0:100,1)
if(new %% 3==0){
output <- c(output, new)
}
}

print(output)
a <- sample(1:100, 10, replace=T)
print(a)

sum <- 0
for(.x in 1:10){
sum <- sum+a[[.x]]
}

print(sum)
count <- 0 # 計數器起始值
sum <- 0
while(count <= 10){ # 計數上限條件
count <- count+1 # 計數器+1
sum <- sum+a[[count]]
}

print(sum)

“…the real downside of for loops is that they’re very flexible: a loop conveys that you’re iterating, but not what should be done with the results. Just as it’s better to use while than repeat, and it’s better to use for than while (Section 5.3.2), it’s better to use a functional than for. Each functional is tailored for a specific task, so when you recognise the functional you immediately know why it’s being used.” – from Advanced R.

• 不過若沒有追求時間效率的需求，還是以符合直覺的寫法優先，日後維護也比較能進入狀況。

5.4.5 綜合練習

1. Mathematical function

$f(n) = \begin{cases} n/2 & \quad \text{if } n \text{ is even}\\ -(n+1)/2 & \quad \text{if } n \text{ is odd} \end{cases}$

myFun <- function(n) {
if (as.logical(n%%2)) {
fvalue <- -(n + 1)/2
} else {
fvalue <- n/2
}
return(fvalue)
}
myFun2(c(-11,32,19,20))

askSilly_weather2 <- function(locationInput,dateInput){
if(!exists("weather_next36hours")){
jsonlite::fromJSON("https://opendata.cwb.gov.tw/fileapi/v1/opendataapi/F-C0032-001?Authorization=rdec-key-123-45678-011121314&format=JSON") ->
weather_next36hours
SOAR::Store(weather_next36hours) # 存在.R_cache environment中
}
(weather_next36hours$cwbopendata$dataset$location$locationName == locationInput) -> pick_location

weather_next36hours$cwbopendata$dataset$location$weatherElement[pick_location][[1]] -> weatherAtLocation
(weatherAtLocation$elementName=="MaxT") -> pick_MaxT (weatherAtLocation$elementName=="MinT") ->
pick_MinT
weatherAtLocation$time[pick_MaxT][[1]]$parameter$parameterName[[1]] -> maxT weatherAtLocation$time[pick_MinT][[1]]$parameter$parameterName[[1]] -> minT

glue::glue("{locationInput} {dateInput} 氣溫，最高{maxT}度，最低{minT}度。")
}
askSilly_weather2(c("臺北市","新北市","臺中市"),lubridate::now())

1. 以下程式隨機自0-100抽出30個數字：
a <- sample(0:100,30, replace=T)
print(a)

3.1 請計算其平均值a_mean.

3.2 令$$\mu$$代表上一題的平均值，請計算其樣本標準差（sample_sd），公式如下：

$\sqrt{\sum_{i=1}^{30}(a_i-\mu)^2/(30-1)}$ （註：開根號除了使用**0.5, ^0.5外，也可以用sqrt()函數。）

1. 現值 明年的100元若可以在今年用90元存到，那表示利率為(100-90)/90=0.1111。反過來說，明年的100元用100/(1+0.1111)可以反推等值現在的90元價值。這1/(1+0.1111)即稱之為折現率。若利率R維持每年不變，則現金流$$a_0, a_1, a_2, ..., a_N$$的現值為：

$a_0+\frac{a_1}{1+R}+\frac{a_2}{(1+R)^2}+...+\frac{a_N}{(1+R)^N}$ 其中下標0表示今天，1表示明年，2表示後年，依此類推。

a <- sample(10000:50000,20,replace=T)
names(a) <- 0:19

arguments:

• a: 現金流class numeric

• R: 年利率

value: 回傳現金流的現值。

5.5 R Script

knitr::purl("Rmd檔路徑")
• 不要輸出的chunk可以用purl=FALSE設定，如{r, purl=FALSE}

source("R檔路徑")

5.6 Debug

• 使用browser()函數於「暫停點」進入「browser debug環境」。
if(!exists("courseStructure")){
jsonlite::fromJSON("https://www.dropbox.com/s/7myzzdnoor21hye/courseStructure2.json?dl=1") -> courseStructure
SOAR::Store(courseStructure)
} else if (exists("courseStructure", envir = globalenv())){
SOAR::Store(courseStructure)
}

pick <-
(courseStructure$學年==acadYear_i & str_detect(courseStructure$應修系級, grade_i))
browser() # 暫停點(1)
return(
unique(courseStructure\$科目名稱[pick])
)
}

entranceYear <- 100
major <- "經濟系"

courseList <- vector("list", 4);
for(.x in 1:4){
if(.x == 3) browser() # 暫停點(2)
}

• n：執行下一句，但不跳離browser debug環境

• f：執行剩餘loop或function步驟，但不跳離browser debug環境

• c：完全跳離browser debug環境並執行暫停點的下一句

• Q：完全跳離browser debug環境並執行暫停點剩下script

for (i in 1:10) {
print(i)
if (i == 5) browser()
}`