R/utoronto_radford_csc120/a1funs.r

   1 # source("a1funs.r")
   2
   3 distance <- function (pa,pb) {
   4         differ <- pa-pb
   5         diss <- sum(differ*differ)
   6         sqrt(diss)
   7 }
   8
   9 total_distance <- function (mpoints,lpairs) {
  10         dis_summer <- 0
  11         for (edge in lpairs) {
  12                 curr_dis <- distance(mpoints[edge[1],],mpoints[edge[2],])
  13                 dis_summer <- dis_summer + curr_dis
  14                 #print(c(edge,curr_dis,dis_summer))
  15         }
  16         dis_summer
  17 }
  18
  19 plot_pairs <- function (mpoints,lpairs,mytitle='',plot=FALSE, wait=TRUE) {
  20         if (plot == FALSE) return
  21         if (wait == TRUE) readline(prompt="Press [enter] to continue")
  22         plot(mpoints,type='p',xlab="x",ylab='y',pch = 19)
  23         for (edge in lpairs) {
  24                 xyxy <- mpoints[edge[1:2],]
  25                 lines(xyxy[,1],xyxy[,2])
  26         }
  27         tdis <- total_distance(mpoints,lpairs)
  28         title(paste('Total distance',tdis,mytitle))
  29 }
  30
  31 random_pairings <- function (mpoints) {
  32         n <- nrow(mpoints)
  33         n <- as.integer(n/2)*2
  34         smp <- sample(n)
  35         foo <- matrix(smp,ncol=2)
  36         lapply(1:nrow(foo), function(i) foo[i,])
  37         # lapply(seq_len(ncol(x)), function(i) x[,i])
  38 }
  39
  40 improve_pairings <- function (mpoints,inpairs,plot=FALSE) {
  41         maxcnt <- length(inpairs)
  42         #lpairs <- inpairs[sample(maxcnt)]
  43         lpairs <- inpairs
  44         for (i in 1:(maxcnt-1)) {
  45                 for (j in (i+1):maxcnt) {
  46                 #ti <- 1:maxcnt
  47                 #for (j in ti[ti!=i]) {
  48                         edgeO <- lpairs[c(i,j)]
  49                         abxy <- unlist(edgeO)
  50                         #xxyy <- simplify2array(edgeO)
  51                         axby <- list(c(abxy[c(1,3)]),abxy[c(2,4)])
  52                         aybx <- list(c(abxy[c(1,4)]),abxy[c(2,3)])
  53                         disO <- total_distance(mpoints,edgeO)
  54                         disaxby <- total_distance(mpoints,axby)
  55                         disaybx <- total_distance(mpoints,aybx)
  56                         flag <- 0
  57                         if (disaxby < disO) {
  58                                 lpairs[i] <- axby[1]
  59                                 lpairs[j] <- axby[2]
  60                                 flag <- 1
  61                         }
  62                         if (disaybx < disO) {
  63                                 lpairs[i] <- aybx[1]
  64                                 lpairs[j] <- aybx[2]
  65                                 flag <- 2
  66                                 if (disaxby < disaybx) {
  67                                         lpairs[i] <- axby[1]
  68                                         lpairs[j] <- axby[2]
  69                                         flag <- 3
  70                                 }
  71                         }
  72                         if (DEBUG && flag) {
  73                                 plot_pairs(mpoints,lpairs,paste(i,j),plot,wait=F)
  74                                 Sys.sleep(0.7)
  75                         }
  76                 }
  77         }
  78         lpairs
  79 }
  80
  81 find_pairings <- function (mpoints, tries=1, plot=FALSE) {
  82         pairs0 <- random_pairings(mpoints)
  83         plot_pairs(mpoints,pairs0,'Init.',plot)
  84         lastpairs <- pairs0
  85         for (i in 1:tries) {
  86                 new_pairs <- improve_pairings(mpoints,lastpairs)
  87                 #plot_pairs(mpoints,new_pairs,paste('Time(s)',i),plot)
  88                 lastpairs <- new_pairs
  89         }
  90         plot_pairs(mpoints,new_pairs,paste('Time(s)',i),plot)
  91 }
  92
  93 find_pairingsX <- function (mpoints, tries=1, plot=FALSE) {
  94         pairs0 <- random_pairings(mpoints)
  95         plot_pairs(mpoints,pairs0,'Init.',plot)
  96         cnt <- length(pairs0)
  97         if (tries > cnt) tries <- cnt
  98         if (tries < 1) tries <- 1
  99         need_id <- sample(cnt)[1:tries]
 100         need_imp <- pairs0[need_id]
 101         had_imp <- improve_pairings(mpoints,need_imp)
 102         pairs1 <- pairs0
 103         for (i in 1:tries) {
 104                 pairs1[need_id[i]] <- had_imp[i]
 105         }
 106         plot_pairs(mpoints,pairs1,paste('Tries(s)',tries),plot)
 107 }
 108