evoalgs-r-practise/w7/w7.Rmd
2024-06-24 12:13:13 +02:00

293 lines
9.8 KiB
Plaintext

```{R fsm}
# Define FSM class
FSM <- setRefClass("FSM",
fields = list(
states = "list",
transitions = "list",
start_state = "character",
accept_states = "character",
input_alphabet = "character",
output_alphabet = "character"
),
methods = list(
initialize = function(states, transitions, start_state, accept_states) {
states <<- states
transitions <<- transitions
start_state <<- start_state
accept_states <<- accept_states
input_alphabet <<- letters
output_alphabet <<- c("0", "1")
},
change_output = function(state, new_output) {
states[[state]]$output <<- new_output
},
modify_transition = function(from_state, input, to_state) {
transitions[[from_state]][[input]] <<- to_state
},
add_state = function(state_name, output) {
if (length(states) < 10) {
states[[state_name]] <<- list(output = output)
transitions[[state_name]] <<- list()
}
},
remove_state = function(state_name) {
if (length(states) <= 2 || state_name == start_state) {
return(FALSE) # Don't remove if it's the start state or if we have 2 or fewer states
}
states[[state_name]] <<- NULL
transitions[[state_name]] <<- NULL
for (state in names(transitions)) {
transitions[[state]] <<- transitions[[state]][names(transitions[[state]]) != state_name]
}
# If we removed an accept state, choose a new one if necessary
if (state_name %in% accept_states) {
accept_states <<- setdiff(accept_states, state_name)
if (length(accept_states) == 0) {
accept_states <<- sample(names(states), 1)
}
}
# Redirect any transitions that went to the removed state
for (state in names(transitions)) {
for (input in names(transitions[[state]])) {
if (transitions[[state]][[input]] == state_name) {
transitions[[state]][[input]] <<- sample(setdiff(names(states), state), 1)
}
}
}
return(TRUE)
},
change_start_state = function(new_start_state) {
start_state <<- new_start_state
},
run = function(input_string) {
if (nchar(input_string) == 0) {
return(states[[start_state]]$output)
}
current_state <- start_state
for (char in strsplit(input_string, "")[[1]]) {
if (!is.null(transitions[[current_state]][[char]])) {
current_state <- transitions[[current_state]][[char]]
}
# Stay in current state if no transition is defined
}
if (is.null(states[[current_state]]) || is.null(states[[current_state]]$output)) {
warning("Invalid final state or missing output")
warning(sprintf("Current state: %s", current_state))
return("0") # Default output
}
return(states[[current_state]]$output)
},
copy = function() {
FSM$new(
states = lapply(states, function(x) list(output = x$output)),
transitions = lapply(transitions, function(x) as.list(x)),
start_state = start_state,
accept_states = accept_states
)
},
check = function() {
# Check if start state exists
if (!(start_state %in% names(states))) {
cat("Error: Start state does not exist\n")
return(FALSE)
}
# Check if all accept states exist
for (accept_state in accept_states) {
if (!(accept_state %in% names(states))) {
cat("Error: Accept state", accept_state, "does not exist\n")
return(FALSE)
}
}
# Check if all transitions are valid
for (from_state in names(transitions)) {
if (!(from_state %in% names(states))) {
cat("Error: Transition from non-existent state", from_state, "\n")
return(FALSE)
}
for (input in names(transitions[[from_state]])) {
to_state <- transitions[[from_state]][[input]]
if (!(to_state %in% names(states))) {
cat("Error: Transition to non-existent state", to_state, "\n")
return(FALSE)
}
}
}
# Check if all states have an output
for (state in names(states)) {
if (is.null(states[[state]]$output)) {
cat("Error: State", state, "has no output\n")
return(FALSE)
}
}
# cat("FSM is well-formed\n")
return(TRUE)
}
),
)
# Create a new FSM
create_fsm <- function() {
num_states <- sample(2:10, 1)
state_names <- paste0("S", 1:num_states)
states <- lapply(state_names, function(s) {
list(output = sample(c("0", "1"), 1))
})
names(states) <- state_names
transitions <- lapply(state_names, function(s) {
num_transitions <- max(1, sample(1:10, 1)) # Ensure at least one transition
inputs <- sample(letters, num_transitions, replace = TRUE)
to_states <- sample(state_names, num_transitions, replace = TRUE)
trans <- setNames(to_states, inputs)
return(as.list(trans))
})
names(transitions) <- state_names
start_state <- sample(state_names, 1)
accept_states <- sample(state_names, 1)
FSM$new(states, transitions, start_state, accept_states)
}
# Mutation operation
mutate_fsm <- function(fsm) {
mutation_type <- sample(1:5, 1)
new_fsm <- fsm$copy()
if (mutation_type == 2 && length(new_fsm$states) <= 2) {
if (mutation_type == 3 && length(new_fsm$states) >= 10) {
mutation_type <- sample(c(1, 4, 5), 1)
} else {
mutation_type <- sample(c(1, 3, 4, 5), 1)
}
} else if (mutation_type == 3 && length(new_fsm$states) >= 10) {
sample(c(1, 2, 4, 5), 1)
}
cat(mutation_type)
if (mutation_type == 1) {
# Change output signal
state <- sample(names(new_fsm$states), 1)
new_output <- sample(new_fsm$output_alphabet, 1)
new_fsm$change_output(state, new_output)
} else if (mutation_type == 2) {
# Modify transition
from_state <- sample(names(new_fsm$states), 1)
input <- sample(new_fsm$input_alphabet, 1)
to_state <- sample(names(new_fsm$states), 1)
new_fsm$modify_transition(from_state, input, to_state)
} else if (mutation_type == 3 && length(new_fsm$states) < 10) {
# Add state
new_state <- paste0("S", length(new_fsm$states) + 1)
new_output <- sample(new_fsm$output_alphabet, 1)
new_fsm$add_state(new_state, new_output)
# Add at least one transition to/from the new state
from_state <- sample(c(names(new_fsm$states), new_state), 1)
to_state <- sample(c(names(new_fsm$states), new_state), 1)
input <- sample(new_fsm$input_alphabet, 1)
new_fsm$modify_transition(from_state, input, to_state)
} else if (mutation_type == 4 && length(new_fsm$states) > 2) {
# Remove state
state_to_remove <- sample(names(new_fsm$states), 1)
new_fsm$remove_state(state_to_remove)
} else if (mutation_type == 5) {
# Change start state
new_start_state <- sample(names(new_fsm$states), 1)
new_fsm$change_start_state(new_start_state)
}
new_fsm$check()
return(new_fsm)
}
# Evaluate FSM fitness
evaluate_fitness <- function(fsm, pos_examples, neg_examples) {
correct <- 0
total <- length(pos_examples) + length(neg_examples)
for (example in pos_examples) {
if (fsm$run(example) == "1") correct <- correct + 1
}
for (example in neg_examples) {
if (fsm$run(example) == "0") correct <- correct + 1
}
return(correct / total)
}
# Evolutionary Algorithm
evolve_fsm <- function(pos_examples, neg_examples, generations = 100) {
population <- replicate(10, create_fsm())
wlog <- list()
for (gen in 1:generations) {
# Create children through mutation
children <- lapply(population, mutate_fsm)
# Evaluate fitness of all FSMs
cat("eval...\n")
all_fsms <- c(population, children)
fitness_scores <- sapply(all_fsms, evaluate_fitness, pos_examples, neg_examples)
cat("max fitness: ")
cat(max(fitness_scores))
cat("\n")
# Select the best 10 FSMs for the next generation
population <- all_fsms[order(fitness_scores, decreasing = TRUE)[1:10]]
# Calculate statistics for the current generation
state_nums <- sapply(population, function(fsm) length(fsm$states))
transition_nums <- sapply(population, function(fsm) sum(sapply(fsm$transitions, function(trans) length(trans))))
wlog[[gen]] <- list(
generation = gen,
best_fitness = max(fitness_scores),
worst_fitness = min(fitness_scores),
average_fitness = mean(fitness_scores),
median_fitness = median(fitness_scores),
max_state_num = max(state_nums),
min_state_num = min(state_nums),
avg_state_num = mean(state_nums),
median_state_num = median(state_nums),
max_transition_num = max(transition_nums),
min_transition_num = min(transition_nums),
avg_transition_num = mean(transition_nums),
median_transition_num = median(transition_nums)
)
cat(sprintf("Generation %d: Best Fitness = %.4f, Avg Fitness = %.4f\n", gen, max(fitness_scores), mean(fitness_scores)))
cat(sprintf(" Min Fitness = %.4f, Std Dev = %.4f\n", min(fitness_scores), sd(fitness_scores)))
cat(sprintf(" Median Fitness = %.4f\n", median(fitness_scores)))
cat(sprintf(" Max States = %d, Min States = %d\n", max(state_nums), min(state_nums)))
cat(sprintf(" Avg States = %.2f, Median States = %.1f\n", mean(state_nums), median(state_nums)))
cat(sprintf(" Max Transitions = %d, Min Transitions = %d\n", max(transition_nums), min(transition_nums)))
cat(sprintf(" Avg Transitions = %.2f, Median Transitions = %.1f\n", mean(transition_nums), median(transition_nums)))
}
# Return the best FSM
best_fsm <- population[[which.max(sapply(population, evaluate_fitness, pos_examples, neg_examples))]]
return(list(res = best_fsm, wlog = wlog))
}
# Load example data
load("pos.example.RData")
load("neg.example.RData")
# Run the evolutionary algorithm
best_fsm <- evolve_fsm(pos.examples, neg.examples)
```