如何使用 Stata 绘制一幅彩色的照片?给你的图表添加一个冰墩墩!

之前给大家推过不少使用 Stata 绘制图片的推文,例如使用 Stata 画一只口红:

听你说 Stata 画图很好用!你能用 Stata 画一只口红么!

使用 Stata 画一只口红

使用 Stata 绘制中美国旗:

如何使用 Stata 绘制中美国旗?

使用 Stata 绘制中美国旗

还有使用 Stata 绘制一只大老虎:

祝大家新年快乐~ 用 Stata 绘制一只大老虎送给大家!

使用 Stata 绘制一只大老虎

这些图都是先使用 R 语言把 svg 格式的图表编辑成地图数据,然后再使用 Stata 的 spmap/grmap 命令像绘制地图一样绘制出来。

那么能不能使用 Stata 把照片画出来呢?

首先我们来思考下,照片该如何画出来?

  • 照片本质是一个个有颜色的像素点;
  • 如果能把照片转换成矩阵就好了,根据这个矩阵生成每个像素点的横纵轴坐标和颜色值;
  • 在 Stata 中使用 scatter 把这个数据绘制出来不就是一张照片了!

待解决的问题1: 如何把照片转换成数据

Stata 中似乎没有很好的方法把照片转换成数据,所以这一步我们需要借助下 R 语言。

首先我们找到一张风景照片:

为了绘制的更快,可以把照片压缩到 100 万像素以下。

图表

这是张 JPG 格式的图片,在 R 语言中使用 jpeg::readJPEG() 函数读取:

df <- jpeg::readJPEG("2021_04_24_18_12_IMG_4151.JPG", native = T)

如果是 png 图片,可以使用 png::readPNG() 函数读取。

df 里面包含 R(red)、G(green)、B(blue)三个矩阵(组成了一个三维的数组),我们把其中一个矩阵导出为 csv 格式的文件:

df[1:dim(df)[1], 1:dim(df)[2], 1] %>%
as_tibble() %>%
readr::write_csv("photo.csv")

在 Stata 中把数据处理成 x, y, color 的数据

首先我们把刚刚保存的 photo.csv 文件读进 Stata 中:

clear all
import delimited photo.csv, clear

运行 ret list 可以查看数据的行数和列数:

ret list
*> scalars:
*> r(N) = 1000
*> r(k) = 750

*> macros:
*> r(delimiters) : ","
*> r(encoding) : "ISO-8859-2"

为了方便后续的调用,我们把行列存储为 local 变量:

local nrow = r(N)
local ncol = r(k)
global aspectratio = `nrow' / `ncol'

aspectratio 为图表的长宽比,在后续的绘图中会被使用。

生成行号并把行号变量放到最前面:

gen row = _n
order row

使用 gather 命令可以把这个数据转换成长数据:

gather v*

其中 gather 命令是个外部命令,可以使用 ssc install tidy 安装。

下面我们再把 variable 变量处理成列号:

ren variable col
replace col = subinstr(col, "v", "", .)
destring col, replace
ren value v

这里的 v 值就是红色的深浅值,这里我们用灰色绘图。

由于 Stata 不支持把变量值直接映射为散点的颜色,所以我们需要一个个图层的绘制散点图,每个 v 值绘制一个图层,由于 v 的取值很多,所以我们需要对 v 进行 round() 来减少药绘制的图层,先从 0.1 尝试:

* v 越大颜色越浅,所以用 1-v 替换 v,这样就是 v 越大,颜色越深了:
replace v = 1 - v
gen v1 = string(round(v, 0.01), "%6.1f")

* 保存数据
save photodata, replace

然后我们就可以绘图了:

use photodata, clear
* 镜像
replace row = -row
tw ///
sc row col if v1 == "0.1", msize(vtiny) mc(black*0.1) || ///
sc row col if v1 == "0.2", msize(vtiny) mc(black*0.2) || ///
sc row col if v1 == "0.3", msize(vtiny) mc(black*0.3) || ///
sc row col if v1 == "0.4", msize(vtiny) mc(black*0.4) || ///
sc row col if v1 == "0.5", msize(vtiny) mc(black*0.5) || ///
sc row col if v1 == "0.6", msize(vtiny) mc(black*0.6) || ///
sc row col if v1 == "0.7", msize(vtiny) mc(black*0.7) || ///
sc row col if v1 == "0.8", msize(vtiny) mc(black*0.8) || ///
sc row col if v1 == "0.9", msize(vtiny) mc(black*0.9) || ///
sc row col if v1 == "1.0", msize(vtiny) mc(black) ///
ytitle("") ///
xtitle("") ///
ylabel("") ///
xlabel("") ///
legend(off) ///
aspect(${aspectratio}) ///
scheme(s1color)
图表

显然这个绘制的结果很不精致!这都是因为前面选择了 round(0.1)!

为了画出来一个精致的宝宝,我使用了 round(0.0001)(这个参数需要大家根据自己的电脑性能和等待忍受力选择)。这个时候 v 的取值就会很多,一行行的写绘图语句就不太可能了,可以通过循环构造绘图语句:

clear all
import delimited photo.csv, clear
ret list
local nrow = r(N)
local ncol = r(k)
global aspectratio = `nrow' / `ncol'
gen row = _n
order row
gather v*
ren variable col
replace col = subinstr(col, "v", "", .)
destring col, replace
ren value v

replace v = 1 - v
gen v1 = string(round(v, 0.0001), "%6.4f")
save photodata2, replace

use photodata2, clear
replace row = -row
local cmd = "tw"
levelsof v1, local(vlist)
foreach vn in `vlist' {
if "`vn'" != "1.0000" local cmd = `"`cmd' (sc row col if v1 == "`vn'", msize(vtiny) mc(black*`vn'))"'
if "`vn'" == "1.0000" local cmd = `"`cmd' (sc row col if v1 == "`vn'", msize(vtiny) mc(black))"'
}

di `"`cmd'"'

`cmd', ytitle("") ///
xtitle("") ///
ylabel("") ///
xlabel("") ///
legend(off) ///
aspect(${aspectratio}) ///
scheme(s1color)
图表

是不是就非常精致了!

使用 Stata 绘制彩色图片

这个时候大家一定会想问该如何绘制彩色图片呢?

彩色图片也很好理解,就是每个散点颜色都是彩色的,所以我们需要一份 x,y,RGB 值的数据。

回到 R 语言里面把这个图片的 RGB 值都导出来:

for (v in 1:3) {
df[1:dim(df)[1], 1:dim(df)[2], v] %>%
as_tibble() %>%
readr::write_csv(paste0("photo", v, ".csv"))
}

然后我们用 Stata 把三份数据处理处理合并起来:

local RGBlist = "R G B"
forval i = 1/3{
import delimited photo`i'.csv, clear
local nrow = r(N)
local ncol = r(k)
global aspectratio = `nrow' / `ncol'
gen row = _n
gather v*
ren variable col
replace col = subinstr(col, "v", "", .)
destring col, replace
replace value = round(v, 0.1)
local a: word `i' of `RGBlist'
ren value `a'
replace `a' = int(R * 255)
save `a', replace
}

use R, clear
merge 1:1 row col using G
drop _m
merge 1:1 row col using B
drop _m

unite R G B, gen(RGB) sep(" ")
drop R G B
unique RGB

*> Number of unique values of RGB is 354
*> Number of records is 187500

这里我其实又把图片压缩了些,要不然实在是太慢了。

可以看到虽然round(0.1),但是仍然还有 354 种颜色(意味着绘图的时候会有 354 个图层,所以绘制颜色不那么丰富的照片其实会更快些):

replace row = -row
local cmd = "tw"

qui levelsof RGB, local(RGB)
foreach vn in `RGB' {
local cmd = `"`cmd' (sc row col if RGB == "`vn'", msize(vtiny) mc("`vn'"))"'
}

di `"`cmd'"'

`cmd', ytitle("") ///
xtitle("") ///
ylabel("") ///
xlabel("") ///
legend(off) ///
aspect(${aspectratio}) ///
scheme(s1color)
图表

这个时候我们就得到了一个彩色的风景照了(这里我为了让图片绘制的更快,大大压缩了图片,所以看起来像素感很强)!

是不是非常神奇!

实际应用

那么下面就是把这个神奇的技能投入到实际应用中了!

  • 应用1: 如果你有个使用 Stata 的女(男)朋友,用 Stata 给她(他)绘制一幅肖像图,对他来说一定是个惊喜!
  • 应用2: 给图表添加背景。

在 Stata 中完成一切

上面的代码中我们使用了 R 语言,这就很不方便了,那么我们能不能在 Stata 中完成整个过程呢?

借助 rcall 命令我们可以在 Stata 中运行 R 语言的代码,运行下面的代码安装 rcall(附件中有安装包):

net install rcall.pkg, from("rcall.pkg 所在的文件夹路径") replace
net install github.pkg, from("github.pkg 所在的文件夹路径") replace

rcall 命令会自动搜寻 R 软件的位置,所以大多数时候并不需要设置 R 的路径,如果 rcall 找不到(使用 rcall 的时候会提示,当然你得先确保你安装了 R 软件):

rcall setpath "/usr/local/bin/R"

注意这里的 “/usr/local/bin/R” 要替换成你自己电脑上的 R 运行路径,如果是 Mac 电脑,可以打开终端(电脑上的一个软件),运行 which R 查看该路径,如果是 Windows 电脑,该路径是 R 安装目录文件夹里面的 exe 文件的完整路径,类似 “C:/Program Files/R/R-3.5.3/R.exe”

然后在 Stata 中运行下面的代码即可(这几行要全选一起运行):

rcall: ///
df <- jpeg::readJPEG("e25fdaa8658c1dc23a5fdf9f22b011a2.jpeg"); ///
for (v in 1:3) { ///
df[1:dim(df)[1], 1:dim(df)[2], v] %>% ///
as_tibble() %>% ///
readr::write_csv(paste0("photo", v, ".csv")) ///
}

然后我们就得到了 photo1.csv,photo2.csv,photo3.csv 三个文件,绘图方法和上面讲的一样。

编写一个 Stata 命令自动绘制图片:

把下面的代码保存为 plotphoto.ado 文件(记得文件的结尾留个空行):

*! 使用 Stata 绘制图片
*! 微信公众号 RStata
*! 2022 年 3 月 3 日
capture program drop plotphoto
program define plotphoto, rclass
syntax anything(name = img) [, Plot]
di "处理图片中......"
qui{
if index("`img'", "jpg") | index("`img'", "jpeg") | index("`img'", "JPG") | index("`img'", "JPEG") {
rcall: ///
df <- jpeg::readJPEG("`img'"); ///
for (v in 1:3) { ///
df[1:dim(df)[1], 1:dim(df)[2], v] %>% ///
as_tibble() %>% ///
readr::write_csv(paste0("photo", v, ".csv")) ///
}
}
if index("`img'", "png") | index("`img'", "PNG") {
rcall: ///
df <- png::readPNG("`img'"); ///
for (v in 1:3) { ///
df[1:dim(df)[1], 1:dim(df)[2], v] %>% ///
as_tibble() %>% ///
readr::write_csv(paste0("photo", v, ".csv")) ///
}
}

local RGBlist = "R G B"
forval i = 1/3{
import delimited photo`i'.csv, clear
local nrow = r(N)
ret local nrow = `nrow'
local ncol = r(k)
ret local ncol = `ncol'
local aspectratio = `nrow' / `ncol'
ret local aspectratio = `aspectratio'
gen row = _n
gather v*
ren variable col
replace col = subinstr(col, "v", "", .)
destring col, replace
replace value = round(v, 0.1)
local a: word `i' of `RGBlist'
ren value `a'
replace `a' = int(`a' * 255)
save `a', replace
}

use R, clear
merge 1:1 row col using G
drop _m
merge 1:1 row col using B
drop _m
unite R G B, gen(RGB) sep(" ")
drop R G B
replace row = -row
}
if "`plot'" != "" {
di "绘图中......"
qui {
local cmd = "tw"

qui levelsof RGB, local(RGB)
foreach vn in `RGB' {
local cmd = `"`cmd' (sc row col if RGB == "`vn'", msize(vtiny) mc("`vn'"))"'
}
di `"`cmd'"'

`cmd', ytitle("") ///
xtitle("") ///
ylabel("") ///
xlabel("") ///
legend(off) ///
aspect(`aspectratio') ///
scheme(s1color)
}
}
* 删除无用的文件
cap qui {
erase photo1.csv
erase photo2.csv
erase photo3.csv
erase R.dta
erase G.dta
erase B.dta
}
end

这个命令的使用很简单:

* 图片转数据(不绘图)
plotphoto e25fdaa8658c1dc23a5fdf9f22b011a2.jpeg
* 图片转数据(绘图)
plotphoto e25fdaa8658c1dc23a5fdf9f22b011a2.jpeg, p

由于冰墩墩的色彩很丰富,上面的代码可能需要运行一整夜,大家绘图的时候可以选择不要太彩色的图:

图表

为图表添加背景

例如我想绘制一幅冬奥会的奖牌榜,然后使用冰墩墩作为背景:

首先爬取冬奥会奖牌榜数据:

clear
copy "https://tiyu.baidu.com/beijing2022/home/tab/%E5%A5%96%E7%89%8C%E6%A6%9C/from/pc" temp.html, replace
infix strL v 1-10000 using temp.html, clear
keep if index(v, "national-box")
replace v = subinstr(v, " ", "", .)
split v, parse("><")
keep v6 v9 v10 v11 v12
foreach i of varlist _all {
replace `i' = ustrregexs(1) if ustrregexm(`i', ">(.*)<")
}
compress
destring _all, replace
ren v6 国家
ren v9 金牌
ren v10 银牌
ren v11 铜牌
ren v12 总计
keep in 1/10
sencode 国家, gsort(-金牌) replace
save jiangpai, replace
图表

然后可以绘制一幅图展示:

* 绘制堆叠柱状图
replace 银牌 = 银牌 + 铜牌
replace 金牌 = 银牌 + 金牌

tw ///
bar 铜牌 国家, barwidth(0.7) color("239 199 16") || ///
rbar 银牌 铜牌 国家, barwidth(0.7) color("190 190 190") || ///
rbar 金牌 银牌 国家, barwidth(0.7) color("222 174 121") ///
xla(1(1)10, value ang(45)) xti("") yti("奖牌数") ///
leg(row(1) pos(11) ring(0) order(1 "金牌" 2 "银牌" 3 "铜牌")) ///
yla(0(3)18) ///
ti("2022 年北京冬奥会获得金牌前十名的代表团奖牌数") ///
subti("绘制:微信公众号 RStata") ///
caption("数据来源:百度体育" "<https://tiyu.baidu.com/beijing2022/home/tab/%E5%A5%96%E7%89%8C%E6%A6%9C/from/pc>")
图表

然后我们再在这个图上添加一个冰墩墩。

首先确定下位置(使用 PPT):

图表

然后把这个图片转换成绘图数据:

plotphoto 冰墩墩.png
save bingdundun, replace

然后就可以把奖牌数据和冰墩墩数据合并起来绘图了:

use bingdundun, clear
sum row

* 把 row 的范围调整到 0 - 18
replace row = (row + 628) / (628 / 18)
sum row

sum col

* 把 col 的范围调整到 1 - 10
replace col = ((col - 1) / (1377 / 9)) + 1
sum col

* 合并两个数据
ren col 国家
gen pic = 1
append using jiangpai
replace pic = 0 if missing(pic)

local cmd = "tw"

qui levelsof RGB, local(RGB)
foreach vn in `RGB' {
local cmd = `"`cmd' (sc row 国家 if RGB == "`vn'" & pic == 1, msize(vtiny) mc("`vn'"))"'
}

di `"`cmd'"'

`cmd' || ///
bar 铜牌 国家 if pic == 0, barwidth(0.7) color("239 199 16") || ///
rbar 银牌 铜牌 国家 if pic == 0, barwidth(0.7) color("190 190 190") || ///
rbar 金牌 银牌 国家 if pic == 0, barwidth(0.7) color("222 174 121") ///
xla(1 "挪威" 2 "德国" 3 "中国" ///
4 "瑞典" 5 "美国" 6 "荷兰" ///
7 "奥地利" 8 "瑞士" ///
9 "俄罗斯奥委会" 10 "法国", ///
value ang(45)) ///
xti("") yti("奖牌数") ///
leg(row(1) pos(11) ring(0) order(198 "金牌" 199 "银牌" 200 "铜牌")) ///
yla(0(3)18) ///
ti("2022 年北京冬奥会获得金牌前十名的代表团奖牌数") ///
subti("绘制:微信公众号 RStata") ///
caption("数据来源:百度体育" "<https://tiyu.baidu.com/beijing2022/home/tab/%E5%A5%96%E7%89%8C%E6%A6%9C/from/pc>")
图表

是不是很有意思!就是太费时间了!

点击这里跳转到 RStata 短书平台获取附件:如何使用 Stata 绘制一幅彩色的照片?给你的图表添加一个冰墩墩!

评论