Question

为了多次选择点（定义间隔），我运行代码下面，现在我想修改这段代码，每当我选择一行时，系统会问我是否对结果感到满意。如果我说是，则该函数保留该记录，否则将其从输出和绘图中删除。同样通过点击一个停止我可以完成并离开该功能并获得输出。

func <- function(f){
  counter <- 1
  output <- list()
  while (TRUE) {    
    id.co1 <- identify(f$speed, f$dist,labels=row.names(f), n = 2, pos = TRUE,plot = TRUE)
    xy <- f[c(id.co1$ind[1],id.co1$ind[2]),]
    lines(xy, col="red", lwd=5)
    lm(dist~speed, xy)
    abline(coef(lm(dist~speed, xy)),col="blue") 
    x.co1 <- f$speed[id.co1$ind[1]:id.co1$ind[2]]
    y.co1 <- f$dist[id.co1$ind[1]:id.co1$ind[2]]
    m.co1 <- lm(y.co1 ~ x.co1)
    output[[counter]] <- list(xco =x.co1, yco=y.co1, lm =m.co1)
    counter <- counter+1
    continue <- readline("again? y/n: ")
#break the loop if the answer is 'n' or 'N'
    if (tolower(continue)=="n") break

  }
  output
}
speed<-cars$speed
dist<-cars$dist
level<-c(1:50)   
f<-data.frame(speed,dist,level)
plot(speed, dist, main="Milage vs. Car Weight", 
    xlab="Weight", ylab="Mileage", pch=18, col="blue")
text(speed, dist, row.names(f), cex=0.6, pos=4, col="red")
func(f)

我尝试以这种方式修改此代码，但它没有工作，因为首先我不知道如何定义停止，只要点击一个停止我想完成/离开算法以及下面的代码仍然保留选定的点，虽然我对他们不满意。

    func <- function(f){
  counter <- 1
  output <- list()
  while (TRUE) {    
    id.co1 <- identify(f$speed, f$dist,labels=row.names(f), n = 2, pos = TRUE,plot = TRUE)
    xy <- f[c(id.co1$ind[1],id.co1$ind[2]),]
    lines(xy, col="red", lwd=5)
    continue <- readline("are you happy with the line? y/n: ")
    if (tolower(continue)=="y") {  
    lm(dist~speed, xy)
    abline(coef(lm(dist~speed, xy)),col="blue") 
    x.co1 <- f$speed[id.co1$ind[1]:id.co1$ind[2]]
    y.co1 <- f$dist[id.co1$ind[1]:id.co1$ind[2]]
    m.co1 <- lm(y.co1 ~ x.co1)
    output[[counter]] <- list(xco =id.co1)
    counter <- counter+1
                               }
   continuee <- readline("Stop? y/n: ")
   if (tolower(continuee)=="y") break

              }
  output
}
speed<-cars$speed
dist<-cars$dist
level<-c(1:50)   
f<-data.frame(speed,dist,level)
plot(speed, dist, main="Milage vs. Car Weight", 
    xlab="Weight", ylab="Mileage", pch=18, col="blue")
text(speed, dist, row.names(f), cex=0.6, pos=4, col="red")
all1<-func(f)

修改code_Deleting绘图中的一条线

0 个答案: