Deleting any node inside BST - Clojure - clojure

I'm studying algorithms and at the class we were asked to create a BST with structures, I'm trying really hard to create a delete function but the one I created isn't efficient and doesn't work. I searched in google for something similar, but most of the questions are about vectors and not record/structures. If you have any recommendations, I would really appreciate it.
This is the basic creating of the root and node:
(let [bst (make-bst)]
(bst-empty? bst)
(make-bst-node 10))
(defrecord BST [root])
(defn bst? [bst]
(= (class bst) BST))
(defn make-bst []
(BST. (ref nil)))
(defn bst-empty? [bst]
(nil? #(:root bst)))
(defrecord BSTnode [data left right])
(defn make-bst-node [val]
(BSTnode. val (ref nil) (ref nil)))
(defn bst-insert! [bst val]
(loop [node (:root bst)]
(if (nil? #node)
(dosync
(ref-set node (make-bst-node val)))
(let [data (:data bst)]
(if (< val data)
(recur (:left #node))
(if (val data)
(recur (:right #node))))))))
This is the delete function:
(defn bst-del [bst val]
(if (nil? #(:root bst))
false
(do
(if (= (:data #(:root bst)) val)
(if (nil? (and (:right bst) (:left bst)))
(dosync
(ref-set (:root bst) nil))
(if (not (nil? (:right bst)))
(dosync
(ref-set (:root bst) #(:right bst)))
(if (not (nil? (:left bst)))
(dosync
(ref-set (:root bst) #(:left bst)))
(if (not (nil? (and (:right bst) (:left bst))))
(dosync
(ref-set (:root bst) #(:left bst))
(ref-set (:root bst) (:right bst))) false))))))))
(defn node-del [bst val]
(loop [node #(:root bst)]
(if (nil? node)
false
(if (true? bst-del)
(println "somthing got deleted")
(if (< val (:data node))
(recur #(:left node))
(recur #(:right node)))))))
I tried to search in google but all the function or examples were for maps and vectors, not my case, as well as, reading theoretical material about the subject and references from different languages.

this code of yours seems to be overly complicated and hard to debug (or event understand an algorithm)
I would propose implementing this recursive algorithm for deletion, which works quite nice with that mutable structure of yours:
Node delete(root : Node, z : T):
if root == null
return root
if z < root.key
root.left = delete(root.left, z)
else if z > root.key
root.right = delete(root.right, z)
else if root.left != null and root.right != null
root.key = minimum(root.right).key
root.right = delete(root.right, root.key)
else
if root.left != null
root = root.left
else if root.right != null
root = root.right
else
root = null
return root
so, i would start with the following type defs:
(defrecord Tree [root])
(defn make-tree [root-node]
(->Tree (ref root-node)))
(defrecord Node [data left right])
(defn make-node [data & {:keys [left right]}]
(->Node (ref data)
(ref left)
(ref right)))
first thing we want is insertion + traversal functions for tree creating/debug. let's implement them for Node (and employ in Tree later):
(defn insert-node [{:keys [data left right] :as node} item]
(if (nil? node)
(make-node item)
(dosync (alter (if (< item #data) left right)
insert-node
item)
node)))
(defn traverse-node [node]
(when-some [{:keys [data left right]} node]
(concat (traverse-node #left)
[#data]
(traverse-node #right))))
user> (reduce insert-node nil [3 1 2])
;; {:data #<Ref#1a28bd3f: 3>,
;; :left
;; #<Ref#514133ef:
;; {:data #<Ref#5617f393: 1>,
;; :left #<Ref#637de49b: nil>,
;; :right
;; #<Ref#6efa5317:
;; {:data #<Ref#14ef556b: 2>,
;; :left #<Ref#7fe0e031: nil>,
;; :right #<Ref#5a16bba5: nil>}>}>,
;; :right #<Ref#4eec6b9f: nil>}
user> (traverse-node (reduce insert-node nil [3 1 2]))
;; (1 2 3)
so, this seems to work ok.
Next, we will implement the deletion algorithm.
there's an utility function minimum in the aforementioned algorithm, so we start with that one:
(defn minimum-node [{:keys [data left right] :as node}]
(cond (nil? node) nil
(nil? #left) #data
:else (recur #left)))
user> (minimum-node (reduce insert-node nil (shuffle (range 10 20))))
;; 10
after that the deletion implementation looks trivial:
(defn del-node [node item]
(when-some [{:keys [data left right]} node]
(cond (< item #data) (dosync (alter left del-node item)
node)
(> item #data) (dosync (alter right del-node item)
node)
(and (some? #left) (some? #right)) (let [m (-> right deref minimum-node)]
(dosync
(ref-set data m)
(alter right del-node m))
node)
(some? #left) #left
(some? #right) #right)))
user> (traverse-node (del-node
(reduce insert-node nil (shuffle (range 10 20)))
13))
;;=> (10 11 12 14 15 16 17 18 19)
this seems to be working mutable algorithm.
Let's then go back to the Tree structure. I would start with the BST protocol, to be used by both Node and Tree:
(defprotocol BST
(traverse [self])
(insert [self item])
(minimum [self])
(del [self item]))
(extend-protocol BST
Node
(traverse [self]
(traverse-node self))
(insert [self item]
(insert-node self item))
(minimum [self]
(minimum-node self))
(del [self item]
(del-node self item)))
(extend-protocol BST
Tree
(traverse [self] (-> self :root deref traverse))
(insert [self item]
(dosync
(if (-> self :root deref some?)
(alter (:root self) insert item)
(ref-set (:root self) (make-node item))))
self)
(minimum [self] (-> self :root deref minimum))
(del [self item]
(dosync
(when (-> self :root deref some?)
(alter (:root self) del item)))
self))
and that's it. Now just use it:
user> (reduce del
(reduce insert (make-tree nil) [1 2 3 4])
[2 4])
;; {:root
;; #<Ref#273f7854:
;; {:data #<Ref#67d4f4d0: 1>,
;; :left #<Ref#26329ec3: nil>,
;; :right
;; #<Ref#5636f9f8:
;; {:data #<Ref#3cd02119: 3>,
;; :left #<Ref#7d62fb13: nil>,
;; :right #<Ref#1f25eeb7: nil>}>}>}

After the class, I understood how to delete a function and I implemented it similarly inside a dictionary binary tree. It is really similar, the only difference is with "key" value, but the logic is the same.
(defn dict-find-leftmost-node[start-node]
(loop [node start-node]
(if (nil? #(:left #node))
node
(recur (:left #node)))))
(defn dict-remove! [dict key]
(let [node-to-remove (dict-get-node dict key)]
(when (not (nil? node-to-remove))
(if (dict-node-leaf? node-to-remove)
(dosync
(ref-set node-to-remove nil))
(if (nil? #(:left #node-to-remove))
(dosync
;;(println "I need to pull up the right branch")
(ref-set node-to-remove
#(:right #node-to-remove)))
(if (nil? #(:right #node-to-remove))
(dosync
;;(println "I need to pull up the left branch")
(ref-set node-to-remove
#(:left #node-to-remove)))
(let [leftmost-node
(dict-find-leftmost-node
(:right #node-to-remove))]
(dosync
(ref-set (:left #leftmost-node)
#(:left #node-to-remove))
(ref-set node-to-remove
#(:right #node-to-remove))))
;;(println "I don't know what to do yet!")
;; this is where we remove the node
))))))
(defn dict-node-leaf? [node]
(and (nil? #(:left #node))
(nil? #(:right #node))))

Related

postwalk to evaluate arithmetic expression

I am trying to use Instaparse to make a simple arithmetic expression evaluator. The parser seems to work fine but I cannot figure out how to evaluate the returned nested vector. Currently I am using postwalk, like this
(ns test5.core
(:require [instaparse.core :as insta])
(:require [clojure.walk :refer [postwalk]])
(:gen-class))
(def WS
(insta/parser
"WS = #'\\s+'"))
(def transform-options
{:IntLiteral read-string})
(def parser
(insta/parser
"AddExpr = AddExpr '+' MultExpr
| AddExpr '-' MultExpr
| MultExpr
MultExpr = MultExpr '*' IntLiteral
| MultExpr '/' IntLiteral
| IntLiteral
IntLiteral = #'[0-9]+'"
:auto-whitespace WS))
(defn parse[input]
(->> (parser input)
(insta/transform transform-options)))
(defn visit [node]
(println node)
(cond
(number? node) node
(string? node) (resolve (symbol node))
(vector? node)
(cond
(= :MultExpr (first node)) (visit (rest node))
(= :AddExpr (first node)) (visit (rest node))
:else node)
:else node))
(defn evaluate [tree]
(println tree)
(postwalk visit tree))
(defn -main
[& args]
(evaluate (parse "1 * 2 + 3")))
postwalk does traverse the vector but I get a nested list as the result, eg
((((1) #'clojure.core/* 2)) #'clojure.core/+ (3))
Use org.clojure/core.match. Base on your current grammar, you can write the evaluation function as:
(defn eval-expr [expr]
(match expr
[:MultExpr e1 "*" e2] (* (eval-expr e1)
(eval-expr e2))
[:MultExpr e1 "/" e2] (/ (eval-expr e1)
(eval-expr e2))
[:AddExpr e1 "+" e2] (+ (eval-expr e1)
(eval-expr e2))
[:AddExpr e1 "-" e2] (- (eval-expr e1)
(eval-expr e2))
[:MultExpr e1] (eval-expr e1)
[:AddExpr e1] (eval-expr e1)
:else expr))
and evaluate with:
(-> "1 * 2 + 3"
parse
eval-expr)
;; => 5
This doesn't use Instaparse or clojure.walk, but here's something I had for evaluating infix math using only reduce:
(defn evaluate
"Evaluates an infix arithmetic form e.g. (1 + 1 * 2)."
[e]
(let [eval-op (fn [op a b]
(let [f (resolve op)]
(f a b)))]
(reduce
(fn [[v op] elem]
(cond
(coll? elem)
(if op
[(eval-op op v (first (evaluate elem))) nil]
[(first (evaluate elem)) nil])
(and op (number? elem))
[(eval-op op v elem) nil]
(number? elem)
[elem nil]
(symbol? elem)
[v elem]
:else
(throw (ex-info "Invalid evaluation" {:v v :op op :elem (type elem)}))))
[0 nil]
e)))
(first (evaluate (clojure.edn/read-string "(1 * 2 + 3)")))
=> 5
(first (evaluate (clojure.edn/read-string "(1 * 2 + (3 * 5))")))
=> 17
This requires the input string to represent a valid Clojure list. I also had this function for grouping multiplication/division:
(defn pemdas
"Groups division/multiplication operations in e into lists."
[e]
(loop [out []
rem e]
(if (empty? rem)
(seq out)
(let [curr (first rem)
next' (second rem)]
(if (contains? #{'/ '*} next')
(recur (conj out (list curr next' (nth rem 2)))
(drop 3 rem))
(recur (conj out curr) (rest rem)))))))
(pemdas '(9.87 + 4 / 3 * 0.41))
=> (9.87 + (4 / 3) * 0.41)
This exact problem is why I first created the Tupelo Forest library.
Please see the talk from Clojure Conj 2017.
I've started some docs here. You can also see live examples here.
Update
Here is how you could use the Tupelo Forest library to do it:
First, define your Abstract Syntax Tree (AST) data using Hiccup format:
(with-forest (new-forest)
(let [data-hiccup [:rpc
[:fn {:type :+}
[:value 2]
[:value 3]]]
root-hid (add-tree-hiccup data-hiccup)
with result:
(hid->bush root-hid) =>
[{:tag :rpc}
[{:type :+, :tag :fn}
[{:tag :value, :value 2}]
[{:tag :value, :value 3}]]]
Show how walk-tree works using a "display interceptor"
disp-interceptor {:leave (fn [path]
(let [curr-hid (xlast path)
curr-node (hid->node curr-hid)]
(spyx curr-node)))}
>> (do
(println "Display walk-tree processing:")
(walk-tree root-hid disp-interceptor))
with result:
Display walk-tree processing:
curr-node => {:tupelo.forest/khids [], :tag :value, :value 2}
curr-node => {:tupelo.forest/khids [], :tag :value, :value 3}
curr-node => {:tupelo.forest/khids [1037 1038], :type :+, :tag :fn}
curr-node => {:tupelo.forest/khids [1039], :tag :rpc}
then define the operators and an interceptor to transform a subtree like (+ 2 3) => 5
op->fn {:+ +
:* *}
math-interceptor {:leave (fn [path]
(let [curr-hid (xlast path)
curr-node (hid->node curr-hid)
curr-tag (grab :tag curr-node)]
(when (= :fn curr-tag)
(let [curr-op (grab :type curr-node)
curr-fn (grab curr-op op->fn)
kid-hids (hid->kids curr-hid)
kid-values (mapv hid->value kid-hids)
result-val (apply curr-fn kid-values)]
(set-node curr-hid {:tag :value :value result-val} [])))))}
] ; end of let form
; imperative step replaces old nodes with result of math op
(walk-tree root-hid math-interceptor)
We can then display the modified AST tree which contains the result of (+ 2 3):
(hid->bush root-hid) =>
[{:tag :rpc}
[{:tag :value, :value 5}]]
You can see the live code here.

Empty children and Clojure zippers

Why the last expression retruns
{:a :foo, :args [{:id :XX}], :id :XX}
instead of:
{:a :foo, :args [], :id :XX}
(require '[clojure.zip :as zip])
(defn my-zipper [tree]
(zip/zipper
(fn branch? [node]
(:args node))
(fn children [node]
(:args node))
(fn make-node [node children]
(assoc node :args (vec children)))
tree))
(def z (my-zipper {:a :foo :args []}))
(loop [loc z]
(if (zip/end? loc)
(zip/node loc)
(recur
(zip/next
(zip/edit loc #(assoc % :id :XX))))))
It looks like the problem is associated with the fact that traversing with zip/next reveals there are 2 nodes :
(zip/node (zip/next z)) ; => nil
(zip/node (zip/next (zip/next z))) ; => {:a :foo :args []}
Why is that? There is a single node with empty children so there should be only one node, correct?
After looking at the code of clojure.zip/vector-zip I conclude that lack of node's children should be communicated with nil. The empty sequence doesn't work.
So the children function should really be:
(fn children [node]
(seq (:args node)))

How to parse xml and get an vector for some attributes on an element

I know how to extract one attribute using zip-xml/attr, but how to extract multiple attributes?
e.g I have the following
<table>
<column name="col1" type="varchar" length="8"/>
<column name="col2" type="varchar" length="16"/>
<column name="col3" type="int" length="16"/>
<table>
And the expected result is. A silly way is to call zip-xml/attr for each attribute, but is there any elegant way to do that?
[["co11" "varchar" 8] [["co12" "varchar" 16] [["co13" "int" 16]
My advice is to use a tree-walking function to extract the interesting data from the XML tree. clojure.walk has several of these, but here I use tree-seq from core clojure to just produce a seq of nodes and work on that. This function takes two functions - a branch? predicate which checks if a node can have children and a children function which gets them. I use :content for both, as tags with no nested tags produce nil, which is a falsey value and so it works also as a predicate.
(->> (clojure.xml/parse "res/doc.xml") ;;source file for your xml
(tree-seq :content :content) ;; Produce a seq by walking the tree
(filter #(= :column (:tag %))) ;;Take only :column tags
(mapv (comp vec vals :attrs)))
;;Collect the values of the :attrs maps into vectors
;;and collect those into a vector with mapv
Your desired output had unmatched square brackets, but I assume it should be like
[["col1" "varchar" "8"] ["col2" "varchar" "16"] ["col3" "int" "16"]]
which was my return value. However, this is potentially brittle - you're relying on the maps returned by clojure.xml/parse preserving the ordering of the attributes in the XML in order to know what the data means. That's not really part of the contract of maps. As an implementation detail it creates clojure.lang.PersistentStructMaps which apparently do have this feature, but it might not always be so.
Alternatively you could use just (mapv :attrs) to keep the whole of the map in there.
The right solution depends on how large and complex the XML is and to some extent, what you know about its structure. If it needs to be very generic, then you need to have quite a lot of logic to navigate the nodes etc. However, if it is a known format and you know what nodes you are interested in, its pretty straight-forward.
I used clojure.zip to create a zipper from the XML file and then use clojure.data.zip.xml to extract the nodes/paths I was interested in. I then defined simple helper functions to process specific nodes. This was pretty much my first bit of clojure and I've not yet gone back to it to re-factor it and refine/clarify some of my very rough clojure idioms based on what I've learnt since, but in the spirit of an example being worth 1000 words, here it is -
(ns arcis.models.nessus
(:use [taoensso.timbre :only [trace debug info warn error fatal]])
(:require [arcis.util :as util]
[arcis.models.db :as db]
[clojure.java.io :as io]
[clojure.xml :as xml]
[clojure.zip :as zip]
[clojure.data.zip.xml :as zx]))
(def nessus-host-keys [:hostname :host_fqdn
:system_type :operating_system
:operating_system_unsupported])
(def used-nessus-host-keys (conj nessus-host-keys
:host_start :host_end
:items :traceroute_hop_0 :traceroute_hop_1
:traceroute_hop_2 :traceroute_hop_3
:traceroute_hop_4 :traceroute_hop_5
:traceroute_hop_6 :traceroute_hop_7
:traceroute_hop_8 :traceroute_hop_9
:traceroute_hop_10 :traceroute_hop_11
:traceroute_hop_12 :traceroute_hop_13
:traceroute_hop_14 :traceroute_hop_15
:traceroute_hop_16 :traceroute_hop_17
:host_ip :patch_summary_total_cves
:cpe_0 :cpe_1 :cpe_2 :cpe_3 :cpe_4 :cpe_5
:cpe_6 :cpe_7 :cpe_8 :cpe_9))
(def nessus-item-keys [:port :svc_name :protocol :severity :plugin_id
:plugin_output])
(def used-nessus-item-keys (conj nessus-item-keys
:plugin_details
:plugin_name
:plugin_family))
(def nessus-plugin-keys [:plugin_id :plugin_name :plugin_family :fname
:script_version :plugin_type :exploitability_ease
:vuln_publication_date :cvss_temporal_data
:solution :cvss_temporal_score :risk_factor
:description :cvss_vector :synopsis
:patch_publication_date :exploit_available
:plugin_publication_date :plugin_modification_date
:cve :bid :exploit_framework_canvas :edb_id
:exploit_framework_metasploit :exploit_framework_core
:metasploit_name :canvas_package :osvdb :cwe
:cvss_temporal_vector :cvss_base_score :cpe
:exploited_by_malware])
(def used-nessus-plugin-keys (conj nessus-plugin-keys
:xref :see_also :cert
:attachment :iava :stig_severity :hp
:secunia :iawb :msft))
(def show-unprocessed true)
(defn log-unprocessed [title vls]
(if (and show-unprocessed
(seq vls))
(println (str "Unprocessed " title ": " vls))))
;;; parse nessus report
(defn parse-xref [xref]
{:xref (first (:content xref))})
(defn parse-see-also [see-also]
{:see_also (first (:content see-also))})
(defn parse-plugin [plugin]
{(util/db-keyword (name (:tag plugin))) (first (:content plugin))})
(defn parse-contents [cont]
(let [xref (mapv parse-xref (filter #(= (:tag %) :xref) cont))
see-also (mapv parse-see-also (filter #(= (:tag %) :see-also) cont))
details (reduce merge {}
(map parse-plugin
(remove #(or (= (:tag %) :xref)
(= (:tag %) :see-also)) cont)))]
(assoc details
:see_also see-also
:xref xref)))
(defn fix-item-keywords [item]
(let [ks (keys item)]
(into {}
(for [k ks]
[(util/db-keyword (name k))
(k item)]))))
(defn parse-item [item]
(let [attrs (fix-item-keywords (:attrs item))
contents (parse-contents (:content item))]
(assoc attrs
:plugin_output (:plugin_output contents)
:plugin_details (assoc (dissoc contents :plugin_output)
:plugin_id (:plugin_id attrs)
:plugin_family (:plugin_family attrs)))))
(defn parse-properties [props]
(into {}
(for [p props]
[(util/db-keyword (:name (:attrs p)))
(first (:content p))])))
(defn parse-host [h]
(let [items (map first (zx/xml-> h :ReportItem))
properties (:content (first (zx/xml1-> h :HostProperties)))]
(assoc (parse-properties properties)
:hostname (zx/attr h :name)
:items (mapv parse-item items))))
(defn parse-hosts [hosts]
(mapv parse-host hosts))
(defn parse-file [f]
(let [root (zip/xml-zip (xml/parse (io/file f)))
report-xml (zx/xml1-> root :Report)
hosts (zx/xml-> report-xml :ReportHost)]
{:report_name (zx/attr report-xml :name)
:policy (zx/text (zx/xml1-> root :Policy :policyName))
:hosts (parse-hosts hosts)}))
;;; insert nessus records into db
(defn mk-host-rec [scan-id host]
(let [[id err] (db/get-sequence-nextval "host_seq")]
(if (nil? err)
(assoc (util/build-map host nessus-host-keys)
:ipv4 (:host_ip host)
:scan_start (util/from-nessus-date (:scan_start host))
:scan_end (util/from-nessus-date (:scan_end host))
:total_cves (:patch_summary_total_cves host)
:id id
:scan_id scan-id)
nil)))
(defn insert-patches [p]
(when (seq p)
(db/insert-nessus-host-patch (first p))
(recur (rest p))))
(defn insert-host-patch [id host]
(let [p-keys (filter #(re-find #"patch_summary_*" %) (map name (keys host)))
recs (map (fn [s]
{:id (first (db/get-sequence-nextval "patch_seq"))
:host_id id
:summary ((keyword (str "patch_summary_txt_" s)) host)
:cve_num ((keyword (str "patch_summary_cve_num_" s)) host)
:cves ((keyword (str "patch_summary_cves_" s)) host)})
(filter seq
(map #(second (re-find #"patch_summary_txt_(.*)" %))
p-keys)))]
(insert-patches recs)
(util/remove-keys host (map keyword p-keys))))
(defn mk-item-rec [host-id item]
(let [[id err] (db/get-sequence-nextval "item_seq")]
(assoc (util/build-map item nessus-item-keys)
:host_id host-id
:id id)))
(defn insert-item [host-id item]
(let [rec (mk-item-rec host-id item)
not-done (keys (util/remove-keys item used-nessus-item-keys))]
(log-unprocessed "Item Keys" not-done)
(db/insert-nessus-report-item rec)
(:plugin_id item)))
(defn mk-plugin-rec [item]
(let [rec (util/build-map (:plugin_details item) nessus-plugin-keys)
not-used (keys (util/remove-keys (:plugin_details item)
used-nessus-plugin-keys))]
(log-unprocessed "Plugin Keys" not-used)
(assoc rec
:vuln_publication_date (util/from-nessus-date
(:vuln_publication_date rec))
:patch_publication_date (util/from-nessus-date
(:patch_publication_date rec))
:plugin_publication_date (util/from-nessus-date
(:plugin_publication_date rec))
:plugin_modification_date (util/from-nessus-date
(:plugin_modificaiton_date rec)))))
(defn insert-xref [plugin-id xrefs]
(when (seq xrefs)
(let [xref {:id (first (db/get-sequence-nextval "xref_seq"))
:plugin_id plugin-id
:xref (:xref (first xrefs))}]
(db/insert-nessus-xref xref)
(recur plugin-id (rest xrefs)))))
(defn insert-see-also [plugin-id see-also]
(when (seq see-also)
(let [sa {:id (first (db/get-sequence-nextval "ref_seq"))
:plugin_id plugin-id
:reference (:see_also (first see-also))}]
(db/insert-nessus-ref sa)
(recur plugin-id (rest see-also)))))
(defn insert-plugin [item]
(let [rec (mk-plugin-rec item)
xref (:xref (:plugin_details item))
see-also (:see_also (:plugin_details item))]
(if (seq xref)
(insert-xref (:plugin_id rec) xref))
(if (seq see-also)
(insert-see-also (:plugin_id rec) see-also))
(db/upsert-nessus-plugin rec)))
(defn insert-items [host-id items plugin-set]
(if (empty? items)
plugin-set
(let [p (insert-item host-id (first items))]
(if-not (contains? plugin-set p)
(insert-plugin (first items)))
(recur host-id (rest items) (conj plugin-set p)))))
(defn insert-host [scan-id host plugin-set]
(if-let [h-rec (mk-host-rec scan-id host)]
(let [[v err] (db/insert-nessus-host h-rec)
items (:items host)]
(if (nil? err)
(let [host2 (insert-host-patch (:id h-rec) host)]
(log-unprocessed "Host Keys" (keys (util/remove-keys
host2 used-nessus-host-keys)))
(insert-items (:id h-rec) items plugin-set))
plugin-set))
plugin-set))
(defn insert-hosts
([id hosts]
(insert-hosts id hosts #{}))
([id hosts plugins]
(if (empty? hosts)
plugins
(let [plugin-set (insert-host id (first hosts) plugins)]
(recur id (rest hosts) plugin-set)))))
(defn mk-scan-record [id report]
{:id id
:name (:report_name report)
:scan_dt (util/to-sql-date)
:policy (:policy report)
:entered_dt (util/to-sql-date)})
(defn store-report [update-plugins report]
(let [[id err] (db/get-sequence-nextval "nscan_seq")
scan-rec (mk-scan-record id report)]
(if (nil? err)
(let [[v e] (db/insert-nessus-scan scan-rec)]
(if (nil? e)
(if update-plugins
(let [plugin-list (set (first (db/select-nessus-plugin-ids)))]
[(insert-hosts id (:hosts report) plugin-list) nil])
[(insert-hosts id (:hosts report)) nil])
[v e]))
[id err])))
(defn process-nessus-report [update-plugins filename]
(let [report (parse-file filename)]
(println (str "Report: " (:report_name report)
"\nPolicy: " (:policy report)
"\nHost Records: " (count (:hosts report))))
(store-report update-plugins report)))
Magos's answer using tree-seq is perfectly fine, but there's no reason to abandon zippers; filtering using zippers is more succinct and the arguably the "clojure" way. (note this example uses data.xml ([org.clojure/data.xml "0.0.8"]) instead of clojure.xml).
(require '[clojure.data.zip.xml :as zf])
(require '[clojure.zip :as z])
(def ex
"<table>
<column name=\"col1\" type=\"varchar\" length=\"8\"/>
<column name=\"col2\" type=\"varchar\" length=\"16\"/>
<column name=\"col3\" type=\"int\" length=\"16\"/>
</table>")
(let [x (z/xml-zip (clojure.data.xml/parse-str ex))]
(->> (zf/xml-> x :column) ;;equivalent to (->> treeseq ... filter)
flatten
(keep :attrs)
(map vals)))
;>>> (("col1" "varchar" "8") ("col2" "varchar" "16") ("col3" "int" "16"))
But the xml-> macro simply applies functions in order, so you can do the following:
(let [x (z/xml-zip (clojure.data.xml/parse-str ex))]
(->> (zf/xml-> x :column #(keep :attrs %))
(map vals)))
;>>> (("col1" "varchar" "8") ("col2" "varchar" "16") ("col3" "int" "16"))

Checking odd parity in clojure

I have the following functions that check for odd parity in sequence
(defn countOf[a-seq elem]
(loop [number 0 currentSeq a-seq]
(cond (empty? currentSeq) number
(= (first currentSeq) elem) (recur (inc number) (rest currentSeq))
:else (recur number (rest currentSeq))
)
)
)
(defn filteredSeq[a-seq elemToRemove]
(remove (set (vector (first a-seq))) a-seq)
)
(defn parity [a-seq]
(loop [resultset [] currentSeq a-seq]
(cond (empty? currentSeq) (set resultset)
(odd? (countOf currentSeq (first currentSeq))) (recur (concat resultset (vector(first currentSeq))) (filteredSeq currentSeq (first currentSeq)))
:else (recur resultset (filteredSeq currentSeq (first currentSeq)))
)
)
)
for example (parity [1 1 1 2 2 3]) -> (1 3) that is it picks odd number of elements from a sequence.
Is there a better way to achieve this?
How can this be done with reduce function of clojure
First, I decided to make more idiomatic versions of your code, so I could really see what it was doing:
;; idiomatic naming
;; no need to rewrite count and filter for this code
;; putting item and collection in idiomatic argument order
(defn count-of [elem a-seq]
(count (filter #(= elem %) a-seq)))
;; idiomatic naming
;; putting item and collection in idiomatic argument order
;; actually used the elem-to-remove argument
(defn filtered-seq [elem-to-remove a-seq]
(remove #(= elem-to-remove %) a-seq))
;; idiomatic naming
;; if you want a set, use a set from the beginning
;; destructuring rather than repeated usage of first
;; use rest to recur when the first item is guaranteed to be dropped
(defn idiomatic-parity [a-seq]
(loop [result-set #{}
[elem & others :as current-seq] a-seq]
(cond (empty? current-seq)
result-set
(odd? (count-of elem current-seq))
(recur (conj result-set elem) (filtered-seq elem others))
:else
(recur result-set (filtered-seq elem others)))))
Next, as requested, a version that uses reduce to accumulate the result:
;; mapcat allows us to return 0 or more results for each input
(defn reducing-parity [a-seq]
(set
(mapcat
(fn [[k v]]
(when (odd? v) [k]))
(reduce (fn [result item]
(update-in result [item] (fnil inc 0)))
{}
a-seq))))
But, reading over this, I notice that the reduce is just frequencies, a built in clojure function. And my mapcat was really just a hand-rolled keep, another built in.
(defn most-idiomatic-parity [a-seq]
(set
(keep
(fn [[k v]]
(when (odd? v) k))
(frequencies a-seq))))
In Clojure we can refine our code, and as we recognize places where our logic replicates the built in functionality, we can simplify the code and make it more clear. Also, there is a good chance the built in is better optimized than our own work-alikes.
Is there a better way to achieve this?
(defn parity [coll]
(->> coll
frequencies
(filter (fn [[_ v]] (odd? v)))
(map first)
set))
For example,
(parity [1 1 1 2 1 2 1 3])
;#{1 3}
How can this be done with reduce function of clojure.
We can use reduce to rewrite frequencies:
(defn frequencies [coll]
(reduce
(fn [acc x] (assoc acc x (inc (get acc x 0))))
{}
coll))
... and again to implement parity in terms of it:
(defn parity [coll]
(let [freqs (frequencies coll)]
(reduce (fn [s [k v]] (if (odd? v) (conj s k) s)) #{} freqs)))

Threadsafe pop in clojure?

I've found this code on http://www.learningclojure.com/2010/11/yet-another-way-to-write-factorial.html, but I don't understand if/how the pop-task is supposed to be threadsafe. Doesn't it allow to return twice the same head ?
(def to-do-list (atom '()))
(defn add-task![t] (swap! to-do-list #(cons t %)))
(defn pop-task![] (let [h (first #to-do-list)] (swap! to-do-list rest) h))
If so, is it possible to keep using atom and write the peek and swap! atomically, or is this a job for the ref mechanism ?
Or you drop to a lower level.
(def to-do-list (atom nil))
(defn add-task!
[t]
(swap! to-do-list conj t))
(defn pop-task!
[]
(let [[h & r :as l] #to-do-list]
(if (compare-and-set! to-do-list l r)
h
(recur))))
Yeah, that code isn't thread safe. You can make it thread-safe by taking advantage of the fact that swap! returns the new value of the atom, which implies you need to combine the queue with the "popped" value.
(def to-do-list
(atom {}))
(defn add-task!
[t]
(swap! to-do-list
(fn [tl]
{:queue (cons t (:queue tl))})))
(defn pop-task!
[]
(let [tl (swap! to-do-list
(fn [old]
{:val (first (:queue old))
:queue (rest (:queue old))}))]
(:val tl)))