Related
In below select_highest_bids function, is it better to use orddict:new() instead of list, something like below ?
OrderedBatches = lists:foldl(fun high_bid_filter/2, orddict:new(), Campaigns)
How can we change high_bid_filter to return orddict ?
select_highest_bids(Campaigns, BidRequest) ->
lists:map(fun({_, C}) -> C end,
lists:foldl(fun high_bid_filter/2, [], Campaigns),
high_bid_filter(Campaign = #campaign_response{bid = BR = #bid_response{ad_id = AdID, cpm_bid = Score}}, Campaigns) ->
case lists:keyfind(AdID, 1, Campaigns) of
false ->
[{AdID, Campaign}|Campaigns];
{AdID, _ = #campaign_response{bid = _ = #bid_response{cpm_bid = EB}}} when EB >= Score ->
Campaigns;
{AdID, _ = #campaign_response{bid = _ = #bid_response{cpm_bid = EB}}} when EB < Score ->
lists:keystore(AdID, 1, Campaigns, {AdID, Campaign})
end.
here is the folder function
high_bid_filter(Campaign = #campaign_response{bid = #bid_response{ad_id = AdID, cpm_bid = Score}}, Campaigns) ->
case orddict:take(AdID, Campaigns) of
{V, _} when V >= Score ->
% find value but higher than Offer
Campaigns;
{V, Dict} ->
% update higher value
orddict:store(AdID, Campaign, Dict);
error ->
%
orddict:store(AdID, Campaign, Campaigns)
end.
i hope it can help you
I'm trying to make the function which takes string and transforms it to boolean expression. For example:for input ((x10+~1)*x132) it should give times(plus(var 10,compl 1),var 132), but it gives times(plus(var #,compl #),var 132). Where do hashtags come from??
datatype boolexp = zero
| one
| plus of boolexp * boolexp
| times of boolexp * boolexp
| var of int
| compl of boolexp
exception InvalidInput
(* takes the first n elements *)
fun take (_, 0) = nil
| take (nil, _) = raise InvalidInput
| take (h::t, n) = if n < 0
then raise InvalidInput
else h::take(t, n-1)
(* drops the frist n elements *)
fun drop (xs, 0) = xs
| drop (nil, _) = raise InvalidInput
| drop (h::t,n) = if n < 0
then raise InvalidInput
else drop (t, n-1)
(* converts string to integer *)
fun charlist_to_int (nil) = raise InvalidInput
| charlist_to_int (xs) =
let fun helper_int_rev (nil) = 0
| helper_int_rev (h::t) = if h >= #"0" andalso h <= #"9"
then helper_int_rev t * 10 + (ord h - ord #"0")
else raise InvalidInput
in helper_int_rev (rev xs) end;
(* finds the operator and its position *)
fun searchfor_oper (nil,_,_) = raise InvalidInput
| searchfor_oper (#"("::t, np, pos) = searchfor_oper (t, np+1, pos+1)
| searchfor_oper (#")"::t, np, pos) = searchfor_oper(t, np-1, pos+1)
| searchfor_oper (#"+"::t, 0, pos) = (pos, #"+")
| searchfor_oper (#"*"::t, 0, pos) = (pos, #"*")
| searchfor_oper (h::t, np, pos) = searchfor_oper (t, np, pos+1)
fun beparse_helper (nil) = raise InvalidInput
| beparse_helper (h::t) =
if h = #"x" then if hd(t)= #"0" then raise InvalidInput
else var (charlist_to_int (t))
else if h = #"0" then if t = nil then zero else raise InvalidInput
else if h = #"1" then if t = nil then one else raise InvalidInput
else if h = #"~" then compl(beparse_helper(t))
else if h = #"(" then
let
val lst = if hd (rev t)= #")" then take(t, length(t)-1) else raise InvalidInput
val (pos, oper) = searchfor_oper (lst, 0, 1)
in
if oper = (#"+")
then plus(beparse_helper(take(lst,pos-1)), beparse_helper(drop(lst,pos)))
else if oper = (#"*")
then times(beparse_helper(take(lst,pos-1)),beparse_helper(drop(lst,pos)))
else raise InvalidInput
end
else raise InvalidInput;
fun beparse(s) = beparse_helper(explode(s));
(*TESTING*)
beparse ("((x10+~1)*x132)");
I don't think that it is SML per se so much as SML/NJ default REPL output. In the grand scheme of things the REPL is for development/debugging -- not the environment for the finished program to run it. Recursive data structures such as trees can give quickly give rise to values which are too big to conveniently print. The REPL truncates the output in a couple of ways. For lists it will print around a dozen elements and then use .... For things like trees it will print down a few levels and then use a # to indicate that you have reached the level where the truncation happens. If you find this inconvenient you can do one of two things:
1) The logical printing depth in SML/NJ can be altered by evaluating Control.Print.printDepth := 20; (or however much you want) in the REPL
2) Perhaps a little more principled but more work -- write a custom pretty-printer (say pprint) for your values and evaluate e.g. pprint v; in the REPL rather than just v;
Also, consider using pattern matching more:
fun beparse_helper [] = raise InvalidInput
| beparse_helper (#"x"::cs) = var (charlist_to_int cs)
| beparse_helper (#"0"::[]) = zero
| beparse_helper (#"1"::[]) = one
| beparse_helper (#"~"::cs) = compl (beparse_helper cs)
| beparse_helper (#"("::(cs as (_::_))) =
let val lst = if List.last cs = #")"
then take (cs, length cs - 1)
else raise InvalidInput
in case searchfor_oper (lst, 0, 1) of
(pos, #"+") => plus (beparse_helper (take (lst, pos-1)),
beparse_helper(drop (lst, pos)))
| (pos, #"*") => times (beparse_helper (take (lst, pos-1)),
beparse_helper(drop (lst, pos)))
end
| beparse_helper _ = raise InvalidInput
I've got the following macro :
Sub MacroClear()
Dim wbD As Workbook, _
wbC As Workbook, _
wsD As Worksheet, _
wsC As Worksheet, _
DicC() As Variant, _
Dic() As String, _
ValToReplace As String, _
IsInDic As Boolean
Set wbD = Workbooks.Open("D:\Users\me\Documents\macro\Dictionnary", ReadOnly:=True)
Set wbC = Workbooks("FileToTreat.xlsm")
Set wsD = wbD.Worksheets("Feuil1")
Set wsC = wbC.Worksheets("draft")
ReDim DicC(1, 0)
For i = 1 To wsD.Range("C" & wsD.Rows.Count).End(xlUp).Row
Dic = Split(wsD.Cells(i, 3), ";")
ValToReplace = Trim(wsD.Cells(i, 2))
For k = LBound(Dic) To UBound(Dic)
IsInDic = False
For l = LBound(DicC, 2) To UBound(DicC, 2)
If LCase(DicC(1, l)) <> Trim(LCase(Dic(k))) Then
'No match
Else
'Match
IsInDic = True
Exit For
End If
Next l
If IsInDic Then
'Don't add to DicC
Else
DicC(0, UBound(DicC, 2)) = Trim(Dic(k))
DicC(1, UBound(DicC, 2)) = ValToReplace
ReDim Preserve DicC(UBound(DicC, 1), UBound(DicC, 2) + 1)
End If
Next k
Next i
ReDim Preserve DicC(UBound(DicC, 1), UBound(DicC, 2) - 1)
wbD.Close
Erase Dic
For l = LBound(DicC, 2) To UBound(DicC, 2)
Cells.Replace What:="*" & Trim(DicC(0, l)) & "*", _
Replacement:=Trim(DicC(1, l)), _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
Next l
Erase DicC
Set wbD = Nothing
Set wbC = Nothing
Set wsD = Nothing
Set wsC = Nothing
End Sub
I'll try to explain : It takes from the dictionnary my "words to replace" (column C), all separated by a ";", and my "primary words" (column B).
image http://img11.hostingpics.net/pics/403257dictionnary.png
Then it searches in all the cells of my "file to treat" (via Cells.Replace), if it finds something in column C of my dictionnary, it replaces it with what's in column B.
But now that I've got "SCE" in my column C (For Sony Computer Entertainment, to be replaced by Sony in column B), even when SCE is in a word (for example : ascend), it replaces the word with Sony. I don't want to replace it if it's inside a word...
In Java, I'd have done it easily with p = Pattern.compile("[^a-zA-Z]"+keyword+"[^a-zA-Z]", Pattern.CASE_INSENSITIVE);
but I have no idea how to solve this problem in VBA. I tried some things but it didn't work, had errors etc. so I came back to the start.
So I changed few parameters in the replace method and proposed a loop for all your cells, you'll just have to set the right column (in second proposition : here B=2).
Parameters :
LookAt:=xlWhole 'To search for whole expression
SearchOrder:=xlByColumns 'Search in column
MatchCase:=True 'Will look for the expression with the same casing (not sure about this word...)
Try one of these :
For l = LBound(DicC, 2) To UBound(DicC, 2)
Cells.Replace What:="*" & Trim(DicC(0, l)) & "*", _
Replacement:=Trim(DicC(1, l)), _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
MatchCase:=True, _
SearchFormat:=False, _
ReplaceFormat:=False
Next l
Or with the loop on each cell :
For l = LBound(DicC, 2) To UBound(DicC, 2)
For k = 1 To wsC.Rows(wsC.Rows.Count).End(xlUp).Row
wsC.Cells(i, 2).Replace What:="*" & Trim(DicC(0, l)) & "*", _
Replacement:=Trim(DicC(1, l)), _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
MatchCase:=True, _
SearchFormat:=False, _
ReplaceFormat:=False
Next k
Next l
I'm trying to write lexer for an indentation-based grammar and I'm having trouble matching the indentation.
Here's my code:
{
module Lexer ( main ) where
import System.IO.Unsafe
}
%wrapper "monadUserState"
$whitespace = [\ \t\b]
$digit = 0-9 -- digits
$alpha = [A-Za-z]
$letter = [a-zA-Z] -- alphabetic characters
$ident = [$letter $digit _] -- identifier character
$indent = [\ \t]
#number = [$digit]+
#identifier = $alpha($alpha|_|$digit)*
error:-
#identifier { mkL LVarId }
\n $whitespace* \n { skip }
\n $whitespace* { setIndent }
$whitespace+ { skip }
{
data Lexeme = Lexeme AlexPosn LexemeClass (Maybe String)
instance Show Lexeme where
show (Lexeme _ LEOF _) = " Lexeme EOF"
show (Lexeme p cl mbs) = " Lexeme class=" ++ show cl ++ showap p ++ showst mbs
where
showap pp = " posn=" ++ showPosn pp
showst Nothing = ""
showst (Just s) = " string=" ++ show s
instance Eq Lexeme where
(Lexeme _ cls1 _) == (Lexeme _ cls2 _) = cls1 == cls2
showPosn :: AlexPosn -> String
showPosn (AlexPn _ line col) = show line ++ ':': show col
tokPosn :: Lexeme -> AlexPosn
tokPosn (Lexeme p _ _) = p
data LexemeClass
= LVarId
| LTIndent Int
| LTDedent Int
| LIndent
| LDedent
| LEOF
deriving (Show, Eq)
mkL :: LexemeClass -> AlexInput -> Int -> Alex Lexeme
mkL c (p, _, _, str) len = return (Lexeme p c (Just (take len str)))
data AlexUserState = AlexUserState { indent :: Int }
alexInitUserState :: AlexUserState
alexInitUserState = AlexUserState 0
type Action = AlexInput -> Int -> Alex Lexeme
getLexerIndentLevel :: Alex Int
getLexerIndentLevel = Alex $ \s#AlexState{alex_ust=ust} -> Right (s, indent ust)
setLexerIndentLevel :: Int -> Alex ()
setLexerIndentLevel i = Alex $ \s#AlexState{alex_ust=ust} -> Right (s{alex_ust=(AlexUserState i)}, ())
setIndent :: Action
setIndent input#(p, _, _, str) i = do
--let !x = unsafePerformIO $ putStrLn $ "|matched string: " ++ str ++ "|"
lastIndent <- getLexerIndentLevel
currIndent <- countIndent (drop 1 str) 0 -- first char is always \n
if (lastIndent < currIndent) then
do setLexerIndentLevel currIndent
mkL (LTIndent (currIndent - lastIndent)) input i
else if (lastIndent > currIndent) then
do setLexerIndentLevel currIndent
mkL (LTDedent (lastIndent - currIndent)) input i
else alexMonadScan
where
countIndent str total
| take 1 str == "\t" = do skip input 1
countIndent (drop 1 str) (total+1)
| take 4 str == " " = do skip input 4
countIndent (drop 4 str) (total+1)
| otherwise = return total
alexEOF :: Alex Lexeme
alexEOF = return (Lexeme undefined LEOF Nothing)
scanner :: String -> Either String [Lexeme]
scanner str =
let loop = do
tok#(Lexeme _ cl _) <- alexMonadScan
if (cl == LEOF)
then return [tok]
else do toks <- loop
return (tok:toks)
in runAlex str loop
addIndentations :: [Lexeme] -> [Lexeme]
addIndentations (lex#(Lexeme pos (LTIndent c) _):ls) =
concat [iter lex c, addIndentations ls]
where iter lex c = if c == 0 then []
else (Lexeme pos LIndent Nothing):(iter lex (c-1))
addIndentations (lex#(Lexeme pos (LTDedent c) _):ls) =
concat [iter lex c, addIndentations ls]
where iter lex c = if c == 0 then []
else (Lexeme pos LDedent Nothing):(iter lex (c-1))
addIndentations (l:ls) = l:(addIndentations ls)
addIndentations [] = []
main = do
s <- getContents
return ()
print $ fmap addIndentations (scanner s)
}
Problem is that in line \n $whitespace* { setIndent }, regex matches wrong string and calls setIndent with this wrong string. For debugging purposes, I added unsafePerformIO in setIndent function, here's an example run of the program:
begin
first indent
|matched string:
first indent
second indent
second indent
dedent
dedent
|
|matched string:
second indent
dedent
|
|matched string:
dedent
|
|matched string:
|
Right [ Lexeme class=LVarId posn=1:1 string="begin", Lexeme class=LIndent posn=1:6, Lexeme class=LVarId posn=2:15 string="indent", Lexeme class=LIndent posn=2:21, Lexeme class=LDedent posn=3:30, Lexeme class=LDedent posn=3:30, Lexeme class=LVarId posn=4:1 string="dedent", Lexeme EOF]
So setIndent is called with more than just whitespaces. And after it returns the lexeme for indentation, other part of the string is omitted.
Is this a bug in Alex? Or what am I doing wrong?
So I haven't analysed your code in detail, but I did notice this:
setIndent :: Action
setIndent input#(p, _, _, str) i = do
--let !x = unsafePerformIO $ putStrLn $ "|matched string: " ++ str ++ "|"
Note that str is the rest of the input, not just the current token. To get the current token, you want take i str. Perhaps this is giving you the impression that the token is matching more of the input than it really is.
We handle indentation in GHC's own lexer of course, so you might want to look there for ideas (although as you might expect it's rather large and complicated).
I am new to F#, about two months, and I recently finished the FParsec tutorial and started looking for more examples. The more I read the more confused I became, and then I started to see references to styles. I looked for more styles and came up with this list.
Combinator style
Monadic style
Arrow style
Direct style
Can someone list all of the styles and explain and demonstrate how each one works with a common problem, e.g. parse
“(abc
(b CDEF
(de 1 E)
(f 234)
)
(h 3)
(jkl H)
)”
into
[Lower "abc";
Group[Lower "b"; Upper "CDEF";
Group [Lower "de"; Number "1"; Upper "E"];
Group [Lower "f"; Number "234"]];
Group [Lower "h"; Number "3"];
Group [Lower "jkl"; Upper "H"]
]
Using
Type out =
| Lower of string
| Upper of string
| Number of string
| Group of out list
EDIT
I picked up combinator and monadic style from a comment in FParsec and a delimiter based syntax
Direct style is always appearing as Direct Style Monadic Parser
Arrow style appears in Parsec: Direct Style Monadic Parser Combinators For The Real World I haven’t read all of this.
EDIT
Per suggestion
Combinator style
type out =
| Lower of string
| Upper of string
| Number of string
| Group of out list
type Parser = Parser<out, unit>
let isUpper = fun c -> isAsciiUpper c
let upper : Parser =
many1Satisfy isUpper .>> ws
|>> fun x -> Upper(x)
let isLower = fun c -> isAsciiLower c
let lower : Parser=
many1Satisfy isLower .>> ws
|>> fun x -> Lower(x)
let isNumber = fun c -> isDigit c
let number : Parser =
many1Satisfy isNumber .>> ws
|>> fun x -> Number(x)
let groupRef, groupImpl = createParserForwardedToRef()
let item : Parser =
lower <|> upper <|> number <|> groupRef
let items =
many item .>> ws
|>> fun x -> Group(x)
do groupImpl := between (pchar '(') (pchar ')') items .>> ws
let test () =
match run groupRef "(abc (b CDEF (de 1 E) (f 234)) (h 3) (jkl H) )" with
| Success(result, _, _) -> printf "Success: %A" result
| Failure(errorMsg, _, _) -> printf "Failure: %s" errorMsg
Monadic style
type out =
| Lower of string
| Upper of string
| Number of string
| Group of out list
type Parser = Parser<out, unit>
let isUpper = fun c -> isAsciiUpper c
let upper : Parser = parse {
let! x = many1Satisfy isUpper
do! ws
return Upper(x)
}
let isLower = fun c -> isAsciiLower c
let lower = parse {
let! x = many1Satisfy isLower
do! ws
return Lower(x)
}
let isNumber = fun c -> isDigit c
let number = parse {
let! x = many1Satisfy isNumber
do! ws
return Number(x)
}
let groupRef, groupImpl = createParserForwardedToRef()
let group = parse {
let! x = groupRef
do! ws
return x
}
let item =
lower <|> upper <|> number <|> group
let items = parse {
let! x = many item
do! ws
return Group(x)
}
do groupImpl := between (pchar '(') (pchar ')') items
let test () =
match run group "(abc (b CDEF (de 1 E) (f 234)) (h 3) (jkl H) )" with
| Success(result, _, _) -> printf "Success: %A" result
| Failure(errorMsg, _, _) -> printf "Failure: %s" errorMsg