R: دوال R: الدوال المخصصة والبرمجة الوظيفية

# Repeat 10 The code for this
sales <- c(120, 150, 80, 200, 175)
total <- sum(sales)
avg <- mean(sales)
top <- max(sales)
cat("Total Sales:", total, "Average:", avg, "Highest:", top, "\n")

# Write a function (just write 1 time)
report <- function(x) {
  cat("Total Sales:", sum(x), " Average:", mean(x), " Highest:", max(x), "\n")
}

# Call 10 times (Every time 1 row)
report(c(120, 150, 80, 200, 175))
report(c(80, 90, 100))
report(c(1000, 2000, 3000))

# The Simplest Function
greet <- function() {
  cat("Hello, World!\n")
}

# Call
greet()
# Output:Hello, World!

# Single parameter
greet <- function(name) {
  cat("Hello,", name, "!\n")
}

greet("Alice")
# Output:Hello, Alice !

# Multiple parameters
greet_full <- function(name, age) {
  cat("I am", name, ",This year", age, "yrs\n")
}

greet_full("Bob", 25)
# Output:I am Bob ,This year 25 yrs

# R the special:The last line wraps automatically(Not necessary return)
add <- function(a, b) {
  a + b   # The last line wraps automatically
}

result <- add(3, 4)
result
# [1] 7

# Function Definition:3 parameter
power <- function(base, exp, mod) {
  result <- (base ^ exp) %% mod
  return(result)
}

# Location Parameters(In order)
power(2, 10, 1000)
# [1] 24  ← 2^10=1024, 1024 %% 1000 = 24

# Named parameters(By Name,Out of order)
power(mod = 1000, base = 2, exp = 10)
# [1] 24  ← The same result

# The second parameter has a default value.
power <- function(base, exp = 2, mod = 1000) {
  result <- (base ^ exp) %% mod
  return(result)
}

# Do not pass a second parameter,Use the default exp = 2
power(10)
# [1] 100  ← 10^2=100, 100 %% 1000 = 100

# Partial Parameter Passing
power(10, mod = 100)
# [1] 0  ← 10^2=100, 100 %% 100 = 0

# Use ... to accept any parameters
my_sum <- function(...) {
  args <- list(...)
  result <- sum(unlist(args))
  cat("Summed up", length(args), "parameter:", result, "\n")
  return(result)
}

my_sum(1, 2, 3)
# Summed up 3 parameter: 6

my_sum(10, 20, 30, 40, 50)
# Summed up 5 parameter: 150

add <- function(a, b) {
  a + b   # Last line,Auto-Return
}

add(3, 4)
# [1] 7

# Use return() to return early
check_age <- function(age) {
  if (age < 0) {
    return("Age of Invalidity")  # Return Early
  }
  if (age >= 18) {
    return("Adulthood")
  }
  "Minor"  # Implicit Return
}

check_age(-5)   # [1] "Age of Invalidity"
check_age(20)   # [1] "Adulthood"
check_age(15)   # [1] "Minor"

# Ordinary Functions
add_print <- function(a, b) {
  a + b  # It will print automatically
}

add_print(3, 4)
# [1] 7  ← Automatic Printing

# invisible Function
add_silent <- function(a, b) {
  invisible(a + b)  # Do not print automatically
}

add_silent(3, 4)
# No output  ← Do not print

# But it can still be assigned a value
result <- add_silent(3, 4)
result
# [1] 7  ← You can see it after the assignment.

# Ordinary Functions
square <- function(x) x ^ 2
square(5)
# [1] 25

# Anonymous Functions(Use directly)
(function(x) x ^ 2)(5)
# [1] 25

# Common Use Cases for Anonymous Functions:lapply/sapply
numbers <- list(1, 2, 3, 4, 5)
result <- lapply(numbers, function(x) x ^ 2)
result
# [[1]] 1
# [[2]] 4
# [[3]] 9
# [[4]] 16
# [[5]] 25

f <- function(x) x * 2
g <- f  # A function has two names

f(5)  # [1] 10
g(5)  # [1] 10  ← Equivalent

# Functions that take other functions as arguments
apply_twice <- function(f, x) {
  f(f(x))
}

# Passing Different Functions
apply_twice(function(x) x + 1, 5)  # 5+1+1=7
apply_twice(function(x) x * 2, 5)  # 5*2*2=20

# A function that returns a function(Closure)
make_multiplier <- function(k) {
  function(x) x * k
}

# Creating Functions with Different Scales
double <- make_multiplier(2)
triple <- make_multiplier(3)

double(5)  # [1] 10
triple(5)  # [1] 15

# Regular Call
sum(1, 2, 3, 4, 5)
# [1] 15

# do.call Call(The parameter is a list)
args <- list(1, 2, 3, 4, 5)
do.call(sum, args)
# [1] 15

# Practical Application:Dynamic Creation data.frame
col_names <- c("name", "age", "score")
col1 <- c("Alice", "Bob", "Charlie")
col2 <- c(25, 30, 35)
col3 <- c(95, 88, 92)

df <- do.call(data.frame, list(
  name = col1,
  age = col2,
  score = col3
))
print(df)
#       name age score
# 1    Alice  25    95
# 2      Bob  30    88
# 3 Charlie  35    92

# Global Variables
x <- 10

# Global variables can be accessed within a function.
read_x <- function() {
  cat("x =", x, "\n")  # Read the whole picture x
}
read_x()
# x = 10

# However, local variables within a function do not affect the global scope.
set_local <- function() {
  x <- 999  # Local variables
  cat("Inside a function x =", x, "\n")
}
set_local()
# Inside a function x = 999
cat("Global x =", x, "\n")
# Global x = 10  <- Global x unchanged

# ============================================
# Sales Report Tool Functions
# Features:Encapsulate Common Analytical Logic,Reuse
# ============================================

# 1. Basic Statistical Functions(Back to List)
basic_stats <- function(x) {
  list(
    n = length(x),
    sum = sum(x),
    mean = round(mean(x), 2),
    median = median(x),
    sd = round(sd(x), 2),
    min = min(x),
    max = max(x)
  )
}

# 2. Formatted Output Functions(invisible Back)
print_report <- function(name, x) {
  stats <- basic_stats(x)
  cat("=================================\n")
  cat("Sales Report:", name, "\n")
  cat("=================================\n")
  cat("Sample size:", stats$n, "\n")
  cat("Total Sales:", stats$sum, "\n")
  cat("Average Sales:", stats$mean, "\n")
  cat("Median:", stats$median, "\n")
  cat("Standard Deviation:", stats$sd, "\n")
  cat("Minimum:", stats$min, " / Maximum:", stats$max, "\n")
  invisible(stats)  # Silent Return
}

# 3. Classification Function(Vectorization)
classify_sales <- function(x) {
  ifelse(x < 100, "Low",
  ifelse(x < 200, "Mid", "High"))
}

# 4. Main Program
sales_data <- list(
  "Beijing" = c(120, 150, 80, 200, 175),
  "Shanghai" = c(95, 110, 130, 145, 160),
  "Shenzhen" = c(200, 220, 180, 250, 300)
)

# Generate reports for each branch
for (city in names(sales_data)) {
  sales <- sales_data[[city]]
  print_report(city, sales)
  
  # Batch Classification Using Anonymous Functions
  levels <- sapply(sales, function(x) classify_sales(x))
  cat("\nCategory Summary:\n")
  print(table(levels))
  cat("\n")
}

# 5. Use do.call to merge all branches
all_sales <- do.call(c, sales_data)
cat("=== Company-wide Summary ===\n")
print_report("Company-wide", all_sales)

=================================
Sales Report: Beijing
=================================
Sample size: 5
Total Sales: 725
Average Sales: 145
Median: 150
Standard Deviation: 47.7
Minimum: 80 / Maximum: 200

Category Summary:
levels
Mid High 
3  2 

=================================
Sales Report: Shanghai
=================================
...