R_Language 板


LINE

criky 版友想要的结果: id year s 1 100 1 1 100 2 1 101 1 1 101 2 1 102 1 1 102 2 2 101 2 2 102 1 2 102 2 2 103 1 3 101 2 总共有 11 笔资料 celestialgod 版友的结果: # id year s # 1: 1 100 1 # 2: 1 100 2 # 3: 1 102 1 # 4: 1 102 2 # 5: 2 101 1 # 6: 2 101 2 # 7: 2 103 1 # 8: 2 103 2 # 9: 3 101 2 总共有 9 笔资料 帐面上看起来少了2笔资料, 实际上是少了 4 笔 1 101 1 1 101 2 2 102 1 2 102 2 却多了 2 笔 # 5: 2 101 1 # 8: 2 103 2 在这提供我的写法: library("data.table") criky = data.table( id = c(1, 2, 3), start_y = c(100, 101, 101), start_s = c(1, 2, 2), end_y = c(102, 103, 101), end_s = c(2, 1, 2) ) id_year_semester = function( id, from, to ){ x = seq(from = from, to = to, by = 0.5) size_x = length(x) data.table( id = rep(id, size_x), year = x %/% 1, s = (x %% 1) * 2 + 1 ) } criky[ , list( id = id, from = start_y + (start_s - 1) * 0.5, to = end_y + (end_s - 1) * 0.5 ) ][ , id_year_semester(id, from, to), by = list(id, from, to) ][ , list(id, year, s) ] 执行结果: id year s 1: 1 100 1 2: 1 100 2 3: 1 101 1 4: 1 101 2 5: 1 102 1 6: 1 102 2 7: 2 101 2 8: 2 102 1 9: 2 102 2 10: 2 103 1 11: 3 101 2 ※ 引述《celestialgod (天)》之铭言: : ※ 引述《criky (立业成家)》之铭言: : : [问题类型]: : : 程式谘询(我想用R 做某件事情,但是我不知道要怎麽用R 写出来) : : [软体熟悉度]: : : 新手(没写过程式,R 是我的第一次) : : [问题叙述]: : : 若我有资料栏位如下: : : id start_y start_s end_y end_s : : 1 100 1 102 2 : : 2 101 2 103 1 : : 3 101 2 101 2 : : year: : : 如何转成下面的样子: : : id year s : : 1 100 1 : : 1 100 2 : : 1 101 1 : : 1 101 2 : : 1 102 1 : : 1 102 2 : : 2 101 2 : : 2 102 1 : : 2 102 2 : : 2 103 1 : : 3 101 2 (只有一笔) : : 谢谢回答~ : : [程式范例]: : : [环境叙述]: : : 请提供 sessionInfo() 的输出结果, : : 里面含有所有你使用的作业系统、R 的版本和套件版本资讯, : : 让版友更容易找出错误 : : [关键字]: : : 选择性,也许未来有用 : 做两次melt就可以达到你要的了,我不确定是否可以一次,看是否有高手写得出来~~ : library(data.table) : DT <- fread("id start_y start_s end_y end_s : 1 100 1 102 2 : 2 101 2 103 1 : 3 101 2 101 2") : DT_melt <- melt.data.table(DT, id = c(1,2,4), value.name = "s") : DT_melt2 <- melt.data.table(DT_melt, id = c(1,5), measure = 2:3, : value.name = "year") : DT_melt2[ , variable := NULL] : setcolorder(DT_melt2, c("id", "year", "s")) : setorderv(DT_melt2, names(DT_melt2)) : unique(DT_melt2, by = names(DT_melt2)) : # id year s : # 1: 1 100 1 : # 2: 1 100 2 : # 3: 1 102 1 : # 4: 1 102 2 : # 5: 2 101 1 : # 6: 2 101 2 : # 7: 2 103 1 : # 8: 2 103 2 : # 9: 3 101 2 : # with pipeR : library(pipeR) : resDT <- melt.data.table(DT, id = c(1,2,4), value.name = "s") %>>% : melt.data.table(id = c(1,5), measure = 2:3, value.name = "year") %>>% : `[`(j = variable := NULL) %>>% setcolorder(c("id", "year", "s")) %>>% : setorderv(names(.)) %>>% unique(by = names(.)) : print(resDT) : # id year s : # 1: 1 100 1 : # 2: 1 100 2 : # 3: 1 102 1 : # 4: 1 102 2 : # 5: 2 101 1 : # 6: 2 101 2 : # 7: 2 103 1 : # 8: 2 103 2 : # 9: 3 101 2 : # tidyr + dplyr解法 (data.table不需要,DT可以是data.frame) : library(dplyr) : library(tidyr) : gather(DT, value, year, -id, -start_s, -end_s) %>>% : gather(ss, s, -id, -value, -year) %>>% select(id, year, s) %>>% : arrange(id, year, s) %>>% distinct(id, year, s) : # id year s : # 1 1 100 1 : # 2 1 100 2 : # 3 1 102 1 : # 4 1 102 2 : # 5 2 101 1 : # 6 2 101 2 : # 7 2 103 1 : # 8 2 103 2 : # 9 3 101 2 --



※ 发信站: 批踢踢实业坊(ptt.cc), 来自: 180.176.58.20
※ 文章网址: https://webptt.com/cn.aspx?n=bbs/R_Language/M.1480605469.A.E29.html
1F:→ celestialgod: XD 看错问题了 等等再补解法 12/01 23:32
2F:推 criky: 谢谢英雄哥,id被拿来作文章感觉怪怪的 XD 12/01 23:38







like.gif 您可能会有兴趣的文章
icon.png[问题/行为] 猫晚上进房间会不会有憋尿问题
icon.pngRe: [闲聊] 选了错误的女孩成为魔法少女 XDDDDDDDDDD
icon.png[正妹] 瑞典 一张
icon.png[心得] EMS高领长版毛衣.墨小楼MC1002
icon.png[分享] 丹龙隔热纸GE55+33+22
icon.png[问题] 清洗洗衣机
icon.png[寻物] 窗台下的空间
icon.png[闲聊] 双极の女神1 木魔爵
icon.png[售车] 新竹 1997 march 1297cc 白色 四门
icon.png[讨论] 能从照片感受到摄影者心情吗
icon.png[狂贺] 贺贺贺贺 贺!岛村卯月!总选举NO.1
icon.png[难过] 羡慕白皮肤的女生
icon.png阅读文章
icon.png[黑特]
icon.png[问题] SBK S1安装於安全帽位置
icon.png[分享] 旧woo100绝版开箱!!
icon.pngRe: [无言] 关於小包卫生纸
icon.png[开箱] E5-2683V3 RX480Strix 快睿C1 简单测试
icon.png[心得] 苍の海贼龙 地狱 执行者16PT
icon.png[售车] 1999年Virage iO 1.8EXi
icon.png[心得] 挑战33 LV10 狮子座pt solo
icon.png[闲聊] 手把手教你不被桶之新手主购教学
icon.png[分享] Civic Type R 量产版官方照无预警流出
icon.png[售车] Golf 4 2.0 银色 自排
icon.png[出售] Graco提篮汽座(有底座)2000元诚可议
icon.png[问题] 请问补牙材质掉了还能再补吗?(台中半年内
icon.png[问题] 44th 单曲 生写竟然都给重复的啊啊!
icon.png[心得] 华南红卡/icash 核卡
icon.png[问题] 拔牙矫正这样正常吗
icon.png[赠送] 老莫高业 初业 102年版
icon.png[情报] 三大行动支付 本季掀战火
icon.png[宝宝] 博客来Amos水蜡笔5/1特价五折
icon.pngRe: [心得] 新鲜人一些面试分享
icon.png[心得] 苍の海贼龙 地狱 麒麟25PT
icon.pngRe: [闲聊] (君の名は。雷慎入) 君名二创漫画翻译
icon.pngRe: [闲聊] OGN中场影片:失踪人口局 (英文字幕)
icon.png[问题] 台湾大哥大4G讯号差
icon.png[出售] [全国]全新千寻侘草LED灯, 水草

请输入看板名称,例如:BuyTogether站内搜寻

TOP