Visits: 170

Programming Languages 的最后一次作业

这作业在网上的参考资料就比较少了，看来坚持到最后的人不多呀

作业的难点在于 Double-Dispatch，如果不能很好地理解，那么会极大加重代码量，还容易出错

首先要读懂 SML/NJ 的代码，然后完成缺少的部分

由于之前已经有过大量 SML/NJ 的训练，所以这里的依葫芦画瓢应该不难

接着是 Ruby 的风格，这是这一节的学习重点，在子类、父类、相似方法这样的设计上，SML 和 Ruby 采用了完全不同的设计思路，它们各自的优劣是教授反复提及的，也体现在了编程作业上

最难的部分是线段相交，我采用了分类讨论的方法，做到不重不漏，但在线段平行时直接把 SML 代码翻译成了 Ruby 代码，没有经过仔细推敲，应该是可以和之前的 4 类再合并一下，使整体更简化

以下代码获得 100 分并通过全部测试数据

(* University of Washington, Programming Languages, Homework 7, hw7.sml 
   (See also Ruby code.)
*)

(* Do not make changes to this code except where you see comments containing
   the word CHANGE. *)

(* expressions in a little language for 2D geometry objects
   values: points, lines, vertical lines, line segments
   other expressions: intersection of two expressions, lets, variables, 
                      (shifts added by you)
*)
datatype geom_exp = 
           NoPoints
	 | Point of real * real (* represents point (x,y) *)
	 | Line of real * real (* represents line (slope, intercept) *)
	 | VerticalLine of real (* x value *)
	 | LineSegment of real * real * real * real (* x1,y1 to x2,y2 *)
	 | Intersect of geom_exp * geom_exp (* intersection expression *)
	 | Let of string * geom_exp * geom_exp (* let s = e1 in e2 *)
	 | Var of string
(* CHANGE add shifts for expressions of the form Shift(deltaX, deltaY, exp *)
	 | Shift of real * real * geom_exp

exception BadProgram of string
exception Impossible of string

(* helper functions for comparing real numbers since rounding means
   we should never compare for equality *)

val epsilon = 0.00001

fun real_close (r1,r2) = 
    (Real.abs (r1 - r2)) < epsilon

(* notice curried *)
fun real_close_point (x1,y1) (x2,y2) = 
    real_close(x1,x2) andalso real_close(y1,y2)

(* helper function to return the Line or VerticalLine containing 
   points (x1,y1) and (x2,y2). Actually used only when intersecting 
   line segments, but might be generally useful *)
fun two_points_to_line (x1,y1,x2,y2) = 
    if real_close(x1,x2)
    then VerticalLine x1
    else
	let 
	    val m = (y2 - y1) / (x2 - x1)
	    val b = y1 - m * x1
	in
	    Line(m,b)
	end

(* helper function for interpreter: return value that is the intersection
   of the arguments: 25 cases because there are 5 kinds of values, but
   many cases can be combined, especially because intersection is commutative.
   Do *not* call this function with non-values (e.g., shifts or lets)
 *)
fun intersect (v1,v2) =
    case (v1,v2) of
	
       (NoPoints, _) => NoPoints (* 5 cases *)
     | (_, NoPoints) => NoPoints (* 4 additional cases *)

     | 	(Point p1, Point p2) => if real_close_point p1 p2
				then v1
				else NoPoints

      | (Point (x,y), Line (m,b)) => if real_close(y, m * x + b)
				     then v1
				     else NoPoints

      | (Point (x1,_), VerticalLine x2) => if real_close(x1,x2)
					   then v1
					   else NoPoints

      | (Point _, LineSegment seg) => intersect(v2,v1)

      | (Line _, Point _) => intersect(v2,v1)

      | (Line (m1,b1), Line (m2,b2)) =>
	if real_close(m1,m2) 
	then (if real_close(b1,b2)
	      then v1 (* same line *)
	      else  NoPoints) (* parallel lines do not intersect *)
	else 
	    let (* one-point intersection *)
		val x = (b2 - b1) / (m1 - m2)
		val y = m1 * x + b1
	    in
		Point (x,y)
	    end

      | (Line (m1,b1), VerticalLine x2) => Point(x2, m1 * x2 + b1)

      | (Line _, LineSegment _) => intersect(v2,v1)

      | (VerticalLine _, Point _) => intersect(v2,v1)
      | (VerticalLine _, Line _)  => intersect(v2,v1)

      | (VerticalLine x1, VerticalLine x2) =>
	if real_close(x1,x2)
	then v1 (* same line *)
	else NoPoints (* parallel *)

      | (VerticalLine _, LineSegment seg) => intersect(v2,v1)

      | (LineSegment seg, _) => 
	(* the hard case, actually 4 cases because v2 could be a point,
	   line, vertical line, or line segment *)
	(* First compute the intersection of (1) the line containing the segment 
           and (2) v2. Then use that result to compute what we need. *)
	(case intersect(two_points_to_line seg, v2) of
	    NoPoints => NoPoints 
	  | Point(x0,y0) => (* see if the point is within the segment bounds *)
	    (* assumes v1 was properly preprocessed *)
	    let 
		fun inbetween(v,end1,end2) =
		    (end1 - epsilon <= v andalso v <= end2 + epsilon)
		    orelse (end2 - epsilon <= v andalso v <= end1 + epsilon)
		val (x1,y1,x2,y2) = seg
	    in
		if inbetween(x0,x1,x2) andalso inbetween(y0,y1,y2)
		then Point(x0,y0)
		else NoPoints
	    end
	  | Line _ => v1 (* so segment seg is on line v2 *)
	  | VerticalLine _ => v1 (* so segment seg is on vertical-line v2 *)
	  | LineSegment seg2 => 
	    (* the hard case in the hard case: seg and seg2 are on the same
               line (or vertical line), but they could be (1) disjoint or 
               (2) overlapping or (3) one inside the other or (4) just touching.
	       And we treat vertical segments differently, so there are 4*2 cases.
	     *)
	    let
		val (x1start,y1start,x1end,y1end) = seg
		val (x2start,y2start,x2end,y2end) = seg2
	    in
		if real_close(x1start,x1end)
		then (* the segments are on a vertical line *)
		    (* let segment a start at or below start of segment b *)
		    let 
			val ((aXstart,aYstart,aXend,aYend),
			     (bXstart,bYstart,bXend,bYend)) = if y1start < y2start
							      then (seg,seg2)
							      else (seg2,seg)
		    in
			if real_close(aYend,bYstart)
			then Point (aXend,aYend) (* just touching *)
			else if aYend < bYstart
			then NoPoints (* disjoint *)
			else if aYend > bYend
			then LineSegment(bXstart,bYstart,bXend,bYend) (* b inside a *)
			else LineSegment(bXstart,bYstart,aXend,aYend) (* overlapping *)
		    end
		else (* the segments are on a (non-vertical) line *)
		    (* let segment a start at or to the left of start of segment b *)
		    let 
			val ((aXstart,aYstart,aXend,aYend),
			     (bXstart,bYstart,bXend,bYend)) = if x1start < x2start
							      then (seg,seg2)
							      else (seg2,seg)
		    in
			if real_close(aXend,bXstart)
			then Point (aXend,aYend) (* just touching *)
			else if aXend < bXstart
			then NoPoints (* disjoint *)
			else if aXend > bXend
			then LineSegment(bXstart,bYstart,bXend,bYend) (* b inside a *)
			else LineSegment(bXstart,bYstart,aXend,aYend) (* overlapping *)
		    end	
	    end						
	  | _ => raise Impossible "bad result from intersecting with a line")
      | _ => raise Impossible "bad call to intersect: only for shape values"

(* interpreter for our language: 
   * takes a geometry expression and returns a geometry value
   * for simplicity we have the top-level function take an environment,
     (which should be [] for the whole program
   * we assume the expression e has already been "preprocessed" as described
     in the homework assignment: 
         * line segments are not actually points (endpoints not real close)
         * lines segment have left (or, if vertical, bottom) coordinate first
*)

fun eval_prog (e,env) =
    case e of
	NoPoints => e (* first 5 cases are all values, so no computation *)
      | Point _  => e
      | Line _   => e
      | VerticalLine _ => e
      | LineSegment _  => e
      | Var s => 
	(case List.find (fn (s2,v) => s=s2) env of
	     NONE => raise BadProgram("var not found: " ^ s)
	   | SOME (_,v) => v)
      | Let(s,e1,e2) => eval_prog (e2, ((s, eval_prog(e1,env)) :: env))
      | Intersect(e1,e2) => intersect(eval_prog(e1,env), eval_prog(e2, env))
(* CHANGE: Add a case for Shift expressions *)
	  | Shift(dx, dy, e) => case eval_prog(e, env) of
      						NoPoints => NoPoints
      						  | Point(x, y) => Point(x + dx, y + dy)
      						  | Line(m, b) => Line(m, b + dy - m * dx) (* y = m * x + b, (y + dy) = m * (x + dx) + b' => b' = m * x + b + dy - m * x - m * dx = b + dy - m * dx *)
      						  | VerticalLine(x) => VerticalLine(x + dx)
      						  | LineSegment(x1, y1, x2, y2) => LineSegment(x1 + dx, y1 + dy, x2 + dx, y2 + dy)

(* CHANGE: Add function preprocess_prog of type geom_exp -> geom_exp *)
fun preprocess_prog e =
    case e of
    	LineSegment(x1, y1, x2, y2) =>
    		if real_close(x1, x2) then
    			if real_close(y1, y2) then
    				Point(x1, y1)
    			else
    				if y1 > y2 then
    					LineSegment(x2, y2, x1, y1)
    				else
    					e
    		else
    			if x1 > x2 then
    				LineSegment(x2, y2, x1, y1)
    			else
    				e
      | Let(s, e1, e2) => Let(s, preprocess_prog e1, preprocess_prog e2)
      | Intersect(e1, e2) => Intersect(preprocess_prog e1, preprocess_prog e2)
      | Shift(dx, dy, e) => Shift(dx, dy, preprocess_prog e)
      | _ => e

# University of Washington, Programming Languages, Homework 7, hw7.rb 
# (See also ML code)

# a little language for 2D geometry objects

# each subclass of GeometryExpression, including subclasses of GeometryValue,
#  needs to respond to messages preprocess_prog and eval_prog
#
# each subclass of GeometryValue additionally needs:
#   * shift
#   * intersect, which uses the double-dispatch pattern
#   * intersectPoint, intersectLine, and intersectVerticalLine for 
#       for being called by intersect of appropriate clases and doing
#       the correct intersection calculuation
#   * (We would need intersectNoPoints and intersectLineSegment, but these
#      are provided by GeometryValue and should not be overridden.)
#   *  intersectWithSegmentAsLineResult, which is used by 
#      intersectLineSegment as described in the assignment
#
# you can define other helper methods, but will not find much need to

# Note: geometry objects should be immutable: assign to fields only during
#       object construction

# Note: For eval_prog, represent environments as arrays of 2-element arrays
# as described in the assignment

class GeometryExpression  
  # do *not* change this class definition
  Epsilon = 0.00001
end

class GeometryValue 
  # do *not* change methods in this class definition
  # you can add methods if you wish

  private
  # some helper methods that may be generally useful
  def real_close(r1,r2) 
    (r1 - r2).abs < GeometryExpression::Epsilon
  end
  def real_close_point(x1,y1,x2,y2) 
    real_close(x1,x2) && real_close(y1,y2)
  end
  # two_points_to_line could return a Line or a VerticalLine
  def two_points_to_line(x1,y1,x2,y2) 
    if real_close(x1,x2)
      VerticalLine.new x1
    else
      m = (y2 - y1).to_f / (x2 - x1)
      b = y1 - m * x1
      Line.new(m,b)
    end
  end

  public
  # we put this in this class so all subclasses can inherit it:
  # the intersection of self with a NoPoints is a NoPoints object
  def intersectNoPoints np
    np # could also have NoPoints.new here instead
  end

  # we put this in this class so all subclasses can inhert it:
  # the intersection of self with a LineSegment is computed by
  # first intersecting with the line containing the segment and then
  # calling the result's intersectWithSegmentAsLineResult with the segment
  def intersectLineSegment seg
    line_result = intersect(two_points_to_line(seg.x1,seg.y1,seg.x2,seg.y2))
    line_result.intersectWithSegmentAsLineResult seg
  end

  # Move them to super class to simplify the code
  def eval_prog env 
    self # all values evaluate to self
  end
  def preprocess_prog
    self # no pre-processing to do here
  end
end

class NoPoints < GeometryValue
  # do *not* change this class definition: everything is done for you
  # (although this is the easiest class, it shows what methods every subclass
  # of geometry values needs)
  # However, you *may* move methods from here to a superclass if you wish to

  # Note: no initialize method only because there is nothing it needs to do

  def shift(dx,dy)
    self # shifting no-points is no-points
  end
  def intersect other
    other.intersectNoPoints self # will be NoPoints but follow double-dispatch
  end
  def intersectPoint p
    self # intersection with point and no-points is no-points
  end
  def intersectLine line
    self # intersection with line and no-points is no-points
  end
  def intersectVerticalLine vline
    self # intersection with line and no-points is no-points
  end
  # if self is the intersection of (1) some shape s and (2) 
  # the line containing seg, then we return the intersection of the 
  # shape s and the seg.  seg is an instance of LineSegment
  def intersectWithSegmentAsLineResult seg
    self
  end
end

class Point < GeometryValue
  # *add* methods to this class -- do *not* change given code and do not
  # override any methods

  # Note: You may want a private helper method like the local
  # helper function inbetween in the ML code
  attr_reader :x, :y
  def initialize(x,y)
    @x = x
    @y = y
  end

  def shift(dx, dy)
    Point.new(x + dx, y+ dy)
  end

  def intersect other
    other.intersectPoint self
  end

  def intersectPoint p
    if real_close_point(x, y, p.x, p.y)
      self
    else
      NoPoints.new
    end
  end

  def intersectLine l
    if real_close(y, l.m * x + l.b)
      self
    else
      NoPoints.new
    end
  end

  def intersectVerticalLine vl
    if real_close(x, vl.x)
      self
    else
      NoPoints.new
    end
  end

  def intersectWithSegmentAsLineResult seg
    seg.intersectPoint self
  end

end

class Line < GeometryValue
  # *add* methods to this class -- do *not* change given code and do not
  # override any methods
  attr_reader :m, :b 
  def initialize(m,b)
    @m = m
    @b = b
  end

  def shift(dx, dy)
    # (y + dy) = m * (x + dx) + b' -> b' = y + dy - m * x - m * dx = dy - m * dx + (y - m * x) = dy - m * dx + b 
    Line.new(m, b + dy - m * dx)
  end

  def intersect other
    other.intersectLine self
  end

  def intersectLine l
    if real_close(m, l.m)
      if real_close(b, l.b)
        self
      else
        NoPoints.new
      end
    else
      # y1 = m1 x + b1 = m2 x + b2
      x0 = (l.b - b) / (m - l.m)
      y0 = m * x0 + b
      Point.new(x0, y0)
    end
  end

  def intersectPoint p
    p.intersectLine self
  end
    
  def intersectVerticalLine vl
    Point.new(vl.x, m * vl.x + b)
  end

  def intersectWithSegmentAsLineResult seg
    seg.intersectLine self
  end
end

class VerticalLine < GeometryValue
  # *add* methods to this class -- do *not* change given code and do not
  # override any methods
  attr_reader :x
  def initialize x
    @x = x
  end

  def shift(dx, dy)
    VerticalLine.new(x + dx)
  end

  def intersect other
    other.intersectVerticalLine self
  end

  def intersectPoint p
    p.intersectVerticalLine self
  end

  def intersectLine l
    l.intersectVerticalLine self
  end

  def intersectVerticalLine v
    if real_close(x, v.x)
      self
    else
      NoPoints.new
    end
  end

  def intersectWithSegmentAsLineResult seg
    seg.intersectVerticalLine self
  end

end

class LineSegment < GeometryValue
  # *add* methods to this class -- do *not* change given code and do not
  # override any methods
  # Note: This is the most difficult class.  In the sample solution,
  #  preprocess_prog is about 15 lines long and 
  # intersectWithSegmentAsLineResult is about 40 lines long
  attr_reader :x1, :y1, :x2, :y2
  def initialize (x1,y1,x2,y2)
    @x1 = x1
    @y1 = y1
    @x2 = x2
    @y2 = y2
  end

  def preprocess_prog
    if real_close(x1, x2) && real_close(y1, y2)
      Point.new(x1, y1)
    elsif real_close(x1, x2) && y1 > y2
      LineSegment.new(x2, y2, x1, y1)
    elsif x1 > x2
      LineSegment.new(x2, y2, x1, y1)
    else
      self
    end      
  end
  
  def shift(dx, dy)
     LineSegment.new(x1 + dx, y1 + dy, x2 + dx, y2 + dy)
  end

  def intersect other
    other.intersectWithSegmentAsLineResult self
  end

  def inbetween (v, end1, end2)
    ((end1 - GeometryExpression::Epsilon <= v) && (v <= end2 + GeometryExpression::Epsilon)) || ((end2 - GeometryExpression::Epsilon <= v) && (v <= end1 + GeometryExpression::Epsilon))
  end

  def intersectPoint p
  	if real_close(x1, x2) && real_close(x1, p.x) && inbetween(p.y, y1, y2)
  	  Point.new(p.x, p.y)
    else
      m2 = (y2 - y1) / (x2 - x1)
      b2 = y2 - m2 * x2
      if real_close(p.x * m2 + b2, p.y)
		if inbetween(p.x, x1, x2) && inbetween(p.y, y1, y2)
      	  Point.new(p.x, p.y)
    	else
      	  NoPoints.new
      	end
      else
      	NoPoints.new
      end
    end   
  end
  
  def intersectLine l
    if real_close(x1, x2)
      Point.new(x1,  l.m * x1 + l.b)
    else
      m2 = (y2 - y1) / (x2 - x1)
      b2 = y2 - m2 * x2
      if real_close(l.m, m2)
        if real_close(l.b, b2)
          LineSegment.new(x1, y1, x2, y2)
        else
          NoPoints.new
        end
      else
        px = (b2 - l.b) / (l.m - m2)
        if inbetween(px, x1, x2)
          Point.new(px, px * l.m + l.b)
        else
          NoPoints.new
        end
      end
    end
  end

  def intersectVerticalLine vl
    if real_close(x1, x2)
      if real_close(x1, vl.x)
        self
      else
      	NoPoints.new
      end
    else
      if vl.x < x1 || vl.x > x2
      	NoPoints.new
      else
        Point.new(vl.x, y1 + (y2 - y1) * (vl.x - x1) / (x2 - x1))
      end
    end
  end

  # SEE HW7.SML FOR DETAILS
  def sameLine seg
  	if real_close(x1, x2) # the segments are on a vertical line
      # let segment a start at or below start of segment b
      if y1 < seg.y1
        aXstart, aYstart, aXend, aYend = [x1, y1, x2, y2]
        bXstart, bYstart, bXend, bYend = [seg.x1, seg.y1, seg.x2, seg.y2]
      else
        aXstart, aYstart, aXend, aYend = [seg.x1, seg.y1, seg.x2, seg.y2]
        bXstart, bYstart, bXend, bYend = [x1, y1, x2, y2]
      end
      if real_close(aYend, bYstart)
        Point.new(aXend, aYend) # just touching
      elsif aYend < bYstart
        NoPoints.new # disjoint
      elsif aYend > bYend
        LineSegment.new(bXstart, bYstart, bXend, bYend) # b inside a
      else
        LineSegment.new(bXstart, bYstart, aXend, aYend) # overlapping
      end
    else
      if x1 < seg.x1
        aXstart, aYstart, aXend, aYend = [x1, y1, x2, y2]
        bXstart, bYstart, bXend, bYend = [seg.x1, seg.y1, seg.x2, seg.y2]
      else
        aXstart, aYstart, aXend, aYend = [seg.x1, seg.y1, seg.x2, seg.y2]
        bXstart, bYstart, bXend, bYend = [x1, y1, x2, y2]
      end
      if real_close(aXend, bXstart)
        Point.new(aXend, aYend) # just touching
      elsif aXend < bXstart
        NoPoints.new # disjoint
      elsif aXend > bXend
        LineSegment.new(bXstart, bYstart, bXend, bYend) # b inside a
      else
        LineSegment.new(bXstart, bYstart, aXend, aYend) # overlapping
      end
    end
  end

  def intersectWithSegmentAsLineResult seg
  	if real_close(x1, x2) && real_close(seg.x1, seg.x2)
  	  sameLine(seg)
  	elsif real_close(x1, x2) && (!real_close(seg.x1, seg.x2))
  	  m2 = (seg.y2 - seg.y1) / (seg.x2 - seg.x1)
  	  b2 = seg.y1 - m2 * seg.x1
  	  xx = x1
  	  yy = xx * m2 + b2
  	  if inbetween(xx, seg.x1, seg.x2) && inbetween(yy, y1, y2) && inbetween(yy, seg.y1, seg.y2)
  	  	Point.new(xx, yy)
  	  else
  	    NoPoints.new
  	  end
  	elsif (!real_close(x1, x2)) && real_close(seg.x1, seg.x2)
  	  m1 = (y2 - y1) / (x2 - x1)
  	  b1 = y1 - m1 * x1
  	  xx = seg.x1
  	  yy = xx * m1 + b1
  	  if inbetween(xx, x1, x2) && inbetween(yy, y1, y2) && inbetween(yy, seg.y1, seg.y2)
  	  	Point.new(xx, yy)
  	  else
  	    NoPoints.new
  	  end
  	else
      m1 = (y2 - y1) / (x2 - x1)
  	  b1 = y1 - m1 * x1
  	  m2 = (seg.y2 - seg.y1) / (seg.x2 - seg.x1)
  	  b2 = seg.y1 - m2 * seg.x1
  	  if real_close(m1, m2)
  	    sameLine(seg)
  	  else
  	  	xx = (b2 - b1) / (m1 - m2)
  	  	yy = xx * m1 + b1
  	  	if inbetween(xx, x1, x2) && inbetween(xx, seg.x1, seg.x2) && inbetween(yy, y1, y2) && inbetween(yy, seg.y1, seg.y2)
  	  	  Point.new(xx, yy)
  	  	else
  	  	  NoPoints.new
  	  	end
  	  end
    end
  end
end

# Note: there is no need for getter methods for the non-value classes

class Intersect < GeometryExpression
  # *add* methods to this class -- do *not* change given code and do not
  # override any methods
  def initialize(e1,e2)
    @e1 = e1
    @e2 = e2
  end

  def preprocess_prog
    Intersect.new(@e1.preprocess_prog, @e2.preprocess_prog)
  end

  def eval_prog env
    @e1.eval_prog(env).intersect(@e2.eval_prog(env))
  end
end

class Let < GeometryExpression
  # *add* methods to this class -- do *not* change given code and do not
  # override any methods
  # Note: Look at Var to guide how you implement Let
  def initialize(s,e1,e2)
    @s = s
    @e1 = e1
    @e2 = e2
  end

  def preprocess_prog
    Let.new(@s, @e1.preprocess_prog, @e2.preprocess_prog)
  end
  
  def eval_prog env
    @e2.eval_prog([[@s, @e1.eval_prog(env)]] + env)
  end
end

class Var < GeometryExpression
  # *add* methods to this class -- do *not* change given code and do not
  # override any methods
  def initialize s
    @s = s
  end
  def eval_prog env # remember: do not change this method
    pr = env.assoc @s
    raise "undefined variable" if pr.nil?
    pr[1]
  end

  def preprocess_prog
    self
  end
end

class Shift < GeometryExpression
  # *add* methods to this class -- do *not* change given code and do not
  # override any methods
  def initialize(dx,dy,e)
    @dx = dx
    @dy = dy
    @e = e
  end

  def preprocess_prog
    Shift.new(@dx, @dy, @e.preprocess_prog)
  end

  def eval_prog env
    @e.eval_prog(env).shift(@dx, @dy)
  end
end