Related
I am trying to do a yahtzee game in R, amd I would like to show the dice on the plot part of R. like this :
I have this function how simulate a dice roll
rolls_the_dice <- function(X1 = 5){if(X1 <= 5){sample(1:6, X1, replace = TRUE)}
But I don't know how to display the score the way I described. I have two main ideas:
First:
plot(c(0, 200), c(0, 170), type = "n", xlab = "", ylab = "", axes= F, main = "")
rect(xleft = 30, xright = 80, ybottom = 0, ytop = 50)
rect(xleft = 0, xright = 50, ybottom = 100, ytop = 150)
rect(xleft = 70, xright = 120, ybottom = 100, ytop = 150)
rect(xleft = 140, xright = 190, ybottom = 100, ytop = 150)
rect(xleft = 120, xright = 170, ybottom = 0, ytop = 50)
That plot 5 rectangles, and then I have to find a way to put points in it giving the result
Second :
rect(xleft = 0, xright = 20, ybottom = 0, ytop = 20)
points(x= 10, y= 10, col="black", pch=19)
This is the face one of a dice. This idea is to create one plot per dice face, and then to pick them up giving the result. But here I don´t know how to store them.
If somebody could tell me what is the best (or even just the feasable) idea.
there's a package for that ;-)
library(magrittr)
library(tidydice)
roll_dice(times = 5, rounds = 1) %>% plot_dice()
Here is one way of doing it in base R using lists...
#your function
rolls_the_dice <- function(X1 = 5){if(X1 <= 5){sample(1:6, X1, replace = TRUE)}}
#a list of x-y coordinates of the corners of the five dice
rects <- list(c(30, 0), c(0, 100), c(70, 100), c(140, 100), c(120, 0))
#a list of list(x, y) coordinates of the dots for numbers 1-6
dots <- list(list(0, 0),
list(c(-1, 1), c(-1, 1)),
list(c(-1, 0, 1), c(-1, 0, 1)),
list(c(-1, -1, 1, 1), c(-1, 1, -1, 1)),
list(c(-1, -1, 0, 1, 1), c(-1, 1, 0, -1, 1)),
list(c(-1, -1, -1, 1, 1, 1), c(-1, 0, 1, -1, 0, 1)))
#a function to plot a dice and a number
plot_face <- function(rects, dots){
rect(xleft = rects[1], xright = rects[1] + 50,
ybottom = rects[2], ytop = rects[2] + 50)
points(x = rects[1] + 25 + 15 * dots[[1]],
y = rects[2] + 25 + 15 * dots[[2]], col = "black", pch = 19)
}
#plot a blank area (note asp=1 to keep the dice square)
plot(c(0, 200), c(0, 170), type = "n", xlab = "", ylab = "",
axes= F, main = "", asp = 1)
#plot the five dice and five random numbers
mapply(plot_face, rects, dots[rolls_the_dice()])
Maybe this could be also interesting for you: the 'TeachingDemos' package provides a "dice" function code https://github.com/cran/TeachingDemos
#install.packages("TeachingDemos")
library(TeachingDemos)
dice(5,1, plot.it=TRUE)
I'm trying to use ggplot, and am hoping to create a boxplot that has four categories on the x axis for suspension data (low, lowish, highish, high) and farms on the y-axis.
I have I think broken the suspension column into four groups. But ggplot is upset with me. Here is the error:
```
Error in if (is.double(data$x) && !has_groups(data) && any(data$x != data$x[1L])) { : missing value where TRUE/FALSE needed
```
Here is my code:
```{r}
# To break suspension_rate_total_pct data into groups for clearer visualization, I found the min, and max
merged_data$suspension_rate_total_pct <-
as.numeric(merged_data$suspension_rate_total_pct)
max(merged_data$suspension_rate_total_pct, na.rm=TRUE)
min(merged_data$suspension_rate_total_pct, na.rm=TRUE)
low_suspension <- merged_data$suspension_rate_total_pct > 0 & merged_data$suspension_rate_total_pct < 0.5
low_ish_suspension <- merged_data$suspension_rate_total_pct > 0.5 & merged_data$suspension_rate_total_pct < 1
high_ish_suspension <- merged_data$suspension_rate_total_pct > 1 & merged_data$suspension_rate_total_pct < 1.5
high_suspension <- merged_data$suspension_rate_total_pct > 1.5 & merged_data$suspension_rate_total_pct < 2
ggplot(merged_data, aes(x = suspension_rate_total_pct , y = farms_pct)) +
geom_boxplot()
```
Here is the Data:
merged_data <- structure(list(schid = c("1030642", "1030766", "1030774", "1030840",
"1130103", "1230150"), enrollment = c(159, 333, 352, 430, 102,
193), farms = c(132, 116, 348, 406, 68, 130), foster = c(2, 0,
1, 8, 1, 4), homeless = c(14, 0, 8, 4, 1, 4), migrant = c(0,
0, 0, 0, 0, 0), ell = c(18, 12, 114, 45, 7, 4), suspension_rate_total = c(NA,
20, 0, 0, 95, 5), suspension_violent = c(NA, 9, 0, 0, 20, 2),
suspension_violent_no_injury = c(NA, 6, 0, 0, 47, 1), suspension_weapon = c(NA,
0, 0, 0, 8, 0), suspension_drug = c(NA, 0, 0, 0, 9, 1), suspension_defiance = c(NA,
1, 0, 0, 9, 1), suspension_other = c(NA, 4, 0, 0, 2, 0),
farms_pct = c(0.830188679245283, 0.348348348348348, 0.988636363636364,
0.944186046511628, 0.666666666666667, 0.673575129533679),
foster_pct = c(0.0125786163522013, 0, 0.00284090909090909,
0.0186046511627907, 0.00980392156862745, 0.0207253886010363
), migrant_pct = c(0, 0, 0, 0, 0, 0), ell_pct = c(0.113207547169811,
0.036036036036036, 0.323863636363636, 0.104651162790698,
0.0686274509803922, 0.0207253886010363), homeless_pct = c(0.0880503144654088,
0, 0.0227272727272727, 0.00930232558139535, 0.00980392156862745,
0.0207253886010363), suspension_rate_total_pct = c(NA, 2,
1, 1, 2, 2)), row.names = c(NA, -6L), class = c("tbl_df",
"tbl", "data.frame"))
If you can, please help me appease ggplot so that it will give me with beautiful visualization. Currently, this feels like a one-sided, emotional rollercoaster of a relationship.
Just a short answer, i am sure you can figure out the rest by yourself, (otherwise post a followup question.)
Since the data you provided has some NA's in the first row in several columns, i can only demonstrate you the principle on how to get your desired result by using the merged_data$homless value as group-input for our boxplots , the data (y-value) will be still Farms .
# first we create our groups of low, middle & high amount of homeless
merged_data2<- merged_data %>% mutate(homelessgroup= ifelse(homeless < 4, "low",
ifelse(homeless <= 8, "middle",
ifelse(homeless > 8, "high",NA ))))
## then we plot the data using ggplot
ggplot(merged_data2,aes(y=farms,fill=homelessgroup))+geom_boxplot()
I think you can just use cut() with your data to partition into 4 groups. Then you can use that variable with the plot
merged_data <- transform(merged_data,
group = cut(
suspension_rate_total_pct,
c(0, .5, 1, 1.5, 2),
include.lowest = TRUE,
labels = c("low", "lowish", "highish", "high")))
ggplot(merged_data, aes(x = group , y = farms_pct)) +
geom_boxplot()
I have created a plot in base R, including 3 clipped 'ablines'. Despite using the "frame.plot = FALSE" function, which removes the box around the plot (see image example1), when I add my clipped ablines [using ablineclip] new framing lines appear above them (see image example2).
The code I am using is shown below:
library(plotrix)
op <- par(mar=c(5, 6, 4, 2) + 0.1)
plot(dif2$land_area ~ dif2$Year_no, ylim = c(1,4000), col.axis = rgb(68, 84, 106,max=255),xaxt='n', type='o', pch=16, col='red', font.axis=2, font.lab=2, col.lab=rgb( 113, 113, 113, max=255), xlab = 'Year', ylab = 'Total Land Area Changed to \nResidential Development (Ha)', frame.plot = FALSE, cex=1.3)
rect(23.2,0,25.8,4000,col='grey',density = 8,border=T)
rect(10.2,0,11.8,4000,col='grey',density = 8,border=T)
xlim(0,30)
axis(1,at= 1:30,labels=F)
axis(1,at= 1:30,tick=F, font.axis=2, col.axis = rgb(68, 84, 106, max=255),labels= c(1989:2018))
# the below section is that which seems to create the issue #
ablineclip(lm(land_area ~ Year_no, data = subset(dif2, int==0)), col='blue', lty=2, x1=1,x2=10, lwd=0.8)
ablineclip(lm(land_area ~ Year_no, data = subset(dif2, int==0)), col='blue', lty=2, x1=12,x2=23, lwd=0.8)
ablineclip(lm(land_area ~ Year_no, data = subset(dif2, int==1)), col='blue', lty=2, x1=26,x2=30, lwd=0.8)
Does anyone have any ideas of why the ablineclip function appears to be altering the borders of the plot?
Cheers
You just need to set the y limits to the area clipped by ablineclip using the parameters y1 and y2, ensuring that y2 is below the top of your plot.
ablineclip(lm(land_area ~ Year_no, data = subset(dif2, int==0)),
col = 'blue', lty = 2, x1 = 1, x2 = 10, y1 = 1, y2 = 3500, lwd = 0.8)
ablineclip(lm(land_area ~ Year_no, data = subset(dif2, int==0)),
col = 'blue', lty = 2, x1 = 12, x2 = 23, y1 = 1, y2 = 3500, lwd = 0.8)
ablineclip(lm(land_area ~ Year_no, data = subset(dif2, int==1)),
col = 'blue', lty = 2, x1 = 26, x2 = 30, y1 = 1, y2 = 3500, lwd = 0.8)
Result:
Of course, I didn't have your data to work with so I had to make up a set that was similar (that's why the graph's shape is different to yours). The data I used was:
dif2 <- structure(list(Year_no = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11,
12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27,
28), land_area = c(3165, 3179, 3076, 2772, 2816, 2605, 2565,
2525, 2446, 2361, NA, 1966, 1911, 1790, 1819, 1710, 1673, 1555,
1434, 1220, 1174, 1021, 1564, NA, NA, 2479, 2539, 2872), int = c(0,
0, 0, 0, 0, 0, 0, 0, 0, 0, NA, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, NA, NA, 1, 1, 1)), row.names = c(NA, -28L), class = "data.frame")
It's something in the code, see below, when you provide x1 and x2, it draws a line on the y limits + 1 :
> ablineclip
function (a = NULL, b = NULL, h = NULL, v = NULL, reg = NULL,
coef = NULL, untf = FALSE, x1 = NULL, x2 = NULL, y1 = NULL,
y2 = NULL, ...)
{
if (!is.null(c(x1, x2, y1, y2))) {
oldclip <- par("usr")
if (is.null(x1))
x1 <- oldclip[1]
if (is.null(x2))
x2 <- oldclip[2]
if (is.null(y1))
y1 <- oldclip[3]
if (is.null(y2))
y2 <- oldclip[4]
clip(x1, x2, y1, y2)
abline(h = oldclip[4] + 1)
You can hack the code and comment out this line, or just use abline with a combination of predict. First we simulate something like your data:
set.seed(123)
dif2 = data.frame(land_area= rnbinom(30,mu=1500,size=5),
Year_no = seq_along(1989:2018))
dif2$int = rep(0:1,c(23,7))
dif2$int[23:27] = 1
dif2[1989:2018 %in% c(1999,2012,2013),c("land_area","int")] = NA
And plot:
library(plotrix)
op <- par(mar=c(5, 6, 4, 2) + 0.1)
plot(dif2$Year_no, dif2$land_area,ylim = c(1,4000), col.axis = rgb(68, 84, 106,max=255),xaxt='n', type='o', pch=16, col='red', font.axis=2, font.lab=2, col.lab=rgb( 113, 113, 113, max=255), xlab = 'Year', ylab = 'Total Land Area Changed to \nResidential Development (Ha)', frame.plot = FALSE, cex=1.3)
rect(23.2,0,25.8,4000,col='grey',density = 8,border=T)
rect(10.2,0,11.8,4000,col='grey',density = 8,border=T)
axis(1,at= 1:30,labels=F)
axis(1,at= 1:30,tick=F, font.axis=2, col.axis = rgb(68, 84, 106, max=255),labels= c(1989:2018))
We make the two fits, and you use predict to get the y values
fit1=lm(land_area ~ Year_no, data = subset(dif2, int==0))
fit2=lm(land_area ~ Year_no, data = subset(dif2, int==1))
lines(1:10,predict(fit1,data.frame(Year_no=1:10)),lty=8,col="blue")
lines(12:23,predict(fit1,data.frame(Year_no=12:23)),lty=8,col="blue")
lines(26:30,predict(fit2,data.frame(Year_no=26:30)),lty=8,col="blue")
I am trying to combine 20 mosaic plots onto one output. par(mfrow=...) is not working. I would like the rows to have 3 plots in each row.
Here is code for just 4 of the plots that I am using:
library(vcd)
library(vcdExtra)
library(MASS)
All <- matrix(c(599,250,39,24, 157,238,89,40, 26,51,51,45, 26,26,30,57), 4, 4)
dimnames(All) <- list("2002" =c("Never","Light","Moderate","Heavy"), "2014" =c("Never","Light","Moderate","Heavy"))
All <- as.table(All)
Poor <- matrix(c(184,57,7,6, 51,43,12,6, 9,10,6,6, 9,5,9,11), 4, 4)
dimnames(Poor) <- list("2002"=c("Never","Light","Moderate","Heavy"), "2014" =c("Never","Light","Moderate","Heavy"))
Poor <- as.table(Poor)
NonPoor <- matrix(c(376,180,30,18, 94,192,77,34, 12,40,43,39, 15,19,21,41), 4, 4)
dimnames(NonPoor) <- list("2002"=c("Never","Light","Moderate","Heavy"), "2014" =c("Never","Light","Moderate","Heavy"))
NonPoor <- as.table(NonPoor)
Black <- matrix(c(239,82,7,6, 54,56,15,9, 8,12,9,5, 12,11,8,8), 4, 4)
dimnames(Black) <- list("2002"=c("Never","Light","Moderate","Heavy"), "2014" =c("Never","Light","Moderate","Heavy"))
Black <- as.table(Black)
mosaic(All, shade = TRUE, rot_labels = c(top = 90, left=0),just_labels = c("left","right","right","right"),offset_labels = c(-.4, 0, 0, 0),offset_varnames = c(1.5, 0, 0, 1.5))
mosaic(Poor, shade = TRUE, rot_labels = c(top = 90, left=0),just_labels = c("left","right","right","right"),offset_labels = c(-.4, 0, 0, 0),offset_varnames = c(1.5, 0, 0, 1.5))
mosaic(NonPoor, shade = TRUE, rot_labels = c(top = 90, left=0),just_labels = c("left","right","right","right"),offset_labels = c(-.4, 0, 0, 0),offset_varnames = c(1.5, 0, 0, 1.5))
mosaic(Black, shade = TRUE, rot_labels = c(top = 90, left=0),just_labels = c("left","right","right","right"),offset_labels = c(-.4, 0, 0, 0),offset_varnames = c(1.5, 0, 0, 1.5))
I did something similar earlier with bar plots and it worked just using the par(mfrow=...). Thank you in advance!
Its a little bit tricky with VCD graphics
try this approach
library(gridExtra)
fig1<-grid.grabExpr(mosaic(All, shade = TRUE, rot_labels = c(top = 90, left=0),just_labels = c("left","right","right","right"),offset_labels = c(-.4, 0, 0, 0),offset_varnames = c(1.5, 0, 0, 1.5)))
fig2<-grid.grabExpr(mosaic(Poor, shade = TRUE, rot_labels = c(top = 90, left=0),just_labels = c("left","right","right","right"),offset_labels = c(-.4, 0, 0, 0),offset_varnames = c(1.5, 0, 0, 1.5)))
fig3<-grid.grabExpr(mosaic(NonPoor, shade = TRUE, rot_labels = c(top = 90, left=0),just_labels = c("left","right","right","right"),offset_labels = c(-.4, 0, 0, 0),offset_varnames = c(1.5, 0, 0, 1.5)))
fig4<-grid.grabExpr(mosaic(Black, shade = TRUE, rot_labels = c(top = 90, left=0),just_labels = c("left","right","right","right"),offset_labels = c(-.4, 0, 0, 0),offset_varnames = c(1.5, 0, 0, 1.5)))
grid.arrange(fig1,fig2,fig3,fig4)
for visualized my data, I used gplot.
Question: Why "colour" doesn't change, and is it possible to do type = "h" like in basic plot?
print(qplot(roundpop, Observation, data=roundpopus), shape = 5, colour = "blue") # i tryed with "" and without.
And if it's possible to change type to histogram, like on second picture, can I draw a line by the top of lines?
Like that:
and maybe to write labels (states) on the top of the lines. Because I know how to give a name only for dots on basic plot.
Thank you!
Here are some options, which you may want to tweak according to your needs:
library(ggplot2)
df <- structure(list(x = c(1, 2, 2, 2, 3, 3, 3, 3, 4, 4, 5, 5, 5, 6,
6, 6, 7, 7, 7, 7, 8, 9, 10, 10, 10, 12, 13, 13, 20, 20, 27, 39
), y = c(33, 124, 45, 294, 160, 105, 276, 178, 377, 506, 176,
393, 247, 378, 221, 796, 503, 162, 801, 486, 268, 575, 828, 493,
252, 495, 836, 551, 413, 832, 1841, 1927), lab = c("i8g8Q", "oXlWk",
"NC2WO", "pYxBL", "Xfsy6", "FJcOl", "Ke98f", "K2mCW", "g4XYi",
"ICzWp", "7nqrK", "dzhlC", "JagAW", "0bObp", "8ljIW", "E8OZR",
"6Tuxz", "3Grbq", "xqsld", "BvuJT", "JXi2N", "eSDYS", "OYVWN",
"vyWzK", "6AKxk", "nCgPx", "8lHrq", "kWAGm", "E08Rd", "cmIYY",
"btoUm", "k6Iek")), .Names = c("x", "y", "lab"), row.names = c(NA,
-32L), class = "data.frame")
p <- ggplot(df, aes(x, y))
gridExtra::grid.arrange(
p + geom_point(),
p + geom_point() + geom_text(aes(label = lab), angle = 60, hjust = 0, size = 2),
p + geom_segment(aes(xend=x, yend=0)),
p + geom_segment(aes(xend=x, yend=0)) + geom_line(color = "red", size = 2) ,
p + geom_segment(aes(xend=x, yend=0)) + geom_smooth(span = .4, se = FALSE, color = "red", size = 2)
)