rainbow cats

R/cat_loader.R

@@ -28,6 +28,7 @@ createCatList <- function(dir) {
 	fs <- list.files(dir, pattern="png")
 	catlist <- vector("list", length(fs))
 	for (i in 1:length(fs)) {
+		print(fs[i])
 		catlist[[i]] <- png::readPNG(source=paste0(dir,fs[i]))
 	}
 	catlist

R/cat_plot.R

@@ -59,8 +59,8 @@ catplot <- function(xs, ys,
 
 	xat = seq(min(xscale), max(xscale), length.out=length(xscale))
 	yat = seq(min(yscale), max(yscale), length.out=length(yscale))
-	xaxtlab = round(seq(min(xs), max(xs),length.out=length(xat)),2)
-	yaxtlab = round(seq(min(ys), max(ys),length.out=length(xat)),2)
+	xaxtlab = round(seq(min(xs), max(xs),length.out=length(xat)),1)
+	yaxtlab = round(seq(min(ys), max(ys),length.out=length(xat)),1)
 	axis(side=1, at=xat, labels=xaxtlab)
 	axis(side=2, at=yat, labels=yaxtlab)
 

R/multi_cat.R

@@ -58,8 +58,8 @@ multicat <- function(xs, ys,
 
 	xat = seq(min(xscale), max(xscale), length.out=length(xscale))
 	yat = seq(min(yscale), max(yscale), length.out=length(yscale))
-	xaxtlab = round(seq(min(xs), max(xs),length.out=length(xat)),2)
-	yaxtlab = round(seq(min(ys), max(ys),length.out=length(xat)),2)
+	xaxtlab = round(seq(min(xs), max(xs),length.out=length(xat)),1)
+	yaxtlab = round(seq(min(ys), max(ys),length.out=length(xat)),1)
 	axis(side=1, at=xat, labels=xaxtlab)
 	axis(side=2, at=yat, labels=yaxtlab)
 
@@ -78,9 +78,41 @@ multicat <- function(xs, ys,
 		rasterImage(imgMod, xscale[i]-(size/2), yscale[i]-(size/2), xscale[i]+(size/2), yscale[i]+(size/2), interpolate=TRUE)
 	}
 
-	list(xs=x, ys=y, args=args, canvas=canvas)
+	list(xs=xs, ys=ys, args=args, canvas=canvas)
 }
 
+
+multipoint <- function(xs, ys,
+					ptsize=0.1,
+					catcolor = c(0,0,0,1),
+					linecolor=1,
+					canvas=c(0,1.1,0,1.1),
+                     ...) {
+
+	args <- list(...)
+
+	plot(x=xs, y=ys, col=0, xaxt="n", yaxt="n", ...)
+	par(usr=canvas)
+
+    pointColor <- rgb(catcolor[1], catcolor[2], catcolor[3], maxColorValue=255)
+
+	scaledData <- scaleData(xs,ys,args)
+	xscale <- scaledData$xscale
+	yscale <- scaledData$yscale
+
+    points(x=xscale, y=yscale, col=pointColor, xaxt="n", yaxt="n", pch=15, cex=ptsize, ...)
+
+	xat = seq(min(xscale), max(xscale), length.out=length(xscale))
+	yat = seq(min(yscale), max(yscale), length.out=length(yscale))
+	xaxtlab = round(seq(min(xs), max(xs),length.out=length(xat)),1)
+	yaxtlab = round(seq(min(ys), max(ys),length.out=length(xat)),1)
+	axis(side=1, at=xat, labels=xaxtlab)
+	axis(side=2, at=yat, labels=yaxtlab)
+
+	list(xs=xs, ys=ys, args=args, canvas=canvas)
+}
+
+
 #' Plot even more cats! In more colors and shapes!
 #'
 #' @param obj a catplot object, returned from catplot
@@ -91,6 +123,8 @@ multicat <- function(xs, ys,
 #' @param catcolor a modifier vector to the png matrix (try c(1,0,0,1))
 #' @param linecolor color of plotted lines
 #' @param type the type of plot ... justcats, or line
+#' @param yshift shifts the cat up or down, within the scaled space
+#' @param xshift shifts the cat left or right, within the scaled space.
 #'
 #' @return a cat plot object... to plot more cats.
 #' @examples
@@ -100,7 +134,7 @@ multicat <- function(xs, ys,
 #' cats(purr, -x, -y, cat=4, catcolor=c(1,0,1,1))'
 #' @export
 morecats <- function(obj=NULL, xs, ys, size=0.1, cat=c(4,5,6), catcolor = list(c(0,0,1,1),c(0,1,0,1)),
-										linecolor=1, type="justcats") {
+										linecolor=1, type="justcats", yshift=0, xshift=0) {
 	# needs a plot already up, and the catObj returned from it.
 	if(is.null(obj)) {
 		print("Please feed the cats!  cat_food <- catplot(...);  cats(cat_food, ...)")
@@ -111,13 +145,14 @@ morecats <- function(obj=NULL, xs, ys, size=0.1, cat=c(4,5,6), catcolor = list(c
 	AR<-dims[1]/dims[2]
 
 	scaledData <- catsScaleData(obj,xs,ys)
-	xscale <- scaledData$xscale
-	yscale <- scaledData$yscale
+	xscale <- scaledData$xscale + xshift
+	yscale <- scaledData$yscale + yshift
 
 	if (type == "line") {
 		points(x=xscale, y=yscale, col=linecolor, type="l")
 	}
 
+
 	cats <- rep(cat, length(xscale))
 	catcolors <- rep(catcolor, length(xscale))
 	for (i in 1:length(xscale)) {
@@ -127,5 +162,26 @@ morecats <- function(obj=NULL, xs, ys, size=0.1, cat=c(4,5,6), catcolor = list(c
 		# modify the cat image
 		imgMod <- colorMod(img, thiscolor)
 		rasterImage(imgMod, xscale[i]-(size/2), yscale[i]-(size/2), xscale[i]+(size/2), yscale[i]+(size/2), interpolate=TRUE)
+        print(paste(xscale[i]-(size/2), "  ",
+                    yscale[i]-(size/2), "  ",
+                    xscale[i]+(size/2), "  ",
+                    yscale[i]+(size/2)))
+	}
+}
+
+
+morepoints <- function(obj=NULL, xs, ys, ptsize=0.1, catcolor = c(0,0,1,1), yshift=0, xshift=0) {
+	# needs a plot already up, and the catObj returned from it.
+	if(is.null(obj)) {
+		print("Please feed the cats!  cat_food <- catplot(...);  cats(cat_food, ...)")
 	}
+
+	scaledData <- catsScaleData(obj,xs,ys)
+	xscale <- scaledData$xscale + xshift
+	yscale <- scaledData$yscale + yshift
+
+    pointColor <- rgb(catcolor[1], catcolor[2], catcolor[3], maxColorValue=1)
+    print(pointColor)
+
+	points(x=xscale, y=yscale, col=pointColor, xaxt="n", yaxt="n", pch=15, cex=ptsize)
 }

R/rainbow_cats.R

@@ -0,0 +1,66 @@
+#
+# CatterPlots
+#
+# Copyright (c) 2016 David L Gibbs
+# email: gibbsdavidl@gmail.com
+#
+# Licensed under the Apache License, Version 2.0 (the "License");
+# you may not use this file except in compliance with the License.
+# You may obtain a copy of the License at
+#
+#   http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing, software
+# distributed under the License is distributed on an "AS IS" BASIS,
+# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+# See the License for the specific language governing permissions and
+# limitations under the License.
+#
+
+#' Rainbows!  Even more colors.
+#'
+#' @param xs a vector of numbers
+#' @param ys another vector of numbers
+#' @param ptsize control the size.
+#' @param yspread. the vertical spread of the rainbow
+#' @param xspread. the horizontal spread of rainbow particles
+#' @param cat. what cat shall make thine rainbow? nyan is 11
+#' @param catshiftx. get your cat connected to the rainbow!
+#' @param catshifty. get your cat connected to the rainbow!
+#' @param canvas. you are probably going to want to zoom in and out (x1,x2,y1,y2)
+#' @param spar. the smoothness of the rainbow.
+#'
+#' @return a rainbow!
+#' @examples
+#' see also tests/rainbow_test.R
+#' x <- -10:10
+#' y <- -x^2 + 10
+#' rainbowCats(x, y, yspread=0.05, xspread=0.05, canvas=c(-0.5,1.5,-1,0.8))
+#' @export
+rainbowCats <- function(xs, ys, ptsize=0.1, yspread=0.1, xspread=0.1,
+                        cat=11, catshiftx=0, catshifty=0, spar=NA, canvas=c(-0.5,1.5,-1,1.5)) {
+    require(png)
+    data(cats)
+
+    if (is.na(spar)) {
+        sm <- smooth.spline(ys~xs)
+    } else {
+        sm <- smooth.spline(ys~xs, spar=spar)
+    }
+    max_x <- max(xs)
+    min_x <- min(xs)
+    z <- predict(sm, x=seq(min_x,max_x,by=xspread))
+
+    cp <- multipoint(xs=z$x, ys=z$y, ptsize=ptsize, catcolor=c(1,1,1,0), canvas=canvas)
+
+    cols <- colorRamp(rainbow(7))(seq(0.0,1,by=0.12)) / 255
+    mults <- seq(-4,4) * yspread
+
+    for (i in 1:nrow(cols)) {
+        morepoints(cp, xs=z$x, ys=z$y, ptsize=ptsize, catcolor=cols[i,], yshift=mults[i])
+    }
+
+    print(paste(z$x[length(z$x)], "  ", z$y[length(z$y)]))
+    morecats(cp, xs=z$x[length(z$x)], ys=z$y[length(z$y)],
+             xshift=catshiftx, yshift=catshifty, size=1, cat=cat)
+}

examples/rainbow_test.R

@@ -0,0 +1,8 @@
+
+
+# Making a parabola rainbow.
+
+library(CatterPlots)
+x <- -10:10
+y <- -x^2 + 10
+rainbowCats(x, y, yspread=0.05, xspread=0.05, ptsize=2, catshiftx=0.5, canvas=c(-0.5,1.5,-1,1.5))