OuhscBbmc / Wats / 101

pending completion

Build # 101

Build Type

push

travis-ci

Committed by

wibeasley

Commit Message

trim whitespace

ref #8

Run Details

23 of 23 new or added lines in 5 files covered. (100.0%)

58 of 244 relevant lines covered (23.77%)

1.77 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

0.0

/R/PolarizeCartesian.R

#' @name PolarizeCartesian
#' @export
#' @title Manipulate Cartesian data to use in the WATS polar plot
#'
#' @description Three operations are performed.
#' First, within each stage, the first row is repeated at the end, to close the loop.
#' Second, multiple points are interpolated (still in a Cartesian coordinates) so that the polar graph doesn't have sharp edges.  These sharp edges would be artifacts of the conversion, and not reflect the observed data.
#' Third, the Cartesian points are coverted to polar coordinates.
#'
#' @param dsLinear The \code{data.frame} to containing the simple linear data.  There should be one record per observation.
#' @param dsStageCycle The \code{data.frame} to containing the reoccurring/periodic bands.  There should be one record per observation per stage.  If there are three stages, this \code{data.frame} should have three times as many rows as \code{dsLinear}.
#' @param yName The variable name containing the dependent/criterion variable.
#' @param stageIDName The variable name indicating which stage the record belongs to.  For example, before the first interruption, the \code{StageID} is \code{1}, and is \code{2} afterwards.
#' @param cycleTallyName The variable name indicating how many \emph{complete} cycles have occurred at that observation.
#' @param proportionThroughCycleName The variable name showing how far through a cycle the observation (or summarized observations) occurred.
#' @param periodicLowerName The variable name showing the lower bound of a stage's periodic estimate.
#' @param periodicCenterName The variable name showing the center estimate of a stage's periodic estimate.
#' @param periodicUpperName The variable name showing the upper bound of a stage's periodic estimate.
#' @param plottedPointCountPerCycle The number of points that are plotted per cycle.  If the polar graph has 'sharp corners', then increase this value.
#' @param graphFloor The value of the criterion/dependent variable at the center of the polar plot.
#' @return Returns a \code{data.frame}.
#' @keywords polar
#' @examples
#' library(Wats)
#' dsLinear <- CountyMonthBirthRate2005Version
#' dsLinear <- dsLinear[dsLinear$CountyName=="oklahoma", ]
#' dsLinear <- AugmentYearDataWithMonthResolution(dsLinear=dsLinear, dateName="Date")
#'
#' hSpread <- function( scores ) { return( quantile(x=scores, probs=c(.25, .75)) ) }
#' portfolio <- AnnotateData(
#'   dsLinear = dsLinear,
#'   dvName = "BirthRate",
#'   centerFunction = median,
#'   spreadFunction = hSpread
#' )
#' rm(dsLinear)
#'
#' polarized <- PolarizeCartesian(
#'   dsLinear = portfolio$dsLinear,
#'   dsStageCycle = portfolio$dsStageCycle,
#'   yName = "BirthRate",
#'   stageIDName = "StageID"
#' )
#'
#' library(ggplot2)
#' ggplot(polarized$dsStageCyclePolar, aes(color=factor(StageID))) +
#'   geom_path(aes(x=PolarLowerX, y=PolarLowerY), linetype=2) +
#'   geom_path(aes(x=PolarCenterX, y=PolarCenterY), size=2) +
#'   geom_path(aes(x=PolarUpperX, y=PolarUpperY), linetype=2) +
#'   geom_path(aes(x=ObservedX, y=ObservedY), data=polarized$dsObservedPolar) +
#'   coord_fixed(ratio=1) +
#'   guides(color=FALSE)

#For a more polished graph, see PolarPeriodic().

PolarizeCartesian <- function(dsLinear, dsStageCycle,
                      yName, stageIDName,
                      cycleTallyName="CycleTally",
                      proportionThroughCycleName="ProportionThroughCycle",
                      periodicLowerName="PositionLower", periodicCenterName="PositionCenter", periodicUpperName="PositionUpper",
                      plottedPointCountPerCycle=120,
                      graphFloor=min(base::pretty(x=dsLinear[, yName]))) {
  #TODO: allow counter-clockwise and arbitrary angle for theta=0


#   print(dsLinear[, cycleTallyName])
#   print(dsLinear[, proportionThroughCycleName])
#   print(dsLinear[, yName])

  closeLoop <- function( d ) {
    d[nrow(d) + 1, ] <- d[1, ] #Within each stage, repeat the first row at the end of the stage's data.frame.
    d[nrow(d), proportionThroughCycleName] <- 1 + d[nrow(d), proportionThroughCycleName]
    return( d )
  }
  interpolateObserved <- function( d, pointsPerCycleCount ) {
    observed <- stats::approx(x = d[, cycleTallyName] + d[, proportionThroughCycleName],
                              y = d[, yName],
                              n = pointsPerCycleCount)
    stageProgress <- stats::approx(x = unique(d[, stageIDName]) + 0:1,
                                   n = pointsPerCycleCount + 1)

    base::data.frame(
      ObservedX = observed$x,
      ObservedY = observed$y,
      StageProgress = stageProgress$y[seq_len(pointsPerCycleCount)] #Which chops off the last value.
    )
  }
  interpolateBand <- function( d, pointsPerCycleCount ) {
    lower <- stats::approx(x=d[, proportionThroughCycleName], y=d[, periodicLowerName], n=pointsPerCycleCount)
    center <- stats::approx(x=d[, proportionThroughCycleName], y=d[, periodicCenterName], n=pointsPerCycleCount)
    upper <- stats::approx(x=d[, proportionThroughCycleName], y=d[, periodicUpperName], n=pointsPerCycleCount)

    base::data.frame(
      LowerX = lower$x,
      LowerY = lower$y,
      CenterX = center$x,
      CenterY = center$y,
      UpperX = upper$x,
      UpperY = upper$y
    )
  }
  polarizeObserved <- function( d, graphFloor=graphFloor ) {
    #After R 3.1.0 has been out for a while, consider using sinpi()`.
    if( nrow(d)==0 ) {
      stageStart <- logical(0)
      stageEnd <- logical(0)
    } else {
      stageStart <- c(TRUE, rep(FALSE, times=nrow(d)-1))
      stageEnd <- c(rep(FALSE, times=nrow(d)-1), TRUE)
    }
    base::data.frame(
      ObservedX = (d$ObservedY - graphFloor) * sin(2 * pi * d$ObservedX),
      ObservedY = (d$ObservedY - graphFloor) * cos(2 * pi * d$ObservedX),
      Theta = pi * 2 * d$ObservedX,
      Radius = d$ObservedY,
      StageProgress = d$StageProgress,
      StageStart = stageStart,
      StageEnd = stageEnd,
      LabelStageStart = ifelse(stageStart, paste0(d$StageID, "S"), ""),
      LabelStageEnd = ifelse(stageEnd, paste0(d$StageID, "E"), ""),
      stringsAsFactors = FALSE
    )
  }
  polarizeBand <- function( d, graphFloor=graphFloor ) {
    if( nrow(d)==0 ) {
      stageStart <- logical(0)
      stageEnd <- logical(0)
    } else {
      stageStart <- c(TRUE, rep(FALSE, times=nrow(d)-1))
      stageEnd <- c(rep(FALSE, times=nrow(d)-1), TRUE)
    }
    base::data.frame(
      PolarLowerX = (d$LowerY - graphFloor) * sin(2 * pi * d$LowerX),
      PolarLowerY = (d$LowerY - graphFloor) * cos(2 * pi * d$LowerX),
      PolarCenterX = (d$CenterY - graphFloor) * sin(2 * pi * d$CenterX),
      PolarCenterY = (d$CenterY - graphFloor) * cos(2 * pi * d$CenterX),
      PolarUpperX = (d$UpperY - graphFloor) * sin(2 * pi * d$UpperX),
      PolarUpperY = (d$UpperY - graphFloor) * cos(2 * pi * d$UpperX),
#       StageProgress = d$StageProgress,
      StageStart = stageStart,
      StageEnd = stageEnd,
      LabelStageStart = ifelse(stageStart, paste0(d$StageID, "S"), ""),
      LabelStageEnd = ifelse(stageEnd, paste0(d$StageID, "E"), ""),
      stringsAsFactors = FALSE
    )
  }

  dsObservedInterpolated <- plyr::ddply(dsLinear, .variables=stageIDName, .fun=interpolateObserved, pointsPerCycleCount=plottedPointCountPerCycle)
  dsObservedPolar <- plyr::ddply(dsObservedInterpolated, .variables=stageIDName, .fun=polarizeObserved, graphFloor=graphFloor)

  dsStageCycleClosed <- plyr::ddply(dsStageCycle, .variables=stageIDName, .fun=closeLoop)
  dsStageCycleInterpolated <- plyr::ddply(dsStageCycleClosed, .variables=stageIDName, .fun=interpolateBand, pointsPerCycleCount=plottedPointCountPerCycle)
  dsStageCyclePolar <- plyr::ddply(dsStageCycleInterpolated, .variables=stageIDName, .fun=polarizeBand, graphFloor=graphFloor)

  return( list(dsObservedPolar=dsObservedPolar, dsStageCyclePolar=dsStageCyclePolar, GraphFloor=graphFloor) )
}

# library(Wats)
# dsLinear <- CountyMonthBirthRate2005Version
# dsLinear <- dsLinear[dsLinear$CountyName=="oklahoma", ]
# dsLinear <- AugmentYearDataWithMonthResolution(dsLinear=dsLinear, dateName="Date")
#
# hSpread <- function( scores ) { return( quantile(x=scores, probs=c(.25, .75)) ) }
# portfolio <- AnnotateData(dsLinear, dvName="BirthRate", centerFunction=median, spreadFunction=hSpread)
# rm(dsLinear)
#
# polarized <- PolarizeCartesian(portfolio$dsLinear, portfolio$dsStageCycle, yName="BirthRate", stageIDName="StageID")
#
# library(ggplot2)
# ggplot(polarized$dsStageCyclePolar, aes(color=factor(StageID))) +
#   geom_path(aes(x=PolarLowerX, y=PolarLowerY), linetype=2) +
#   geom_path(aes(x=PolarCenterX, y=PolarCenterY), size=2) +
#   geom_path(aes(x=PolarUpperX, y=PolarUpperY), linetype=2) +
#   geom_path(aes(x=ObservedX, y=ObservedY), data=polarized$dsObservedPolar) +
#   coord_fixed(ratio=1) +
#   guides(color=FALSE)
#
# #For a more polished graph, see PolarPeriodic().

1	#' @name PolarizeCartesian
2	#' @export
3	#' @title Manipulate Cartesian data to use in the WATS polar plot
4	#'
5	#' @description Three operations are performed.
6	#' First, within each stage, the first row is repeated at the end, to close the loop.
7	#' Second, multiple points are interpolated (still in a Cartesian coordinates) so that the polar graph doesn't have sharp edges. These sharp edges would be artifacts of the conversion, and not reflect the observed data.
8	#' Third, the Cartesian points are coverted to polar coordinates.
9	#'
10	#' @param dsLinear The \code{data.frame} to containing the simple linear data. There should be one record per observation.
11	#' @param dsStageCycle The \code{data.frame} to containing the reoccurring/periodic bands. There should be one record per observation per stage. If there are three stages, this \code{data.frame} should have three times as many rows as \code{dsLinear}.
12	#' @param yName The variable name containing the dependent/criterion variable.
13	#' @param stageIDName The variable name indicating which stage the record belongs to. For example, before the first interruption, the \code{StageID} is \code{1}, and is \code{2} afterwards.
14	#' @param cycleTallyName The variable name indicating how many \emph{complete} cycles have occurred at that observation.
15	#' @param proportionThroughCycleName The variable name showing how far through a cycle the observation (or summarized observations) occurred.
16	#' @param periodicLowerName The variable name showing the lower bound of a stage's periodic estimate.
17	#' @param periodicCenterName The variable name showing the center estimate of a stage's periodic estimate.
18	#' @param periodicUpperName The variable name showing the upper bound of a stage's periodic estimate.
19	#' @param plottedPointCountPerCycle The number of points that are plotted per cycle. If the polar graph has 'sharp corners', then increase this value.
20	#' @param graphFloor The value of the criterion/dependent variable at the center of the polar plot.
21	#' @return Returns a \code{data.frame}.
22	#' @keywords polar
23	#' @examples
24	#' library(Wats)
25	#' dsLinear <- CountyMonthBirthRate2005Version
26	#' dsLinear <- dsLinear[dsLinear$CountyName=="oklahoma", ]
27	#' dsLinear <- AugmentYearDataWithMonthResolution(dsLinear=dsLinear, dateName="Date")
28	#'
29	#' hSpread <- function( scores ) { return( quantile(x=scores, probs=c(.25, .75)) ) }
30	#' portfolio <- AnnotateData(
31	#' dsLinear = dsLinear,
32	#' dvName = "BirthRate",
33	#' centerFunction = median,
34	#' spreadFunction = hSpread
35	#' )
36	#' rm(dsLinear)
37	#'
38	#' polarized <- PolarizeCartesian(
39	#' dsLinear = portfolio$dsLinear,
40	#' dsStageCycle = portfolio$dsStageCycle,
41	#' yName = "BirthRate",
42	#' stageIDName = "StageID"
43	#' )
44	#'
45	#' library(ggplot2)
46	#' ggplot(polarized$dsStageCyclePolar, aes(color=factor(StageID))) +
47	#' geom_path(aes(x=PolarLowerX, y=PolarLowerY), linetype=2) +
48	#' geom_path(aes(x=PolarCenterX, y=PolarCenterY), size=2) +
49	#' geom_path(aes(x=PolarUpperX, y=PolarUpperY), linetype=2) +
50	#' geom_path(aes(x=ObservedX, y=ObservedY), data=polarized$dsObservedPolar) +
51	#' coord_fixed(ratio=1) +
52	#' guides(color=FALSE)
53
54	#For a more polished graph, see PolarPeriodic().
55
56	PolarizeCartesian <- function(dsLinear, dsStageCycle,
57	yName, stageIDName,
58	cycleTallyName="CycleTally",
59	proportionThroughCycleName="ProportionThroughCycle",
60	periodicLowerName="PositionLower", periodicCenterName="PositionCenter", periodicUpperName="PositionUpper",
61	plottedPointCountPerCycle=120,
62	graphFloor=min(base::pretty(x=dsLinear[, yName]))) {
63	#TODO: allow counter-clockwise and arbitrary angle for theta=0
64
65
66	# print(dsLinear[, cycleTallyName])
67	# print(dsLinear[, proportionThroughCycleName])
68	# print(dsLinear[, yName])
69
70	closeLoop <- function( d ) {	×
71	d[nrow(d) + 1, ] <- d[1, ] #Within each stage, repeat the first row at the end of the stage's data.frame.	×
72	d[nrow(d), proportionThroughCycleName] <- 1 + d[nrow(d), proportionThroughCycleName]	×
73	return( d )	×
74	}
75	interpolateObserved <- function( d, pointsPerCycleCount ) {	×
76	observed <- stats::approx(x = d[, cycleTallyName] + d[, proportionThroughCycleName],	×
77	y = d[, yName],	×
78	n = pointsPerCycleCount)	×
79	stageProgress <- stats::approx(x = unique(d[, stageIDName]) + 0:1,	×
80	n = pointsPerCycleCount + 1)	×
81
82	base::data.frame(	×
83	ObservedX = observed$x,	×
84	ObservedY = observed$y,	×
85	StageProgress = stageProgress$y[seq_len(pointsPerCycleCount)] #Which chops off the last value.	×
86	)
87	}
88	interpolateBand <- function( d, pointsPerCycleCount ) {	×
89	lower <- stats::approx(x=d[, proportionThroughCycleName], y=d[, periodicLowerName], n=pointsPerCycleCount)	×
90	center <- stats::approx(x=d[, proportionThroughCycleName], y=d[, periodicCenterName], n=pointsPerCycleCount)	×
91	upper <- stats::approx(x=d[, proportionThroughCycleName], y=d[, periodicUpperName], n=pointsPerCycleCount)	×
92
93	base::data.frame(	×
94	LowerX = lower$x,	×
95	LowerY = lower$y,	×
96	CenterX = center$x,	×
97	CenterY = center$y,	×
98	UpperX = upper$x,	×
99	UpperY = upper$y	×
100	)
101	}
102	polarizeObserved <- function( d, graphFloor=graphFloor ) {	×
103	#After R 3.1.0 has been out for a while, consider using sinpi()`.
104	if( nrow(d)==0 ) {	×
105	stageStart <- logical(0)	×
106	stageEnd <- logical(0)	×
107	} else {
108	stageStart <- c(TRUE, rep(FALSE, times=nrow(d)-1))	×
109	stageEnd <- c(rep(FALSE, times=nrow(d)-1), TRUE)	×
110	}
111	base::data.frame(	×
112	ObservedX = (d$ObservedY - graphFloor) * sin(2 * pi * d$ObservedX),	×
113	ObservedY = (d$ObservedY - graphFloor) * cos(2 * pi * d$ObservedX),	×
114	Theta = pi * 2 * d$ObservedX,	×
115	Radius = d$ObservedY,	×
116	StageProgress = d$StageProgress,	×
117	StageStart = stageStart,	×
118	StageEnd = stageEnd,	×
119	LabelStageStart = ifelse(stageStart, paste0(d$StageID, "S"), ""),	×
120	LabelStageEnd = ifelse(stageEnd, paste0(d$StageID, "E"), ""),	×
121	stringsAsFactors = FALSE	×
122	)
123	}
124	polarizeBand <- function( d, graphFloor=graphFloor ) {	×
125	if( nrow(d)==0 ) {	×
126	stageStart <- logical(0)	×
127	stageEnd <- logical(0)	×
128	} else {
129	stageStart <- c(TRUE, rep(FALSE, times=nrow(d)-1))	×
130	stageEnd <- c(rep(FALSE, times=nrow(d)-1), TRUE)	×
131	}
132	base::data.frame(	×
133	PolarLowerX = (d$LowerY - graphFloor) * sin(2 * pi * d$LowerX),	×
134	PolarLowerY = (d$LowerY - graphFloor) * cos(2 * pi * d$LowerX),	×
135	PolarCenterX = (d$CenterY - graphFloor) * sin(2 * pi * d$CenterX),	×
136	PolarCenterY = (d$CenterY - graphFloor) * cos(2 * pi * d$CenterX),	×
137	PolarUpperX = (d$UpperY - graphFloor) * sin(2 * pi * d$UpperX),	×
138	PolarUpperY = (d$UpperY - graphFloor) * cos(2 * pi * d$UpperX),	×
139	# StageProgress = d$StageProgress,
140	StageStart = stageStart,	×
141	StageEnd = stageEnd,	×
142	LabelStageStart = ifelse(stageStart, paste0(d$StageID, "S"), ""),	×
143	LabelStageEnd = ifelse(stageEnd, paste0(d$StageID, "E"), ""),	×
144	stringsAsFactors = FALSE	×
145	)
146	}
147
148	dsObservedInterpolated <- plyr::ddply(dsLinear, .variables=stageIDName, .fun=interpolateObserved, pointsPerCycleCount=plottedPointCountPerCycle)	×
149	dsObservedPolar <- plyr::ddply(dsObservedInterpolated, .variables=stageIDName, .fun=polarizeObserved, graphFloor=graphFloor)	×
150
151	dsStageCycleClosed <- plyr::ddply(dsStageCycle, .variables=stageIDName, .fun=closeLoop)	×
152	dsStageCycleInterpolated <- plyr::ddply(dsStageCycleClosed, .variables=stageIDName, .fun=interpolateBand, pointsPerCycleCount=plottedPointCountPerCycle)	×
153	dsStageCyclePolar <- plyr::ddply(dsStageCycleInterpolated, .variables=stageIDName, .fun=polarizeBand, graphFloor=graphFloor)	×
154
155	return( list(dsObservedPolar=dsObservedPolar, dsStageCyclePolar=dsStageCyclePolar, GraphFloor=graphFloor) )	×
156	}
157
158	# library(Wats)
159	# dsLinear <- CountyMonthBirthRate2005Version
160	# dsLinear <- dsLinear[dsLinear$CountyName=="oklahoma", ]
161	# dsLinear <- AugmentYearDataWithMonthResolution(dsLinear=dsLinear, dateName="Date")
162	#
163	# hSpread <- function( scores ) { return( quantile(x=scores, probs=c(.25, .75)) ) }
164	# portfolio <- AnnotateData(dsLinear, dvName="BirthRate", centerFunction=median, spreadFunction=hSpread)
165	# rm(dsLinear)
166	#
167	# polarized <- PolarizeCartesian(portfolio$dsLinear, portfolio$dsStageCycle, yName="BirthRate", stageIDName="StageID")
168	#
169	# library(ggplot2)
170	# ggplot(polarized$dsStageCyclePolar, aes(color=factor(StageID))) +
171	# geom_path(aes(x=PolarLowerX, y=PolarLowerY), linetype=2) +
172	# geom_path(aes(x=PolarCenterX, y=PolarCenterY), size=2) +
173	# geom_path(aes(x=PolarUpperX, y=PolarUpperY), linetype=2) +
174	# geom_path(aes(x=ObservedX, y=ObservedY), data=polarized$dsObservedPolar) +
175	# coord_fixed(ratio=1) +
176	# guides(color=FALSE)
177	#
178	# #For a more polished graph, see PolarPeriodic().

OuhscBbmc / Wats / 101

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous