📚 R Code Vault by MALAK

💠 ONE


REGNO <- c(101,102,103,104,105)
STUDENTNAME <- c("Aakash","Sethu","Prahadeesh","Kala","Mala")
TAMIL <- c(67,78,89,45,35)
ENGLISH <- c(56,67,78,89,75)
MATHS <- c(56,35,23,89,78)
SCIENCE <- c(56,67,89,98,76)
SOCIAL <- c(56,67,78,89,45)
df<- data.frame(REGNO, STUDENTNAME, TAMIL, ENGLISH, MATHS, SCIENCE, SOCIAL)
write.csv(df,"E:/2024_2025/Rlab/studentinfo1.csv", row.names = FALSE, col.names = TRUE)
data<- df[-c(5), ]
print("Before Deletion")
print(df)
df<- df[ -c(3), ]
print("After Deletion")
print(df)

💠 TWO


getwd()
setwd("E:/2024_2025/Rlab")
getwd()

datas <- read.csv("MARK.csv")
print(datas)

data <- data.frame(
  REGNO = 1:4,
  Name = c("A", "B", "C", "D"),
  TAMIL = c(67, 76, 88, 90),
  ENGLISH = c(67, 76, 88, 90),
  MATHS = c(67, 76, 88, 90),
  SCIENCE = c(67, 76, 88, 90),
  SOCIAL = c(67, 76, 88, 90)
)

write.table(data, file = "MARK.csv", row.names = FALSE)

layout(matrix(c(1,1,2,2,3,3,0,4,4,5,5,0), nrow=2, ncol=6, byrow=TRUE), respect=FALSE)
hist(data$TAMIL)
hist(data$ENGLISH)
hist(data$MATHS)
hist(data$SCIENCE)
hist(data$SOCIAL)

💠 THREE


set.seed(123)
mean_value <- 5
sd_value <- 2
num_samples <- 1000
random_numbers <- rnorm(num_samples, mean = mean_value, sd = sd_value)
print(head(random_numbers))
hist(random_numbers)

💠 FOUR


Z <- rnorm(255, 0, 1)  
u <- 0.3               
sd <- 0.2              
s <- 100               
price <- c(s)         
a <- 2                 
t <- 1:256             

for(i in Z) {
  S = s + s * (u / 255 + sd / sqrt(255) * i)
  price[a] <- S 
  s = S 
  a = a + 1
}

plot(t, price, main = "Time series stock X", xlab = "time", ylab = "price", 
     type = "l", col = "blue")

summary(price)

statistics <- c(sd(price), mean(price), (price[256] - price[1]) / price[1] * 100)
names(statistics) <- c("Volatility", "Average price", "Return %")
print(statistics)

💠 FIVE


library(GA)

fitness_function <- function(ch) {
  n <- binary2decimal(ch)
  if (n == 0) return(-1e6)
  -abs(exp(1) - (1 + 1/n)^n)
}

gaControl("binary" = list(
  selection = "ga_rwSelection",
  crossover = "gabin_spCrossover",
  mutation  = "gabin_raMutation"
))

myga <- ga(
  type = "binary",
  fitness = fitness_function,
  nBits = 10,
  popSize = 100,
  maxiter = 3000,
  pcrossover = 0.8,
  pmutation = 0.1,
  elitism = 0,
  monitor = TRUE
)

summary(myga)
plot(myga)

best_n <- binary2decimal(myga@solution[1, ])
cat("Best n:", best_n, 
    "\nValue:", (1 + 1/best_n)^best_n, 
    "\nError:", abs(exp(1) - (1 + 1/best_n)^best_n), "\n")

💠 SIX


install.packages("datasets")
install.packages("caTools")
install.packages("party")
install.packages("dplyr")
install.packages("magrittr")

library(datasets)
library(caTools)
library(party)
library(dplyr)
library(magrittr)

data("readingSkills")
head(readingSkills)

set.seed(123)
samples_data <- sample.split(readingSkills$nativeSpeaker, SplitRatio = 0.8)

train_data <- subset(readingSkills, samples_data == TRUE)
test_data  <- subset(readingSkills, samples_data == FALSE)

model <- ctree(nativeSpeaker ~ age + shoeSize + score, data = train_data)

plot(model)

💠 SEVEN



require(graphics)

f <- function(x) (x - 1/3)^2

xmin <- optimize(f, c(0, 1), tol = 0.0001)
print(xmin)

optimize(function(x) ifelse((x > -1) & (x < 4), exp(-(x - 1)^2), 10), c(-5, 5))

fp <- function(x) { print(x); f(x) }

plot(f, -2, 5, ylim = c(0, 1), col = 2)

optimize(fp, c(-4, 20))
optimize(fp, c(-7, 20))

💠 EIGHT



if (!require(forecast)) {
  install.packages("forecast")
  library(forecast)
}
if (!require(ggplot2)) {
  install.packages("ggplot2")
  library(ggplot2)
}

set.seed(123)
time_series_length <- 100
time_series <- ts(rnorm(time_series_length, mean = 10, sd = 5), frequency = 12)

plot(time_series,
     main = "Synthetic Time Series Data",
     ylab = "Value",
     xlab = "Time",
     col = "blue")

fit <- auto.arima(time_series)

forecast_horizon <- 12
forecast_result <- forecast(fit, h = forecast_horizon)

autoplot(forecast_result) +
  ggtitle("ARIMA Forecasting") +
  xlab("Time") +
  ylab("Forecast Value") +
  theme_minimal()

print(summary(fit))
print(forecast_result)

💠 NINE


install.packages("dplyr")
install.packages("tibble")

library(dplyr)
library(tibble)

initial_state <- list(
  current_time = 0,
  events = data.frame(time = numeric(0), event = character()),
  warm_up_time = 0,
  data_collected = tibble(time = numeric(0), data = numeric(0)),
  event_log = tibble(time = numeric(0), event = character())
)

# Function to schedule events
schedule_event <- function(state, event_time, event_description) {
  new_event <- data.frame(time = event_time, event = event_description, 
                          stringsAsFactors = FALSE)
  state$events <- bind_rows(state$events, new_event) %>%
    arrange(time)
  return(state)
}

process_event <- function(state) {
  if (nrow(state$events) == 0) {
    return(state)
  }
  
  next_event <- state$events[1, ]
  state$current_time <- next_event$time
  
  state$event_log <- bind_rows(state$event_log,
                               tibble(time = state$current_time, event = next_event$event))
  
  if (state$current_time >= state$warm_up_time) {
    data_value <- rnorm(1)
    state$data_collected <- bind_rows(state$data_collected,
                                      tibble(time = state$current_time, data = data_value))
  }
  
  state$events <- state$events[-1, ]
  
  return(state)
}

# Run simulation
state <- initial_state
state$warm_up_time <- 5

state <- schedule_event(state, 2, "event1")
state <- schedule_event(state, 4, "event2")
state <- schedule_event(state, 6, "event3")
state <- schedule_event(state, 7, "event4")
state <- schedule_event(state, 8, "event5")

while (nrow(state$events) > 0) {
  state <- process_event(state)
}

print("Event Log")
print(state$event_log)

print("Data collected post warm-up interval")
print(state$data_collected)

💠 TEN



  if (!require("ggplot2")) {
  install.packages("ggplot2")
}
library(ggplot2)
library(dplyr)
library(tibble)

# Initial state
initial_state <- list(
  current_time = 0,
  light_intensity = numeric(),
  pupil_diameter = numeric(),
  response_time = 1,
  max_pupil_diameter = 8,
  min_pupil_diameter = 2
)

# Function to update pupil diameter
update_pupil_diameter <- function(state, light_intensity) {
  target_diameter <- state$max_pupil_diameter -
    (light_intensity / log(10 + light_intensity)) *
    (state$max_pupil_diameter - state$min_pupil_diameter)
  
  if (length(state$pupil_diameter) == 0) {
    current_diameter <- state$max_pupil_diameter
  } else {
    current_diameter <- state$pupil_diameter[length(state$pupil_diameter)]
  }
  
  new_diameter <- current_diameter +
    (target_diameter - current_diameter) *
    (1 - exp(-1 / state$response_time))
  
  return(new_diameter)
}

# Simulation function
simulate_eye_response <- function(state, time_steps, light_changes) {
  for (t in 1:time_steps) {
    if (t <= length(light_changes)) {
      state$light_intensity[t] <- light_changes[t]
    } else {
      state$light_intensity[t] <- state$light_intensity[t - 1]
    }
    
    state$pupil_diameter[t] <- update_pupil_diameter(state, state$light_intensity[t])
    state$current_time <- state$current_time + 1
  }
  return(state)
}

# Parameters
time_steps <- 50
light_changes <- c(
  rep(10, 10),
  rep(50, 10),
  rep(20, 10),
  rep(80, 10),
  rep(10, 10)
)

# Run simulation
state <- initial_state
state <- simulate_eye_response(state, time_steps, light_changes)

# Collect results
results <- tibble(
  Time = 1:time_steps,
  Light_Intensity = state$light_intensity,
  Pupil_Diameter = state$pupil_diameter
)

# Plot
ggplot(results, aes(x = Time)) +
  geom_line(aes(y = Light_Intensity * 0.1, colour = "Light Intensity"), size = 1) +
  geom_line(aes(y = Pupil_Diameter, colour = "Pupil Diameter"), size = 1) +
  scale_y_continuous(
    sec.axis = sec_axis(~ . * 10, name = "Light Intensity (scaled)")
  ) +
  labs(
    y = "Pupil Diameter (mm)",
    colour = "Legend",
    title = "Simulation of Pupil Diameter Response to Light Intensity"
  ) +
  theme_minimal()