.Rhistory

library("jpeg")
photo <- readJPEG("C:/Windows/Web/Wallpaper/Theme1/img1.jpg")
width.px <- 1920
height.px <- 1200
rasterImage(photo, xleft = 0, ybottom = 0, xright = width.px/100, ytop = height.px/100, )
plot.new()
rasterImage(photo, xleft = 0, ybottom = 0, xright = width.px/100, ytop = height.px/100 )
plot.new(x= seq(0, width.px, 1000), y = seq(0,height.px,1000))
seq(0, width.px, 1000)
plot.new(x= seq(0, width.px, length.out = 1000), y = seq(0,height.px,1000))
plot.new(x= seq(0, width.px, length.out = 1000), y = seq(0,height.px, length.out = 1000))
seq(0,height.px, length.out = 1000)
seq(0, width.px, length.out = 1000)
plot(x= seq(0, width.px, length.out = 1000), y = seq(0,height.px, length.out = 1000))
rasterImage(photo, xleft = 0, ybottom = 0, xright = width.px/100, ytop = height.px/100 )
rasterImage(photo, xleft = 0, ybottom = 0, xright = width.px, ytop = height.px)
getwd()
library("plotrix")
install.packages("plotrix")
library("plotrix")
seq(0, width.px, length.out = 1000)
draw.circle(cut(seq(0, width.px, length.out = 1000), breaks = 6), cut(seq(0,height.px, length.out = 1000), 8), 200)
draw.circle(x = rep(cut(seq(0, width.px, length.out = 1000), breaks = 6), 7), y = rep(cut(seq(0,height.px, length.out = 1000), 8), each = 5), 200)
rep(cut(seq(0, width.px, length.out = 1000), breaks = 6), 7)
draw.circle(x = rep(cut(seq(0, width.px, length.out = 1000), breaks = 8), 7), y = rep(cut(seq(0,height.px, length.out = 1000), 8), each = 6), 200)
x = rep(cut(seq(0, width.px, length.out = 1000), breaks = 8), 7)
rep(cut(seq(0,height.px, length.out = 1000), 8), each = 6)
cut(seq(0, width.px, length.out = 1000), breaks = 8, labels = F)
x <- seq(0, width.px, length.out = 1000)
y <- seq(0,height.px, length.out = 1000)
plot(x, y)
rasterImage(photo, xleft = 0, ybottom = 0, xright = width.px, ytop = height.px)
x <- tapply(x, cut(seq(0, width.px, length.out = 1000), breaks = 7), mean)
x
x <- tapply(x, cut(seq(0, width.px, length.out = 1000), breaks = 6), mean)
x <- seq(0, width.px, length.out = 1000)
y <- seq(0,height.px, length.out = 1000)
x <- tapply(x, cut(x, breaks = 6), mean)
y <- tapply(y, cut(y, breaks = 8), mean)
draw.circle(x = rep(x, 8), y = rep(y, each = 6), 200)
x
x <- as.vector(tapply(x, cut(x, breaks = 6), mean))
y <- as.vector(tapply(y, cut(y, breaks = 8), mean))
rep(x, 8)
length(rep(x, 8))
length(rep(y, 6))
draw.circle(x = rep(x, 8), y = rep(y, each = 6), rep(200, 6*8))
x <- seq(0, width.px, length.out = 1000)
y <- seq(0,height.px, length.out = 1000)
plot(x, y)
rasterImage(photo, xleft = 0, ybottom = 0, xright = width.px, ytop = height.px)
x <- as.vector(tapply(x, cut(x, breaks = 6), mean))
y <- as.vector(tapply(y, cut(y, breaks = 8), mean))
draw.circle(x = rep(x, 8), y = rep(y, each = 6), rep(200, 6*8))
plot(1:5,seq(1,10,length=5),type="n",xlab="",ylab="",main="Test draw.circle")
draw.circle(2,4,c(1,0.66,0.33),border="purple",
col=c("#ff00ff","#ff77ff","#ffccff"),lty=1,lwd=1)
draw.circle(2.5,8,0.6,border="red",lty=3,lwd=3)
x <- seq(0, width.px, length.out = 1000)
y <- seq(0,height.px, length.out = 1000)
draw.circle(2,4,c(1,0.66,0.33),border="purple",
col=c("#ff00ff","#ff77ff","#ffccff"),lty=1,lwd=1)
x <- seq(0, width.px, length.out = 1000)
y <- seq(0,height.px, length.out = 1000)
plot(x, y)
draw.circle(2.5,8,0.6,border="red",lty=3,lwd=3)
draw.circle(2,4,c(1,0.66,0.33),border="purple",
col=c("#ff00ff","#ff77ff","#ffccff"),lty=1,lwd=1)
draw.circle(500,200,100,border="red",lty=3,lwd=3)
rep(x, 8)
cbin(rep(x, 8), rep(y, 6))
cbind(rep(x, 8), rep(y, 6))
x <- as.vector(tapply(x, cut(x, breaks = 6), mean))
y <- as.vector(tapply(y, cut(y, breaks = 8), mean))
cbind(rep(x, 8), rep(y, 6))
cbind(rep(x, 8), rep(y, reach = 6))
cbind(rep(x, 8), rep(y, each = 6))
draw.circle(x = rep(x, 8), y = rep(y, each = 6), 100)
coordinates.circle <- cbind(rep(x, 8), rep(y, each = 6))
apply(coordinates.circle, 1, function(x) draw.circle(x[1,], x[,2], 100))
apply(coordinates.circle, 1, function(x) draw.circle(x[1], x[2], 100))
x <- seq(0, width.px, length.out = 1000)
y <- seq(0,height.px, length.out = 1000)
plot(x, y)
rasterImage(photo, xleft = 0, ybottom = 0, xright = width.px, ytop = height.px)
x <- as.vector(tapply(x, cut(x, breaks = 6), mean))
y <- as.vector(tapply(y, cut(y, breaks = 8), mean))
coordinates.circle <- cbind(rep(x, 8), rep(y, each = 6))
apply(coordinates.circle, 1, function(x) draw.circle(x[1], x[2], 100))
x1 <- seq(0, width.px, length.out = 1000)
y1 <- seq(0,height.px, length.out = 1000)
plot(x1, y1)
rasterImage(photo, xleft = 0, ybottom = 0, xright = width.px, ytop = height.px)
break.x <- 8
break.y <- 15
x <- as.vector(tapply(x1, cut(x1, breaks = break.x), mean))
y <- as.vector(tapply(y1, cut(y1, breaks = break.y), mean))
coordinates.circle <- cbind(rep(x, break.y), rep(y, each = break.x))
apply(coordinates.circle, 1, function(x) draw.circle(x[1], x[2], 100))
apply(coordinates.circle, 1, function(x) draw.circle(x[1], x[2], 50))
getwd(
)
# make a picture of the data
mat <- mat[order(mat$id, mat$x),]
set.seed(1)
# our growth functions are piecewise linear with these breaks
breaks <- seq(0,5)
mean.slopes <- seq(5,2,-.6)
# generate the true slope parameters for 20 subjects (variance isn't really constant or known, just simplifying)...
true.slopes <- sapply(mean.slopes,function(x) rnorm(n=20,sd=3,mean=x))
# ...and the intercepts - they really don't come from any particular distribution
true.intercepts <- runif(n=20,min=30,max=50)
# generate sample data - we don't necessarily have the same number of observations per subject
mat <- matrix(nr=20*10,nc=3)
for (i in 1:20)
{
xs <- runif(n=10,min=0,max=6)
slopes <- true.slopes[i,]
ys <- true.intercepts[i] + rnorm(n=10,mean=0,sd=0.9) +
sapply(xs, function(x) sum(slopes[1:floor(x)]) + (x - floor(x)) *
slopes[ceiling(x)])
id <- rep(i,10)
mat[(1+10*(i-1)):(10*i),] <- cbind(xs,ys,id)
}
mat <- as.data.frame(mat)
names(mat) <- c("x","y","id")
mat
# make a picture of the data
mat <- mat[order(mat$id, mat$x),]
mat$id <- factor(mat$id)
plot1 <- xyplot(y~x, group=id, data=mat, type="b")
plot1
# packages needed
library(lattice)
library(latticeExtra)
library(lme4)
plot1 <- xyplot(y~x, group=id, data=mat, type="b")
plot1
# function to set up knots
knot <- function(x, knot) {(x-knot)*(x>knot)}
knots <- function(x, knots) {
out <- sapply(knots, function(k) knot(x, k))
colnames(out) <- knots
out
}
knots
knots(mat$x, 0:5)
# add knots to data frame
mat$knot <- knots(mat$x, 0:5)
# piecewise curves with no random effects
m1 <- lm(y~ knot, data=mat)
summary(m1)
# get predicted values
matX <- data.frame(x=0:6)
matX$knot <- knots(matX$x, 0:5)
matX$predict <- predict(m1, newdata=matX)
# plot of data and predicted values
plot1 <- xyplot(y~x, group=id, data=mat, type="b")
plot2 <- xyplot(predict~x, data=matX, type="b", col="black", lwd=3)
plot1+plot2
# piecewise curves with random effects
m2 <- lmer(y~ knot + (knot|id), data=mat)
summary(m2)
ranef(m2)
# get predicted values
ids <- unique(mat$id)
matXid <- expand.grid(id=unique(mat$id), x=0:6)
matXid$knot <- knots(matXid$x, 0:5)
matXid$predict <- rowSums(as.matrix(coef(m2)$id[matXid$id,]) * cbind(1,matXid$knot))
# plot of data and predicted values
plot1 <- xyplot(y~x|id, data=mat, type="b", as.table=TRUE)
plot2 <- xyplot(predict~x|id, data=matXid, type="b", col="black", lwd=1)
plot1+plot2
library(magick)
rm(ls())
source("R/my.arrows.R")
r = 2
xs <- c(1/2, sqrt(3)/2)
x1 <- c(0, xs, 1,  rev(xs), 0, -c(xs), -1,  -rev(xs), 1) * r
y1 <- sqrt(r^2 - x1^2) * c(1, 1, 1, 1, -1,-1,-1,-1,-1,1,1,1,1)
X <- data.frame(x0 = 0, y0 = 0, x1, y1)
for(r in 1:100){
print(r)
( i <- sample(x = 1:nrow(X), size = 1))
png("arrows.png", width = 200, height = 200, units = "px", res = 96, )
par(mar = c(0,0,0,0))
plot(-2:2, -2:2, axes = F, xlab = "", ylab= "", type = "n")
arrow.coordinates <- as.list(X[i,])
my.arrows(arrow.coordinates, arr.width = rlnorm(1, 0, 0.5))
dev.off()
img <- image_read("arrows.png")
if(r == 1 ) all_img <- img else  all_img <- image_scale(c(all_img, img), "200")
}
animation <-  image_animate(all_img, fps = 1)
image_write(animation, path = "img/portfolio/my_arrows.gif", format = "gif")
library(magick)
rm(ls())
source("R/my.arrows.R")
rm(list = ls())
setwd('C:/Users/HerrmannV/Dropbox (Smithsonian)/GitHub/ValentineHerr.github.io/')
source("R/my.arrows.R")
r = 2
xs <- c(1/2, sqrt(3)/2)
x1 <- c(0, xs, 1,  rev(xs), 0, -c(xs), -1,  -rev(xs), 1) * r
y1 <- sqrt(r^2 - x1^2) * c(1, 1, 1, 1, -1,-1,-1,-1,-1,1,1,1,1)
X <- data.frame(x0 = 0, y0 = 0, x1, y1)
for(r in 1:100){
print(r)
( i <- sample(x = 1:nrow(X), size = 1))
png("arrows.png", width = 200, height = 200, units = "px", res = 96, )
par(mar = c(0,0,0,0))
plot(-2:2, -2:2, axes = F, xlab = "", ylab= "", type = "n")
arrow.coordinates <- as.list(X[i,])
my.arrows(arrow.coordinates, arr.width = rlnorm(1, 0, 0.5))
dev.off()
img <- image_read("arrows.png")
if(r == 1 ) all_img <- img else  all_img <- image_scale(c(all_img, img), "200")
}
library(magick)
img <- image_read("arrows.png")
library(magick)
rm(list = ls())
setwd('C:/Users/HerrmannV/Dropbox (Smithsonian)/GitHub/ValentineHerr.github.io/')
source("R/my.arrows.R")
r = 2
xs <- c(1/2, sqrt(3)/2)
x1 <- c(0, xs, 1,  rev(xs), 0, -c(xs), -1,  -rev(xs), 1) * r
y1 <- sqrt(r^2 - x1^2) * c(1, 1, 1, 1, -1,-1,-1,-1,-1,1,1,1,1)
X <- data.frame(x0 = 0, y0 = 0, x1, y1)
for(r in 1:100){
print(r)
( i <- sample(x = 1:nrow(X), size = 1))
png("arrows.png", width = 200, height = 200, units = "px", res = 96, )
par(mar = c(0,0,0,0))
plot(-2:2, -2:2, axes = F, xlab = "", ylab= "", type = "n")
arrow.coordinates <- as.list(X[i,])
my.arrows(arrow.coordinates, arr.width = rlnorm(1, 0, 0.5))
dev.off()
img <- image_read("arrows.png")
if(r == 1 ) all_img <- img else  all_img <- image_scale(c(all_img, img), "200")
}
animation <-  image_animate(all_img, fps = 1)
image_write(animation, path = "img/portfolio/my_arrows.gif", format = "gif")
image_scale(c(all_img, img))
library(magick)
rm(list = ls())
setwd('C:/Users/HerrmannV/Dropbox (Smithsonian)/GitHub/ValentineHerr.github.io/')
source("R/my.arrows.R")
r = 2
xs <- c(1/2, sqrt(3)/2)
x1 <- c(0, xs, 1,  rev(xs), 0, -c(xs), -1,  -rev(xs), 1) * r
y1 <- sqrt(r^2 - x1^2) * c(1, 1, 1, 1, -1,-1,-1,-1,-1,1,1,1,1)
X <- data.frame(x0 = 0, y0 = 0, x1, y1)
for(r in 1:100){
print(r)
( i <- sample(x = 1:nrow(X), size = 1))
png("arrows.png", width = 900, height = 650, units = "px", res = 96 )
par(mar = c(0,0,0,0))
plot(-2:2, -2:2, axes = F, xlab = "", ylab= "", type = "n")
arrow.coordinates <- as.list(X[i,])
my.arrows(arrow.coordinates, arr.width = rlnorm(1, 0, 0.5))
dev.off()
img <- image_read("arrows.png")
if(r == 1 ) all_img <- img else  all_img <- image_scale(c(all_img, img))
}
animation <-  image_animate(all_img, fps = 1)
image_write(animation, path = "img/portfolio/my_arrows.gif", format = "gif")