library(dplyr) #Devel version, soon-to-be-released 0.6.0
library(tidyr)
library(ggplot2)
library(forcats) #for gss_cat data
Run Code Online (Sandbox Code Playgroud)
我正在尝试编写一个函数,它结合了即将发布的dplyrdevel版本的quosures tidyr::gather和ggplot2.到目前为止它似乎可以使用tidyr,但我在绘图方面遇到了麻烦.
以下功能似乎适用于tidyr's gather:
GatherFun<-function(gath){
gath<-enquo(gath)
gss_cat%>%select(relig,marital,race,partyid)%>%
gather(key,value,-!!gath)%>%
count(!!gath,key,value)%>%
mutate(perc=n/sum(n))
}
Run Code Online (Sandbox Code Playgroud)
但我无法弄清楚如何让情节发挥作用.我试着用!!gath用ggplot2,但没有奏效.
GatherFun<-function(gath){
gath<-enquo(gath)
gss_cat%>%select(relig,marital,race,partyid)%>%
gather(key,value,-!!gath)%>%
count(!!gath,key,value)%>%
mutate(perc=n/sum(n))%>%
ggplot(aes(x=value,y=perc,fill=!!gath))+
geom_col()+
facet_wrap(~key, scales = "free") +
geom_text(aes(x = "value", y = "perc",
label = "perc", group = !!gath),
position = position_stack(vjust = .05))
}
Run Code Online (Sandbox Code Playgroud) 由于我在标题幻灯片底部的图片,我想:
title,subtitle并author达到他们的中心位置. Rlogo标题幻灯片中的内容(不知道该怎么做).我现在只能删除幻灯片号码.title-slide .remark-slide-number { display: none; }.任何建议表示赞赏!谢谢!
这是我可重复的例子:
tweaks.css文件
/* for logo and slide number in the footer */
.remark-slide-content:after {
content: "";
position: absolute;
bottom: 15px;
right: 8px;
height: 40px;
width: 120px;
background-repeat: no-repeat;
background-size: contain;
background-image: url("Rlogo.png");
}
/* for background image in title slide */
.title-slide {
background-image: url("slideMasterSample.png");
background-size: cover;
}
.title-slide h1 {
color: #F7F8FA;
margin-top: -170px;
}
.title-slide h2, .title-slide h3 …Run Code Online (Sandbox Code Playgroud) 我正在寻找有效的方法来删除数据中的异常值。我尝试了在 StackOverflow 和其他地方找到的几种解决方案,但没有一个对我有用(应该在样本数据中检测并删除 1993 年 6 月、1994 年 8 月和 1995 年 3 月的 4 个高值 21637、19590、21659 和 200000发布在这篇文章的末尾)。任何建议将不胜感激!
这是我到目前为止测试过的:
数据概览

3 个异常值仍然存在,并且时间序列末尾的许多合法高值已被删除。
y <- dat$Value
y_filter <- y[!y %in% boxplot.stats(y)$out]
plot(y_filter)
Run Code Online (Sandbox Code Playgroud)

与第一种方法类似的问题
FindOutliers <- function(data) {
data <- data[!is.na(data)]
lowerq = quantile(data)[2]
upperq = quantile(data)[4]
iqr = upperq - lowerq #Or use IQR(data)
# we identify extreme outliers
extreme.threshold.upper = (iqr * 1.5) + upperq
extreme.threshold.lower = lowerq - (iqr * 1.5)
result <- which(data …Run Code Online (Sandbox Code Playgroud) 尝试编写一个相对简单的包装器来生成一些图,但是无法弄清楚如何指定整理评估的分组变量,这些变量被指定为...一个面向变量但不通过分组区分的示例函数...
my_plot <- function(df = starwars,
select = c(height, mass),
...){
results <- list()
## Tidyeval arguments
quo_select <- enquo(select)
quo_group <- quos(...)
## Filter, reshape and plot
results$df <- df %>%
dplyr::filter(!is.na(!!!quo_group)) %>%
dplyr::select(!!quo_select, !!!quo_group) %>%
gather(key = variable, value = value, !!!quo_select) %>%
## Specify what to plot
ggplot(aes(value)) +
geom_histogram(stat = 'count') +
facet_wrap(~variable, scales = 'free', strip.position = 'bottom')
return(results)
}
## Plot height and mass as facets but colour histograms by hair_color
my_plot(df …Run Code Online (Sandbox Code Playgroud) 考虑这个简单的例子
library(dplyr)
library(ggplot2)
dataframe <- data_frame(id = c(1,2,3,4),
group = c('a','b','c','c'),
value = c(200,400,120,300))
# A tibble: 4 x 3
id group value
<dbl> <chr> <dbl>
1 1 a 200
2 2 b 400
3 3 c 120
4 4 c 300
Run Code Online (Sandbox Code Playgroud)
在这里,我想编写一个将数据帧和分组变量作为输入的函数.理想情况下,在分组和聚合后,我想打印一个ggpplot图表.
这有效:
get_charts2 <- function(data, mygroup){
quo_var <- enquo(mygroup)
df_agg <- data %>%
group_by(!!quo_var) %>%
summarize(mean = mean(value, na.rm = TRUE),
count = n()) %>%
ungroup()
df_agg
}
> get_charts2(dataframe, group)
# A tibble: …Run Code Online (Sandbox Code Playgroud) 我有一个巨大的数据集,包含679行和16列,缺失值为30%.所以我决定用包impute中的impute.knn函数来判断这个缺失的值,我得到了一个包含679行和16列但没有缺失值的数据集.
但现在我想使用RMSE检查准确性,我尝试了两个选项:
hydroGOF并应用该rmse功能sqrt(mean (obs-sim)^2), na.rm=TRUE)在两种情况下,我有错误: errors in sim .obs: non numeric argument to binary operator.
发生这种情况是因为原始数据集包含一个NA值(缺少某些值).
如果删除缺失值,如何计算RMSE?然后obs,sim将有不同的大小.
我想在单色图形中的一条线上绘制标签.所以我需要在标签的每个字母上留下小的白色边框.
文本标签的矩形边框或背景无用,因为隐藏了大量绘制的数据.
有没有办法在R图中的文本标签周围放置边框,阴影或缓冲区?
编辑:
shadowtext <- function(x, y=NULL, labels, col='white', bg='black',
theta= seq(pi/4, 2*pi, length.out=8), r=0.1, ... ) {
xy <- xy.coords(x,y)
xo <- r*strwidth('x')
yo <- r*strheight('x')
for (i in theta) {
text( xy$x + cos(i)*xo, xy$y + sin(i)*yo, labels, col=bg, ... )
}
text(xy$x, xy$y, labels, col=col, ... )
}
pdf(file="test.pdf", width=2, height=2); par(mar=c(0,0,0,0)+.1)
plot(c(0,1), c(0,1), type="l", lwd=20, axes=FALSE, xlab="", ylab="")
text(1/6, 1/6, "Test 1")
text(2/6, 2/6, "Test 2", col="white")
shadowtext(3/6, 3/6, "Test 3")
shadowtext(4/6, 4/6, "Test 4", …Run Code Online (Sandbox Code Playgroud) 我的简单问题是:如何ks.test逐列在两个数据框之间进行处理?
例如。我们有两个数据框:
D1 <- data.frame(D$Ag, D$Al, D$As, D$Ba, D$Be, D$Ca, D$Cd, D$Co, D$Cu, D$Cr)
D2 <- data.frame(S$Ag, S$Al, S$As, S$Ba, S$Be, S$Ca, S$Cd, S$Co, S$Cu, S$Cr)
Run Code Online (Sandbox Code Playgroud)
注意:这只是一个例子 - 实际情况将包括更多的列,并且它们包含特定位置中某个元素的浓度。
现在我想在两个数据帧之间运行 ks.test :
ks.test(D$Ag, S$Ag)
ks.test(D$Al, S$Al)
ks.test(D$As, S$As)
Run Code Online (Sandbox Code Playgroud)
等等。如何在不做奴隶制工作的情况下做到这一点?
当我对一个数据框进行 shapiro.test 时,我只是使用:
lshap1 <- lapply(D1, shapiro.test)
lres1 <- sapply(lshap1, `[`, c("statistic","p.value"))
Run Code Online (Sandbox Code Playgroud)
我读过一些关于循环、聚合、映射的东西 - 尝试了不同的东西,比如:
apply(D1, 2, function(D2) ks.test(D2,D1[,1])$p.value)
Run Code Online (Sandbox Code Playgroud)
但后来我得到了很多 p 值 = 0.. 当我手动执行时,情况并非如此。
编辑:09.10.2017 我将数据作为两个数据框导入,然后我将一些数据提取到“较小”的数据框进行分析 - 例如在这种情况下查看有毒元素并排除其他元素。
样本数据:dput(head(D1))和dput(head(D2))。
## Output dput(head(D1)):
structure(list(DF.As = …Run Code Online (Sandbox Code Playgroud) sbatch手册页中使用的术语可能有点令人困惑.因此,我想确保我正确设置选项.假设我有一个任务在一个有N个线程的节点上运行.我是否正确地假设我会使用--nodes = 1和--ntasks = N?我习惯于考虑使用例如pthreads在单个进程中创建N个线程.他们称之为"核心"或"每个任务的cpus"的结果是什么?CPU和线程在我的脑海里并不是一回事.
我正在 ggplot2 中制作图表,但ggsave()没有达到我的预期。
require(ggplot2)
require(showtext)
showtext_auto()
hedFont <- "Pragati Narrow"
font_add_google(
name = hedFont,
family = hedFont,
regular.wt = 400,
bold.wt = 700
)
chart <- ggplot(
data = cars,
aes(
x = speed,
y = dist
)
) +
geom_point() +
labs(
title = "Here is a title",
subtitle = "Subtitle here"
) +
theme(
plot.title = element_text(
size = 20,
family = hedFont,
face = "bold"
),
axis.title = element_text(
face = "bold"
)
)
ggsave( …Run Code Online (Sandbox Code Playgroud)