msyds/gf-rgl
1
0 Fork 0
forked from GitHub/gf-rgl
Code Pull Requests Activity

script PrepVerb.hs to create rules for prepositional and particle verbs ; modified MergeDict.hs to add them only in cases where the old dict does not have them

Browse Source
This commit is contained in:
aarne committed 2014-12-07 11:53:58 +00:00
1 parent fb5d28e88c
commit 7d75c1373f
2 files changed
+103 -19
Download Patch File Download Diff File Expand all files Collapse all files

No files matched your search

src/translator/MergeDict.hs
+32 -19
View File
@@ -20,9 +20,22 @@ Comments can be added at the merging phase.
Other lines than 'lin' rules are taken from "old". The rules in the resulting grammar are sorted alphabetically.
The boolean argument is set False if you do not want to add new rules to already existing old ones:
lin f = t1 | ... | tm ; -- comment1
lin f = u1 | ... | un ; -- comment2
where m > 0, results in
lin f = t1 | ... | tm ; -- comment1
Usage:
mergeDict "DictionaryChi.gf" "../chinese/hsk/csv/hsku.gf" (Just "HSK") "tmp/DictionaryChi.gf"
mergeDict <OldFile> <NewFile> Bool (Maybe separator) <TargetFile>
Example:
mergeDict "DictionaryChi.gf" "../chinese/hsk/csv/hsku.gf" True (Just "HSK") "tmp/DictionaryChi.gf"
-}
@@ -30,8 +43,8 @@ Usage:
import Data.List
mergeDict :: FilePath -> FilePath -> Maybe String -> FilePath -> IO ()
mergeDict old new comm file = do
mergeDict :: FilePath -> FilePath -> Bool -> Maybe String -> FilePath -> IO ()
mergeDict old new ifAdd comm file = do
olds1 <- readFile old >>= return . lines
news1 <- readFile new >>= return . lines
let (preamble,olds2) = break ((== ["lin"]) . take 1 . words) olds1
@@ -39,7 +52,7 @@ mergeDict old new comm file = do
let news = [mkRule 1 (w:ws) | w:ws <- map words news1, w == "lin"]
let lins = sort $ olds ++ news
let linss = groupBy (\x y -> (fun x) == (fun y)) lins
let lins2 = map (mergeRule comm) linss
let lins2 = map (mergeRule ifAdd comm) linss
writeFile file $ unlines preamble
appendFile file $ unlines $ map prRule lins2
appendFile file "}"
@@ -58,31 +71,31 @@ mkRule i ws = case ws of
getVariants ws = case break (=="|") ws of
(e,vs) | isEmpty e -> getVariants vs
(v,_:vs) -> v : getVariants vs
([],_) -> []
(v,_) -> [v]
isEmpty v = elem v [["variants{}"],["variants","{}"]]
isEmpty v = elem v [["variants{}"],["variants","{}"],["variants{};"],["variants","{};"]]
isComment = (=="--") . take 2
mergeRule :: Maybe String -> [Rule] -> Rule
mergeRule mco rs = case rs of
mergeRule :: Bool -> Maybe String -> [Rule] -> Rule
mergeRule ifAdd mco rs = case rs of
[r] -> r
[old,new] -> R (fun old) 0 (mergeLin (lins old) (lins new)) (comment old ++ comment new)
_ -> error $ show rs
where
mergeLin old new = olds ++ case filter (flip notElem old) new of
l:ls -> case mco of
Just co -> (("{-"++co++"-}"):l):ls
_ -> l:ls
_ -> []
where
olds = case old of
---- [[]] -> [["variants","{}"]]
[old,new]
| ifAdd == False && not (null (lins old)) -> old -- old has something: just keep it
| null (lins old) && null (lins new) -> old -- both are empty: just keep old
| null (lins old) -> new -- old is empty: just keep new
| otherwise -> case filter (flip notElem (lins old)) (lins new) of
l:ls -> case mco of
Just co -> R (fun old) 0 (lins old ++ (("{-"++co++"-}"):l):ls) (comment new ++ comment old)
_ -> R (fun old) 0 (lins old ++ l:ls) (comment new ++ comment old)
_ -> old
_ -> error $ "cannot handle more than two rule sources: " ++ show rs
prRule :: Rule -> String
prRule ru = unwords $ "lin" : fun ru : "=" : variants ru ++ [";"] ++ comment ru
variants :: Rule -> [String]
variants ru = case lins ru of
[[]] -> ["variants","{}"]
[] -> ["variants","{}"]
ls -> intersperse "|" (map unwords (filter (not . null) ls))
src/translator/PrepVerb.hs
+71
View File
@@ -0,0 +1,71 @@
import qualified Data.Set
import qualified Data.Map as M
main = do
let parts w = words (map (\c -> if c =='_' then ' ' else c) w)
lfuns <- readFile "Dictionary.gf" >>= return . lines
let funs = [f | "fun":f:_ <- map words lfuns]
let pverbs = [v | v <- funs, let vs = parts v, length vs > 2, head (last vs) == 'V']
let funset = Data.Set.fromList funs
let hasCatt f c = case Data.Set.member (f ++ "_" ++ c) funset of
True -> (True,"_")
_ -> case Data.Set.member (f ++ "_1_" ++ c) funset of
True -> (True,"_1_")
_ -> (False,"_") ---- why _ needed
let hasCat f c = fst (hasCatt f c)
let mkFun f c = f ++ snd (hasCatt f c) ++ c
let linPVerb v = case parts v of
[w,p,"V"] | hasCat p "Adv" && hasCat w "V" -> advV (w ++ "_V " ++ mkFun p "Adv")
[w,p,"V"] | hasCat p "Adv" && hasCat w "V2" -> advV (v2V w ++ mkFun p "Adv")
[w,p,"V2"] | hasCat p "Prep" && hasCat w "V" -> "prepV2 " ++ w ++ "_V " ++ mkFun p "Prep"
[w,p,"V2"] | hasCat p "Adv" && hasCat w "V" -> "mkV2 (" ++ advV (w ++ "_V " ++ mkFun p "Adv") ++ " )"
[w,p,"V2"] | hasCat p "Prep" && hasCat w "V2" -> "prepV2 " ++ v2V w ++ mkFun p "Prep"
[w,p,"V2"] | hasCat p "Adv" && hasCat w "V2" -> "mkV2 (" ++ advV (v2V w ++ mkFun p "Adv") ++ " )"
[w,p,q,"V2"] | hasCat p "Adv" && hasCat q "Prep" && hasCat w "V" -> "prepV2 (" ++ advV (w ++ "_V " ++ mkFun p "Adv") ++" ) " ++ mkFun q "Prep"
[w,p,q,"V2"] | hasCat p "Adv" && hasCat q "Prep" && hasCat w "V2" -> "prepV2 (" ++ advV (v2V w ++ mkFun p "Adv") ++ " ) " ++ mkFun q "Prep"
_ -> "variants {}"
writeFile "PrepVerbs.gf" $ unlines ["lin " ++ p ++ " = " ++ linPVerb p ++ " ; -- guess-p-verb" | p <- pverbs]
advV s = "advV " ++ s
v2V v = "(lin V " ++ v ++ "_V2) "
getPrepsAdvs lang = do
rs <- readFile ("Dictionary" ++ lang ++ ".gf") >>= return . lines
let dict = M.fromList [(f,unwords r) | "lin":f:"=":r <- map words rs]
let look x = maybe ("","variants {} ;") (\r -> ("--DD ",r)) (M.lookup x dict)
let preps = [(p, "Prep", look p) | p <- allPreps]
let advs = [(p, "Adv", look p) | p <- allAdvs]
let verbs = [(p, "V", look p) | p <- allVs]
let verb2 = [(p, "V2", look p) | p <- allV2s]
let rules = [s ++ "oper " ++ p ++ " : " ++ c ++ " = " ++ r | (p,c,(s,r)) <- preps ++ advs ++ verbs ++ verb2]
let preamble = [
"concrete PrepVerbs" ++ lang ++ " of Dictionary = Cat" ++ lang ++ " ** ",
" open Paradigms" ++ lang ++ ", (S = Syntax" ++ lang ++ "), Dictionary" ++ lang ++ " in {",
"",
"oper prepV2 : V -> Prep -> V2 = \\v,p -> mkV2 v p ;",
"oper advV : V -> Adv -> V = \\v,a -> mkV v a.s ;",
""
]
let outFile = "PrepVerbs" ++ lang ++ ".gf"
writeFile outFile $ unlines preamble
appendFile outFile $ unlines rules
appendFile outFile $ "\n"
lins <- readFile "PrepVerbs.gf"
appendFile outFile lins
appendFile outFile $ "\n}"
allPreps = ["by_Prep","for_Prep","on_Prep","out_Prep","upon_Prep","up_Prep","to_Prep","with_Prep","at_Prep","of_Prep","down_Prep","about_Prep","after_Prep","around_Prep","in_Prep","over_Prep","round_Prep","off_Prep","into_Prep","under_Prep","through_Prep","along_Prep","across_Prep","before_Prep","from_Prep","against_Prep","among_Prep","towards_Prep","as_Prep","onto_Prep","above_Prep","behind_Prep","past_Prep","without_Prep","toward_Prep"]
allAdvs = ["up_Adv","in_1_Adv","on_Adv","back_Adv","around_Adv","away_1_Adv","down_Adv","off_Adv","out_Adv","about_Adv","over_Adv","apart_Adv","along_Adv","forth_Adv","forward_Adv","aside_Adv","under_Adv","round_Adv","together_Adv","across_Adv","by_Adv","through_Adv","to_Adv","even_Adv","clean_Adv","behind_Adv","ahead_Adv","way_Adv","before_Adv","below_Adv","for_Adv","open_Adv","after_Adv","clear_Adv"]
allV2s = ["allow_V2","auction_V2","bash_V2","bed_V2","belt_V2","black_V2","block_V2","blot_V2","blurt_V2","board_V2","bone_V2","book_V2","boot_V2","boss_V2","botch_V2","bottle_V2","brick_V2","bring_V2","buff_V2","bug_V2","butter_V2","cap_V2","cart_V2","catch_V2","chalk_V2","choose_V2","chuck_V2","claw_V2","cobble_V2","cock_V2","coop_V2","cop_V2","cover_V2","crack_V2","crank_V2","cream_V2","deck_V2","dish_V2","dole_V2","dust_V2","egg_V2","eke_V2","even_V2","explain_V2","eye_V2","fathom_V2","fell_V2","fence_V2","fiddle_V2","flick_V2","flog_V2","fluff_V2","fob_V2","fool_V2","free_V2","frighten_V2","fritter_V2","get_V2","gin_V2","ginger_V2","gloss_V2","glue_V2","gun_V2","hand_V2","hash_V2","hate_V2","hone_V2","hose_V2","hound_V2","invite_V2","jack_V2","jazz_V2","jot_V2","key_V2","kiss_V2","loan_V2","log_V2","lug_V2","lure_V2","man_V2","map_V2","mark_V2","mash_V2","match_V2","mete_V2","mug_V2","mull_V2","nail_V2","net_V2","offer_V2","own_V2","palm_V2","paper_V2","parcel_V2","pare_V2","patch_V2","pencil_V2","pep_V2","phase_V2","pin_V2","pit_V2","plant_V2","plate_V2","pop_V2","power_V2","prop_V2","put_V2","queer_V2","rack_V2","ramp_V2","rein_V2","rope_V2","rough_V2","salt_V2","seek_V2","set_V2","sex_V2","shore_V2","shrug_V2","shut_V2","single_V2","size_V2","smuggle_V2","snaffle_V2","spirit_V2","stack_V2","staff_V2","stash_V2","stock_V2","stow_V2","stub_V2","stuck_V2","stuff_V2","summon_V2","suss_V2","take_V2","tide_V2","time_V2","tool_V2","top_V2","tow_V2","twist_V2","urge_V2","usher_V2","vacuum_V2","wall_V2","ward_V2","wean_V2","whack_V2","while_V2","winkle_V2","word_V2","wound_V2","yank_V2","yield_V2","zip_V2","zone_V2"]
allVs = ["abide_V","account_V","ache_V","act_V","add_V","agree_V","aim_V","angle_V","answer_V","apply_V","argue_V","ask_V","back_V","bag_V","bail_V","ball_V","bang_V","bank_V","bargain_V","barge_V","bat_V","bawl_V","bear_V","beat_V","beaver_V","beef_V","bend_V","bid_V","bitch_V","blare_V","blast_V","blaze_V","bleed_V","blow_V","bog_V","boil_V","bolster_V","border_V","bottom_V","bounce_V","bowl_V","box_V","brace_V","branch_V","break_V","breeze_V","brighten_V","brush_V","bubble_V","buck_V","bucket_V","buckle_V","budge_V","build_V","bulk_V","bump_V","bundle_V","bunk_V","buoy_V","burn_V","burst_V","bust_V","butt_V","buy_V","buzz_V","call_V","calm_V","camp_V","cancel_V","care_V","carry_V","carve_V","cash_V","cast_V","cater_V","cave_V","chance_V","change_V","charge_V","chase_V","chat_V","cheat_V","check_V","cheer_V","chew_V","chill_V","chime_V","chip_V","choke_V","chop_V","churn_V","clam_V","clamp_V","clank_V","clean_V","clear_V","click_V","climb_V","cling_V","clog_V","close_V","cloud_V","clown_V","clutch_V","coast_V","colour_V","come_V","conjure_V","conk_V","continue_V","contract_V","cool_V","cost_V","cotton_V","cough_V","count_V","cram_V","crash_V","creep_V","crop_V","cross_V","cruise_V","cry_V","curl_V","cut_V","damp_V","dash_V","dawn_V","decide_V","die_V","dig_V","dine_V","dip_V","disagree_V","dive_V","divide_V","doss_V","double_V","doze_V","drag_V","draw_V","dream_V","dredge_V","dress_V","drift_V","drill_V","drink_V","drive_V","drone_V","drop_V","drown_V","drum_V","dry_V","duck_V","dump_V","dwell_V","ease_V","eat_V","ebb_V","edge_V","embark_V","empty_V","end_V","enter_V","face_V","fall_V","farm_V","fart_V","fasten_V","fatten_V","fawn_V","feed_V","feel_V","fend_V","ferret_V","fight_V","figure_V","file_V","fill_V","filter_V","find_V","finish_V","fire_V","firm_V","fish_V","fit_V","fix_V","fizzle_V","flag_V","flake_V","flame_V","flare_V","flip_V","flounce_V","flush_V","fly_V","focus_V","fold_V","follow_V","force_V","forge_V","fork_V","freak_V","freeze_V","freshen_V","front_V","frown_V","fuel_V","gad_V","gag_V","gain_V","gang_V","gear_V","ghost_V","give_V","gnaw_V","go_V","goof_V","grasp_V","grass_V","grey_V","grind_V","grow_V","hack_V","ham_V","hammer_V","hang_V","hanker_V","harp_V","haul_V","have_V","head_V","hear_V","heat_V","heave_V","help_V","hide_V","hinge_V","hit_V","hive_V","hold_V","hole_V","hook_V","hover_V","hunt_V","hush_V","inch_V","iron_V","issue_V","jabber_V","jam_V","jaw_V","jerk_V","jet_V","join_V","joke_V","jump_V","keel_V","keep_V","kick_V","kill_V","kip_V","knock_V","knuckle_V","land_V","lap_V","lark_V","lash_V","latch_V","laugh_V","lay_V","lead_V","leak_V","lean_V","leap_V","leave_V","level_V","lie_V","lift_V","light_V","lighten_V","limber_V","line_V","link_V","listen_V","live_V","load_V","lock_V","look_V","loosen_V","lose_V","lust_V","make_V","marry_V","measure_V","meet_V","melt_V","mess_V","mill_V","miss_V","mix_V","mock_V","monkey_V","mooch_V","mop_V","mope_V","mount_V","mouth_V","move_1_V","muddle_V","muscle_V","nag_V","narrow_V","nip_V","nod_V","nose_V","note_V","nut_V","occur_V","open_V","operate_V","opt_V","pack_V","pad_V","pair_V","pal_V","pan_V","part_V","pass_V","pat_V","pay_V","peck_V","peel_V","peg_V","perk_V","peter_V","pick_V","pig_V","pile_V","pine_V","pipe_V","pitch_V","play_1_V","plead_V","plot_V","plough_V","plow_V","pluck_V","plug_V","plump_V","plunge_V","point_V","poke_V","polish_V","pore_V","potter_V","pour_V","prattle_V","press_V","prey_V","price_V","print_V","pucker_V","pull_V","pump_V","push_V","quarrel_V","quiet_V","quieten_V","quit_V","race_V","rain_V","rake_V","ramble_V","rap_V","rat_V","rattle_V","reach_V","read_V","reason_V","reel_V","rely_V","rent_V","report_V","ride_V","ring_V","rip_V","roll_V","romp_V","room_V","root_V","round_V","row_V","rub_V","rule_V","run_V","rush_V","rustle_V","saddle_V","sag_V","sail_V","sally_V","save_V","saw_V","scale_V","scare_V","scoop_V","scout_V","scrape_V","scratch_V","screen_V","screw_V","see_V","seize_V","sell_V","send_V","settle_V","shack_V","shade_V","sidle_V","shake_V","shape_V","share_V","shave_V","shell_V","ship_V","shoot_V","shop_V","short_V","shout_V","shove_V","show_V","shy_V","side_V","sift_V","sign_V","silt_V","simmer_V","sing_V","sink_V","sit_V","skin_V","skip_V","slack_V","slacken_V","slant_V","sleep_V","slice_V","slip_V","slope_V","slough_V","slow_V","smack_V","smash_V","smoke_V","smooth_V","snap_V","snarl_V","sneak_V","sniff_V","snitch_V","snuff_V","soak_V","sober_V","soften_V","soldier_V","sort_V","sound_V","spark_V","speak_V","speed_V","spell_V","spew_V","spill_V","spin_V","spit_V","splash_V","split_V","spoil_V","sponge_V","spread_V","spring_V","sprout_V","spruce_V","spur_V","square_V","squeeze_V","stamp_V","stand_V","stare_V","start_V","stave_V","stay_V","steal_V","steer_V","stem_V","step_V","stick_V","stiffen_V","stir_V","stitch_V","stomp_V","stop_V","storm_V","straighten_V","stretch_V","strike_V","string_V","struggle_V","stumble_V","stump_V","suck_V","suit_V","sum_V","surge_V","swallow_V","swan_V","swear_V","sLine truncated