#' 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{Russell.S.Pierce@@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
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.