Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
441 views
in Technique[技术] by (71.8m points)

function - R: Miscellaneous Errors While Trying to Plot Graphs

I am working with R. I am following this tutorial (https://cran.r-project.org/web/packages/GA/vignettes/GA.html) and am learning how to optimize functions using the "genetic algorithm".

The entire process is illustrated in the code below:

Part 1: Generate some sample data ("train_data")

Part 2: Define the "fitness function" : the objective of my problem is to generate 7 random numbers

  • "[1]" (between 80 and 100)
  • "[2]" (between 85 and 120)
  • "[3]" (between 80 and 100)
  • "[4]" (between 90 and 120)
  • "[5]" (between 90 and 140)
  • "[6]" (between 180 and 400)
  • "[7]" (between 365 and 720)

and use these numbers to perform a series of data manipulation procedures on the train data. At the end of these data manipulation procedures, a "total" mean variable is calculated.

Part 3: The purpose of the "genetic algorithm" is to find the set of these 7 numbers that produce the largest value of the "total".

Below, I illustrate this entire process :

Part 1

#load libraries
library(dplyr)
library(GA)

# create some data for this example
a1 = rnorm(1000,100,10)
b1 = rnorm(1000,100,5)
c1 = sample.int(1000, 1000, replace = TRUE)
train_data = data.frame(a1,b1,c1)

Part 2

   #define fitness function
   fitness <- function(x) {

x1 = x[1]
x2 = x1 + x[2]
x3 = x[3]
x4 = x3 + x[4]

#bin data according to random criteria
train_data <- train_data %>%
    mutate(cat = ifelse(a1 <= x1 & b1 <= x3, "a",
                        ifelse(a1 <= x2 & b1 <= x4, "b", "c")))
   
train_data$cat = as.factor(train_data$cat)
   
#new splits
a_table = train_data %>%
    filter(cat == "a") %>%
    select(a1, b1, c1, cat)
   
b_table = train_data %>%
    filter(cat == "b") %>%
    select(a1, b1, c1, cat)
   
c_table = train_data %>%
    filter(cat == "c") %>%
    select(a1, b1, c1, cat)
   
   
   
   
#calculate  quantile ("quant") for each bin
   
table_a = data.frame(a_table%>% group_by(cat) %>%
                         mutate(quant = ifelse(c1 > x[5],1,0 )))
                     
table_b = data.frame(b_table%>% group_by(cat) %>%
                         mutate(quant = ifelse(c1 > x[6],1,0 )))
                                         
table_c = data.frame(c_table%>% group_by(cat) %>%
                         mutate(quant = ifelse(c1 > x[7],1,0 )))
                                                               
                                                               
                                                               
                                                               
#group all tables
                                                               
final_table = rbind(table_a, table_b, table_c)
# calculate the total mean : this is what needs to be optimized
mean = mean(final_table$quant)
}

Part 3

#run the genetic algorithm (20 times to keep it short):

GA <- ga(type = "real-valued", 
         fitness = fitness,
         lower = c(80, 1, 80, 1, 90,180, 365), upper = c(100, 20, 100, 20, 140,400,720), 
         popSize = 50, maxiter = 20, run = 20)

The above code (Part 1, Part 2, Part 3) all work fine.

Problem: Now, I am trying to produce some the of the visual plots from the tutorial:

First Plot - This Works:

plot(GA)

enter image description here

But I can't seem to produce the other plots from the tutorial:

Second Plot (using any 2 vairables): Does Not Work

lbound <- c(80,80,80,80,0,0,0)
ubound <- c(120,120,120,120,1,1,1)

curve(fitness, from = lbound, to = ubound, n = 1000)
points(GA@solution, GA@fitnessValue, col = 2, pch = 19)

 Error: Problem with `mutate()` column `cat`.
i `cat = ifelse(...)`.
x argument "random_3" is missing, with no default
Run `rlang::last_error()` to see where the error occurred. 

Error in xy.coords(x, y) : 'x' and 'y' lengths differ

Third Plot(using any 2 variables) : Does Not Work

x <- random_2 <- seq(80, 120, by = 0.1)
f <- outer(x1, x2, fitness)
persp3D(x1, x2, fitness, theta = 50, phi = 20, col.palette = bl2gr.colors)

Error: Problem with `mutate()` column `cat`.
i `cat = ifelse(...)`.
x argument "random_3" is missing, with no default
Run `rlang::last_error()` to see where the error occurred.
In addition: Warning message:
 Error: Problem with `mutate()` column `cat`.
i `cat = ifelse(...)`.
x argument "random_3" is missing, with no default
Run `rlang::last_error()` to see where the error occurred. 

Error in z[-1, -1] : object of type 'closure' is not subsettable

Fourth Plot (using any 2 variables): Does Not Work

filled.contour(x1, x2, fitness, color.palette = bl2gr.colors)

Error in min(x, na.rm = na.rm) : invalid 'type' (list) of argument

Can someone please show me how to fix these errors?

Thanks

See Question&Answers more detail:os

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

The input of your fitness-function "x" has 7 dimensions (x = c(x1,x2,x3,x4,x5,x6,x7)). The curve function is only one-dimensional (x = x1). If you create a fitness-function with a one-dimensional x and one-dimensional upper and lower bounds (which is vectorized), it will work out.

The outer-function is two-dimensional, so the "x" of your fitness-function must be two-dimensional (e.g., x = c(x1,x2)) (and the function must be vectorized). So, again it is not possible to plot your 7-dimensional fitness function.

Maybe you can check if it is possible to formulate the fitness function in a one- or two-dimensional way. Or you find another way of visualizing it, e.g. techniques to visualize multidimensional data. For example, you could fix 5 of the 7 values to the values of GA@solution and plot the surface of the two free parameters with the outer function and repeat it for every two pairs. It depends on your problem, if this can be a solution for you.


与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...