R/VisualAngleCalculations.R

Defines functions visangle3D.l visangle3D lawOfCos viewdist stimsize visangle degrees radians aspect pythag dist3D conv2Dto3D conv3Dto2D m2in in2m mi2km km2mi

Documented in aspect conv2Dto3D conv3Dto2D degrees dist3D in2m km2mi lawOfCos m2in mi2km pythag radians stimsize viewdist visangle visangle3D visangle3D.l

#' Convert kilometers to miles
#'
#' @export
#' @param km numeric value in kilometers (km)
#' @return numeric a value in miles
km2mi <- function(km) {
  return(km/mi2km(1))
}

#' Convert miles to kilometers
#'
#' @export
#' @param mi numeric value in miles (mi)
#' @return numeric a value in km
mi2km <- function(mi) {
  return(in2m(mi*63360)/1000)
}

#' Convert inches to meters
#'
#' @export
#' @param inches A value in inches
#' @return numeric a value in meters
in2m <- function(inches) {return((inches * 2.54 * .01))} #converting from inches to cm to meters

#' Convert meters to inches
#'
#' @export
#' @param m A value in meters
#' @return numeric a value in inchs
m2in <- function(m) {return(m / in2m(1))}
NULL

#' Calculate the projection position of a real world object
#'
#' Given the position of an object in 3D space and the depth of the projection plane,
#' calculate the position of the projection of that object on projection plane
#'
#' @param TargetPosition The targets' position in width and/or height coordinates
#' @param TargetDepth    The targets' position in depth coordinates
#' @param ScreenDepth    The position of the projection plane in depth coordinates
#' @export conv3Dto2D
#' @return numeric Projection position in the coordinate type specified in TargetPosition
conv3Dto2D <- function(TargetPosition,TargetDepth,ScreenDepth) {
  TargetPosition * (ScreenDepth/TargetDepth)
}
NULL

#' Calculate a real world position of a projected object
#'
#' Given the position of an object on the projection plane, the real depth of the object,
#' and the depth of the projection plane,
#' calculate the position of the real-world object
#'
#' @export conv2Dto3D
#' @param ScreenPosition The position of the object on the screen
#' @param TargetDepth    The targets' position in depth coordinates
#' @param ScreenDepth    The position of the projection plane in depth coordinates
#' @return numeric 3D position in the coordinate axis specified in TargetPosition
conv2Dto3D <- function(ScreenPosition,TargetDepth,ScreenDepth) {
	ScreenPosition/(ScreenDepth/TargetDepth)
}
NULL

#' Calculate the distance between two 3D points
#'
#' @export dist3D
#' @param point1 The location of the first point as a numeric vector of length 3 c(X,Y,Z) or ordered list
#' @param point2 The location of the second point as a numeric vector of length 3 c(X,Y,Z) or ordered list
#' @return numeric distance between two points
#' @references
#' \url{http://www.calculatorsoup.com/calculators/geometry-solids/distance-two-points.php}
#' @examples 
#' dist3D(c(5,6,2),c(-7,11,-13))
#' dist3D(list(c(0,0),c(0:0),c(0,0)),list(1:2,3:4,5:6))
#' dist3D(list(5,6,2),list(-7,11,-13))
dist3D <- function(point1,point2) {
  if(is.list(point1) & is.list(point2)) {
    if ((!is.list(point1)) | (!is.list(point2))) {stop("In russmisc::dist3D: point1 or point2 is not a list")}
    if (!all(names(point1)==names(point2))) {stop("In russmisc::dist3D: List names not the same for point1 and point2")}
    if ((!length(point1)==3) & (!length(point2)==3)) {stop("In rusmisc::dist3D: point1 or point2 has more than 3 list items")}  
    #making sure we have all of the datapoints
    point1.lengths <- unlist(lapply(point1,length))
    point2.lengths <- unlist(lapply(point2,length))
    lengths <- c(point1.lengths,point2.lengths)
    max.length <- max(lengths)
    if(max.length==1) #if the maximum list length is one, then we can process these points like vectors
    {
      return(dist3D(unlist(point1),unlist(point2)))
    }
    #fleshing out the lists if there is just a single entry, I assume that value should be repeated
    if (point1.lengths[1]==1) {point1[[1]] <- rep(point1[[1]],max.length)}
    if (point1.lengths[2]==1) {point1[[2]] <- rep(point1[[2]],max.length)}
    if (point1.lengths[3]==1) {point1[[3]] <- rep(point1[[3]],max.length)}
    if (point2.lengths[1]==1) {point2[[1]] <- rep(point2[[1]],max.length)}
    if (point2.lengths[2]==1) {point2[[2]] <- rep(point2[[2]],max.length)}
    if (point2.lengths[3]==1) {point2[[3]] <- rep(point2[[3]],max.length)}
    #now that we are fleshed out, we check all of the datapoints again
    point1.lengths <- unlist(lapply(point1,length))
    point2.lengths <- unlist(lapply(point2,length))
    lengths <- c(point1.lengths,point2.lengths)
    max.length <- max(lengths)
    #and check to see if we have what we need to continue  
    if (!all(c(point1.lengths==max.length),(point2.lengths==max.length))) {
      stop("In russmisc::dist3d: number of items in the lists are not equal")
    }
    differences <- mapply(function(x,y) {x-y},point1,point2)
    if (!is.vector(differences)) {
      differences.squared <- apply(differences,2,function(x) {x*x})
    } else {
      differences.squared <- differences^2
    }
    differences.squared.summed <- apply(differences.squared,1,sum)
    differences.squared.summed.rooted <- sqrt(differences.squared.summed)
    return(differences.squared.summed.rooted)
  }
  return(sqrt(sum((point2-point1)^2)))
}
NULL

#' Calculate the pythagorean theorem to solve for A, B, or C
#'
#' Given that A and B are the legs of a right triangle and C is its hypotenuse: solve for A, B, or C given any other two.
#'
#' @export
#' @param a Leg 1
#' @param b Leg 2
#' @param c Hypotenuse
#' @return numeric The length of the unspecified side
#' @references
#' \url{http://en.wikipedia.org/wiki/Pythagorean_theorem}
#' @examples
#' pythag(a=3,c=pythag(3,4))
pythag <- function(a = NULL, b = NULL, c = NULL) {
    if ((is.null(a) + is.null(b) + is.null(c)) != 1) {
        stop("In russmisc::pythag: Two, and only two, values must be specified!")
    }
    if (is.null(c)) {
        return(sqrt(a^2 + b^2))
    }
    else {
        #we know we are solving for a leg
        if (is.null(a)) 
            {
                a <- b
            }  #just get it into a standard form
        return(sqrt(c^2 - a^2))
    }
}
NULL

#' Solve right-triangles systems involving (monitor) aspect ratios
#'
#' I designed this to calculate values for monitor aspect ratios, but I imagine it is more general.
#' Given any two or three values, solve for the missing values.  Note, the values are not checked so the principle of GIGO applies.
#'
#' @export
#' @importFrom MASS fractions
#' @param w Width
#' @param h Height
#' @param d Diagonal
#' @param aspect Aspect ratio (w/h)
#' @return numeric The length of the unspecified side
#' @references
#' \url{http://en.wikipedia.org/wiki/Pythagorean_theorem}
#' @examples
#' pythag(a=3,c=pythag(3,4))
aspect <- function(w = NULL, h = NULL, d = NULL, aspect = NULL) {
    have.w <- !is.null(w)
    have.h <- !is.null(h)
    have.d <- !is.null(d)
    have.aspect <- !is.null(aspect)
    if ((have.w + have.h + have.d + have.aspect) > 2) {
        stop("In russmisc::aspect: At least two values must be specified!")
    }
    #we want to get w and h however we can as a standard
    if (have.aspect & have.h & !have.w) {
        w <- h * aspect
        have.w <- TRUE
    }
    if (have.aspect & have.w & !have.h) {
        h <- w/aspect
        have.h <- TRUE
    }
    if (have.aspect & have.d & !have.w) {
        w <- d/pythag(1/aspect, 1) #assuming w is the greater of h and w
        have.w <- TRUE
    }
    if ((have.w + have.h + have.d) == 2) {
        if (!have.w) {
            w <- pythag(NULL, h, d)
            have.w <- TRUE
        }
        if (!have.h) {
            h <- pythag(w, NULL, d)
            have.h <- TRUE
        }
        if (!have.d) {
            d <- pythag(w, h, NULL)
            have.d <- TRUE
        }
    }
    if ((!have.aspect) & (have.h & have.w)) {
        aspect <- w/h
        have.aspect <- TRUE
    }
    if (!all(c(have.w, have.h, have.d, have.aspect))) {
        stop("In russmisc::aspect: A solution was not found!")  
    }
    return(list(w = w, h = h, d = d, aspect = MASS::fractions(aspect)))
} 
NULL

#' Convert degrees to radians
#'
#' @export
#' @param degrees A value in degrees 
#' @return The value provided in degrees converted to radians
#' @examples 
#' radians(90)
radians <- function(degrees)
  {
  constval <- pi/180
  return(degrees*constval)
  }
NULL

#' Convert radians to degrees
#' @export
#' @param radians A value in radians
#' @return The value provided in radians converted to degrees
#' @seealso \code{\link{radians}}
#' @examples 
#' degrees(pi)
degrees <- function(radians)
  {
  constval <- pi/180
  return(radians/constval)
  }
NULL

#' Calculate visual angle given a stimulus size and viewing distance
#' @export
#' @param stimsize.val The stimulus size
#' @param viewdist.val The viewing distance
#' @param offset       The offset of the center of the object from the center of the viewing angle
#' @note The units of measure should be the same for both parameters
#' @return Degrees in visual angle for the given stimulus size
#' @seealso \code{\link{stimsize}} \code{\link{viewdist}} \code{link{visangle3D}}
#' @examples 
#' visangle(10,100)
#' visangle(visangle(0.75438,45),viewdist(visangle(0.75438,45),0.75438))
visangle <- function(stimsize.val,viewdist.val,offset=0) {
  if (offset==0) {
    return(degrees(2*atan(stimsize.val/(2*viewdist.val))))
  } else {
    #get the visual angle from the center to the far edges of the object if it were reflected
    #symmetrically over the center of the viewing position
    bigstim <- (offset-stimsize.val/2+stimsize.val)*2
    bigvisangle <- visangle(bigstim,viewdist.val)
    nonstim <- (offset-stimsize.val/2)*2
    nonstimvisangle <- visangle(nonstim,viewdist.val)
    return(bigvisangle/2-nonstimvisangle/2)
  }
}
NULL

#' Calculate a stimulus size given a visual angle and viewing distance
#' @export
#' @param visangle.val A value in degrees of visual angle
#' @param viewdist.val A viewing distance
#' @return The stimulus size that when centrally presented would have a visual angle (in degrees) of visangle.val.  Stimulus size is reported in the same units as viewdist.val.
#' @seealso \code{\link{viewdist} \link{stimsize}}
#' @examples 
#' stimsize(visangle(10,100),100)
stimsize <- function(visangle.val,viewdist.val) {return(2*(tan(radians(visangle.val/2))*viewdist.val))}
NULL

#' Calculate a viewing distance given a visual angle and stimulus size
#' @export
#' @param visangle.val A value in degrees of visual angle
#' @param stimsize.val A stimulus size
#' @return The viewing distance of an object of stimsize.val that, when centrally presented, would have a visual angle (in degrees) of visangle.val.  Viewing distance is reported in the same units as stimsize.val.
#' @author Russell S. Pierce \email{[email protected]@gmail.com}
#' @seealso \code{\link{viewdist} \link{visangle}}
#' @examples 
#' viewdist(visangle(10,100),10)
viewdist <- function(visangle.val,stimsize.val) {(stimsize.val/2)/tan(radians(visangle.val/2))}
NULL

#' Use the law of sines 
#' Use the law of cosines to calculate an angle
#'
#' Given that A, B, and C are the legs of a triangle solve the the opposite angles
#'
#' @export
#' @param A numeric Length of side A
#' @param B numeric Length of side B
#' @param C numeric Length of side C
#' @return list(a=numeric angle opposite A,b=numeric angle opposite B,c=numeric angle opposite C)
#' @references
#' \url{http://oakroadsystems.com/twt/solving.htm#eq30}
#' @examples
#' lawOfCos(3,4,5)
#' lawOfCos(3,3,3)
#' stimsize.val <- 10 #the stimulus size
#' dist <- 15 #the distance
#' visangle(10,15)-lawOfCos(stimsize.val,pythag(stimsize.val/2,dist),pythag(stimsize.val/2,dist))$a
#' offset <- 5
#' visangle(10,15,5)-lawOfCos(stimsize.val,pythag(stimsize.val/2+offset,dist),pythag(stimsize.val/2-offset,dist))$a
lawOfCos <- function(A,B,C) {
  a <- (B^2  + C^2 - A^2) / (2*B*C)
  b <- (A^2  + C^2 - B^2) / (2*A*C)
  c.tmp <- (A^2  + B^2 - C^2) / (2*A*B)
  biggerthanpi <- c(c(a,b,c.tmp) > pi)
  if (any(biggerthanpi,na.rm=TRUE)) {
    stop("In russmisc::lawOfCos: The side lengths provided do not form a regular triangle")
  }
  return(list(
    a=degrees(acos(a)), #find A
    b=degrees(acos(b)), #find B
    c=degrees(acos(c.tmp)) #find C
  ))
}
NULL

#' Calculate visual angle given a 3D viewer position, stimulus size, and stimulus position
#'
#' 
#' This function calculates the visual angle of a stimulus given a viewer position, stimulus size, and stimulus position.
#' Here I make fewer assumptions and calculate the distance between the viewer and the edges of the object in order to 
#' use the law of cosines to calculate the associated angle.
#'
#' @export
#' @param viewerloc The location of the center of the viewer as a numeric vector of length 3 c(X,Y,Z)
#' @param stimloc The location of the center of the stimulus as a numeric vector of length 3 c(X,Y,Z)
#' @param stimdim The stimulus dimensions as a numeric vector of length 2 c(width,height)
#' @note The units of measure should be the same for all parameters.  Z is assumed to be the depth plane.
#' @return Degrees in visual angle for the given stimulus dimentions and positions of viewer and stimuli
#' @seealso \code{\link{visangle}}
#' @examples 
#' #corresponds to an offset of 10 and 10 and a viewer distance of 20
#' viewerloc <- c(0,0,0)
#' stimloc<-c(10,10,-20) 
#' stimsize.val <- 10
#' stimdim <- c(stimsize.val,1)
#' visangle(stimsize.val,20,pythag(stimloc[1],stimloc[2]))
#' visangle3D(viewerloc,stimloc,stimdim)
#' #corresponds to an offset of 10 and 0 and a viewer distance of 20
#' viewerloc <- c(0,0,0)
#' stimloc<-c(10,0,-20) 
#' stimsize.val <- 10
#' stimdim <- c(stimsize.val,1)
#' visangle(stimsize.val,20,pythag(stimloc[1],stimloc[2]))
#' visangle3D(viewerloc,stimloc,stimdim)
#' visangle3D(list(c(1,1),c(1,1),c(1,1)),list(c(2,2),c(2,2),c(2,2)),list(c(3,3),c(3,3)))
#' visangle3D(list(1,2,3),list(3,4,5),list(2,2))

visangle3D <- function(viewerloc,stimloc,stimdim) {
  if(all(sapply(list(viewerloc,stimloc,stimdim),is.list))) {
    return(visangle3D.l(viewerloc,stimloc,stimdim))
  }
  
  stim.left.pos <- c(stimloc[1]-stimdim[1]/2,stimloc[2],stimloc[3])
  stim.right.pos <- c(stimloc[1]+stimdim[1]/2,stimloc[2],stimloc[3])
  A <- dist3D(stim.left.pos,viewerloc)
  C <- dist3D(stim.right.pos,viewerloc)
  B <- stimdim[1]
  XaxisAngle <- lawOfCos(A,B,C)$b
  stim.top.pos <- c(stimloc[1],stimloc[2]-stimdim[2]/2,stimloc[3])
  stim.bottom.pos <- c(stimloc[1],stimloc[2]+stimdim[2]/2,stimloc[3])
  A <- dist3D(stim.top.pos,viewerloc)
  C <- dist3D(stim.bottom.pos,viewerloc)
  B <- stimdim[2]
  YaxisAngle <- lawOfCos(A,B,C)$b
  return(list(VisualAngle.X=XaxisAngle,VisualAngle.Y=YaxisAngle))
}
NULL

#' Helper function for visangle3D to handle lists
#'
#' @param viewerloc The location of the center of the viewer as a list
#' @param stimloc The location of the center of the stimulus as a list
#' @param stimdim The stimulus dimensions as a numeric list
visangle3D.l <- function(viewerloc,stimloc,stimdim) {
  names(viewerloc) <- c("X","Y","Z")
  names(stimloc) <- c("X","Y","Z")
  names(stimdim) <- c("X","Y")
  viewerloc.x <- viewerloc$X
  viewerloc.y <- viewerloc$Y
  viewerloc.z <- viewerloc$Z
  stimloc.x <- stimloc$X
  stimloc.y <- stimloc$Y
  stimloc.z <- stimloc$Z
  stimdim.x <- stimdim$X
  stimdim.y <- stimdim$Y
  if (all(sapply(list(viewerloc,stimloc,stimdim),length)==c(3,3,2))) {
    #turf the processing back to the vector version of visangle3D if there is only a single set of points
    visangle3D(unlist(viewerloc),unlist(stimloc),unlist(stimdim))
  }
  stim.left.pos <- list(X=stimloc.x-stimdim.x/2,Y=stimloc.y,Z=stimloc.z)
  stim.right.pos <- list(X=stimloc.x+stimdim.x/2,Y=stimloc.y,Z=stimloc.z)
  A <- dist3D(stim.left.pos,viewerloc)
  C <- dist3D(stim.right.pos,viewerloc)
  B <- stimdim.x
  XaxisAngle <- lawOfCos(A,B,C)$b
  stim.top.pos <- list(X=stimloc.x,Y=stimloc.y-stimdim.y/2,Z=stimloc.z)
  stim.bottom.pos <- list(X=stimloc.x,Y=stimloc.y+stimdim.y/2,Z=stimloc.z)
  A <- dist3D(stim.top.pos,viewerloc)
  C <- dist3D(stim.bottom.pos,viewerloc)
  B <- stimdim.y
  YaxisAngle <- lawOfCos(A,B,C)$b
  return(list(VisualAngle.X=XaxisAngle,VisualAngle.Y=YaxisAngle))
}
NULL

Try the russmisc package in your browser

Any scripts or data that you put into this service are public.

russmisc documentation built on May 31, 2017, 1:54 a.m.