thainltk: Thai National Language Toolkit

#devtools::load_all('../ssgd')
library(tm)
library(Matrix)
library(parallel)
library(hash)



X <- readRDS('../data/train_f2_1_all_X.RDS')
y <- readRDS('../data/train_f2_1_all_y.RDS')
Xval <- readRDS('../data/val_f2_1_all_X.RDS')
yval <- readRDS('../data/val_f2_1_all_y.RDS')
Xtest <- readRDS('../data/test_f2_1_all_X.RDS')
ytest <- readRDS('../data/test_f2_1_all_y.RDS')

X <- cbind(X, Xval, Xtest)
y <- c(y, yval, ytest)
rm(Xtest, ytest, Xval, yval)
cl <- makeCluster(3)
prepareCl4Svm(cl, X, y)
rm(X, y)

#results <- clusterEvalQ(cl[1], partialLrCost(theta, data, labels))

parlr1 <- parSvm(cl, 0.1)
#C <- 1
#clusterExport(cl, 'C')
p <- runif(getNumFeatures() + 1, min = -0.7, max = 0.7)
gc()
sol <- optim(p, parlr1$cost, parlr1$grad, method = 'L-BFGS-B', control = list(trace=3, maxit=500))
saveRDS(sol, '../data/best_f2_1_all_svm_sol.RDS')

p <- sol$par

ts1 <- 'จะผ่านไฟเขียว? หรือจะติดไฟแดง? อยู่ที่ผลการลงมติของประชาชนทั่วประเทศ 47 ล้านคนนับจากวันนี้ไปยังมีเวลาลุ้นเสียวอีกเกือบ 4 เดือน“แม่ลูกจันทร์” กราบเรียนว่าหัวใจสำคัญของการลงประชามติร่างรัฐธรรมนูญ คือต้องเปิดโอกาสให้ทุกฝ่ายแสดงความคิดเห็นวิพากษ์วิจารณ์ข้อดีข้อเสียอย่างกว้างขวางและเท่าเทียมเพราะประชาชนทุกคนมี 1 สิทธิ 1 เสียงเท่ากันปัญหาคือประชามติครั้งนี้มันแปลกพิลึกกึกกือเพราะประชาชนต้องลงประชามติ 2 คำถาม 2 ประเด็นซึ่งขัดแย้งกันเองเต็มเปา!!1, ต้องลงมติเห็นชอบ? หรือไม่เห็นชอบ? ร่างรัฐธรรมนูญฉบับมีชัย (ทั้งฉบับ 279 มาตรา)2, ต้องลงมติเห็นชอบ? หรือไม่เห็นชอบ? คำถามพ่วงที่ให้เพิ่มอำนาจ ส.ว. ลากตั้ง 250 คน ร่วมลงมติเลือกนายกรัฐมนตรีคนใหม่(ซึ่งขัดหลักการสำคัญในร่างรัฐธรรมนูญฉบับมีชัย)'
ts1 <- 'พลทหารทรงธรรม หมุดหมัด และ พลทหารฉัตรภิศุทธิ์ ชุมพันธ์ ทหารเกณฑ์สังกัด ร.152 พัน 1 ค่ายพยัคฆ์ อ.บันนังสตา จ.ยะลา ที่ถูก “ทำโทษปรับปรุงวินัย” หรือ ภาษาทหาร เรียกว่า "ซ่อม" จนเสียชีวิตและได้รับบาดเจ็บ สร้างความตื่นตระหนก ระคนเศร้าใจ ให้กับคนในสังคมเป็นวงกว้าง พร้อมกับมีการตั้งคำถามตามมาว่า พลทหารทั้งสองนาย กระทำความผิดร้ายแรงเรื่องอะไร? จึงได้ถูกลงโทษอย่างรุนแรง จนถึงขั้นได้รับบาดเจ็บสาหัสและเสียชีวิตขนาดนี้'
ts1 <- 'จากที่เฟซบุ๊ก พงศ์สุข หิรัญพฤกษ์ ได้โพสข้อความ กรณีเกาะนาคาน้อย อำเภอถลาง จังหวัดภูเก็ต ป่าที่กำลังถูกทำลาย โดยกลุ่มคนแอบอ้างถือกรรมสิทธิ์ที่ดินบนเกาะ โดยข้อความในเฟซบุ๊ก ระบุว่า เกาะนาคาน้อยเป็นเกาะเล็กๆในจังหวัดภูเก็ต ครอบครัวไม่ได้เป็นเจ้าของทั้งเกาะ มีที่ดินอยู่เพียง 53 ไร่ตามที่ระบุไว้ในเอกสารสิทธิ์ นส.3ก. ประกอบไปด้วย ที่ดินหน้าหาดไปจนถึงบ้านพัก และสวนมะพร้าวหลังบ้าน (ซึ่งปัจจุบันปล่อยไว้ให้เป็นป่า) โดยที่ดินส่วนที่เหลืออีก ร้อยละ60ของเกาะเป็น "ป่าดิบชื้น" ที่สมบรูณ์ เป็นที่อยู่อาศัยของนกเงือก และไม่เคยถูกบุกรุกแต่อย่างใด'
ts1 <- 'ในข้อความ มันยกเลิกบัตร ATM ของผมไปแล้ว แล้วบอกให้ไปทำบัตรใหม่ฟรี ที่สาขาไหนก็ได้แต่ไปที่ธนาคารแล้ว มันไม่มีฟรีอย่างที่บอกใน SMS พร้อมคำอธิบายของพนักงานว่าบัตรของคุณพี่เป็นบัตรแบบธรรมดา ซึ่งไม่มีความปลอดภัยถ้าเอาไปใช้กับตู้ที่ติดเครื่อง สแคมเมอร์ เราจึงยกเลิกไป แล้วบัตรแบบนี้มันหมดไปแล้ว ถ้าจะทำใหม่ก็ต้องซื้อบัตรใหม่ (ซึ่งพ่วงประกันทุกอัน มี 600 - 1500 บาท) แถมมีโทรไปหาสาขานั้นสาขานี้ แล้วกลับมาบอกว่าที่ไหนๆบัตรแบบนี้ก็หมด หมดทั้งจังหวัดบอกตรงๆเสียความรู้สึกมากกับการกระทำแบบนี้ของ KTB เหมือนยกเลิกบัตรธรรมดาแล้วมาบังคับ ยัดเยียดให้ลูกค้าซื้อบัตรพ่วงประกันใหม่อีกรอบ ซึ่งผมมองว่าเป็นการเอาเปรียบกันเกินไปรึเปล่า ลองคิดทบทวนการกระทำแบบนี้ดูนะครับ KTB '
ts1 <- '"ปั่นสองน่องท่องป่าดึกดำบรรพ์ สานฝันยายจวน" เสาร์ที่.9เม.ย.59.หุบป่าตาด อ.ลานสัก จ.อุทัยธานี ยายคนนี้ชื่อ ยายจวน ที่พักอาศัยก็ยังไม่เหมือนบ้าน เก่าๆจะพังวันไหนก็ยังไม่รู้ กลุ่มนักปั่นจึงจัดปั่นขึ้นเพื่อ ปลูกบ้านสร้างที่อยู่อาศัยไห้กับ ยายจวน มีคนเคยกล่าวไว้ว่า : การพบเจอกันไม่ใช่เรื่องบังเอิญ เช่นการรวมตัวกันของนานานักปั่นจักรยานจากหลายชมรมในวันนี้ กับกิจกรรม "ปั่นสองน่อง ท่องป่าดึกดำบรรพ์ สานฝันให้ยายจวน"  นั่นเพราะทุกคนมี 2 สิ่งที่เหมือนกันคือ รู้สึกรักและรู้จักให้ เพราะ รักสุขภาพจึงรักการปั่นจักรยาน เพราะรู้จักแบ่งปันจึงสานฝันให้ยายจวนได้มีบ้านอยู่ "สุขทั้งผู้ให้และผู้รับ" คำว่าให้ไม่มีสิ้นสุด '
ts1 <- 'มอบสิ่งของให้แก่นางสาวไข่มุก'
ts1f <- createFeaturesV2(ts1)
ts1m <- features2Matrix(ts1f)
pred <- (as.vector(sol$par[-1] %*% ts1m + sol$par[[1]]) > 0)
splitByPos(ts1, which(pred == 1))


Xval <- readRDS('../data/val_f2_1_all_X.RDS')
yval <- readRDS('../data/val_f2_1_all_y.RDS')
pred <- (as.vector(sol$par[-1] %*% Xval + sol$par[[1]]) > 0)
(t <- table(pred, yval))
spr <- t[2,2]/sum(t[2,])
srec <- t[2,2]/sum(t[,2])
sf1s <- 2 * spr * srec /(spr + srec)
# cost @ 402 C = 0.01 val f1 0.9768 (p 0.9711, r 0.9827)
# cost @ 502 C = 0.1 val f1 0.9787 (p 0.9745, r 0.9829)
# cost @ ? C = 1, train f1 0.9727 (p 0.967, r 0.9787)
#                       val f1 0.9782 (p 0.9739, r 0.9825)
# cost @ ? C = 10, train f1 0.9744 (p 0.967, r 0.9821)
#                       val f1 0.9777 (p 0.9737, r 0.9817)
rm(Xval, yval, pred)
gc()

pred <- (as.vector(sol$par[-1] %*% X + sol$par[[1]]) > 0)
(t <- table(pred, y))
spr <- t[2,2]/sum(t[2,])
srec <- t[2,2]/sum(t[,2])
sf1s <- 2 * spr * srec /(spr + srec)

valCor <- readRDS('../data/bestval.RDS')
doc <- valCor[[1]]$content
ncharDoc <- nchar(doc)
fp <- (pred[1:ncharDoc] & (yval[1:ncharDoc] != 1))
fp <- which(fp)
strs <- lapply(fp, function (i) c(substr(doc, i - 5, i)[[1]],
                                  substr(doc, i+1, i + 5)[[1]]))
for (s in strs) cat(sprintf('%s\t%s\t\n', s[[1]], s[[2]]))

fn <- which(!pred[1:ncharDoc] & (yval[1:ncharDoc] == 1))
strs <- lapply(fn, function (i) c(substr(doc, i - 5, i)[[1]],
                                  substr(doc, i+1, i + 5)[[1]]))
for (s in strs) cat(sprintf('%s\t%s\t\n', s[[1]], s[[2]]))