From 990b51a162a8aa5c7b3bf86eba1fb76b5a885896 Mon Sep 17 00:00:00 2001 From: Myoungjin JEON Date: Mon, 14 Sep 2020 01:22:04 +1000 Subject: [ch-077/jeongoon] ch-1.lsp added, ch-1.hs bug fixed. --- challenge-077/jeongoon/common-lisp/ch-1.lsp | 156 ++++++++++++++++++++++++++++ challenge-077/jeongoon/haskell/ch-1.hs | 27 +++-- 2 files changed, 173 insertions(+), 10 deletions(-) create mode 100644 challenge-077/jeongoon/common-lisp/ch-1.lsp diff --git a/challenge-077/jeongoon/common-lisp/ch-1.lsp b/challenge-077/jeongoon/common-lisp/ch-1.lsp new file mode 100644 index 0000000000..24bf85a27e --- /dev/null +++ b/challenge-077/jeongoon/common-lisp/ch-1.lsp @@ -0,0 +1,156 @@ +;; translated from ch-1.pl + +;; fibonacci number in reverse order upto limit +(defun rfibs (limit) ;; ignore first number 1 for challenge purpose + (if (= limit 1) (list 1) + (if (= limit 2) (list 2 1) + (let ((rfib (list 2 1))) + (loop for nf = (+ (car rfib) (cadr rfib)) + if (<= nf limit) do (setq rfib (cons nf rfib)) + else do (return)) + rfib)))) + +;;(format t "~a~%" (rfibs 100)) + +(defun a-fib-sub-cases (a-fib rfibs-ls) ;; return as a vector of lists + (let* ((skip 0) + (rlen (length rfibs-ls)) + (rfibs-vec (make-array (list rlen) :initial-contents rfibs-ls))) + (setq skip (loop named finding-idx for i from 0 below rlen + for a-rf = (aref rfibs-vec i) + if (= a-rf a-fib) do (return-from finding-idx i))) + (if (null skip) + '() + (let* ((sub-rfib-len (- rlen skip)) + (all-cases (list (list a-fib)))) + (loop named generating-subfib + for i from 0 below (- sub-rfib-len 2) by 2 + for ri = (+ skip i 1) + do (let* ((last-fibs (car (last all-cases))) ;; XXX car needed + (two-fibs (list (aref rfibs-vec ri) + (aref rfibs-vec (1+ ri)))) + (last-fibs-withouth-last-one + (reverse (cdr (reverse last-fibs)))) + (new-sub-case + (append last-fibs-withouth-last-one two-fibs))) + + (nconc all-cases (list new-sub-case)))) + (make-array (list (length all-cases)) :initial-contents all-cases))))) + +;;(format t "~a~%" (a-fib-sub-cases 55 (rfibs 55))) + +(defun flat-once (list-of-list) + (let ((all '())) + (map nil #'(lambda (ls) (setq all (append all ls))) list-of-list) + all)) + +(defun product-cases (cases-map &optional validate-func) + (let* ((num-cases (length cases-map)) + (cases-vec (make-array (list num-cases) :initial-contents cases-map)) + (pos (make-array (list num-cases) :initial-element 0)) + (csr (1- num-cases)) ;; pointing the last case + (all-cases (list 'remove-me))) + + (loop named processing-cases do + (if (< (aref pos csr) (length (aref cases-vec csr))) + ;; still have next step at the current cursor + (let* ((cur-cases-combi + (mapcar + (lambda (sub-case cur-sub-case-idx) + (coerce (aref sub-case cur-sub-case-idx) 'list)) + cases-map (coerce pos 'list)))) + + (when (or (null validate-func) + (funcall validate-func cur-cases-combi)) + ;; flatten and collect the case + (nconc all-cases (list (flat-once cur-cases-combi)))) + ;; try next case + (setf (aref pos csr) (1+ (aref pos csr)))) + ;; else -- try to go higher order + (let* ((new-csr + (loop named finding-new-cursor + for c from (1- csr) downto 0 + if (< (aref pos c) (1- (length (aref cases-vec c)))) + do (return-from finding-new-cursor c)))) + (if (null new-csr) + (return-from processing-cases) + (progn + (setf (aref pos new-csr) (1+ (aref pos new-csr))) + (loop for i from (1+ new-csr) below num-cases + do (setf (aref pos i) 0)) + (setq csr (1- num-cases))))))) + (cdr all-cases))) + + +;; (format t "~a~%" (product-cases (list (a-fib-sub-cases 55 (rfibs 55)) +;; (a-fib-sub-cases 13 (rfibs 13))))) + +(defun product-a-rfibs-combi (a-fibs-combi rfibs-ls) ;; `r' means reversed order + (let* ((rcase-map (map 'list + (lambda (a-fib) (a-fib-sub-cases a-fib rfibs-ls)) + a-fibs-combi))) + (product-cases rcase-map + (lambda (a-combi) ;; validation code + (let* ((left-case (first a-combi)) + (overlapped + (loop named finding-duplicated + for right-case in (cdr a-combi) + if (<= (car (last left-case)) (first right-case)) + do (return-from finding-duplicated t) + else + do (setq left-case right-case)))) + (not overlapped)))))) + +;;(format t "~a~%" (product-a-rfibs-combi '(55 13 5) (rfibs 55))) + +(defun a-min-combi-rfib-sum (target-sum rfibs-ls) + (let ((major-fib + (loop named finding-major-fib for a-fib in rfibs-ls + do (if (<= a-fib target-sum) + (return-from finding-major-fib a-fib) + (setq rfibs-ls (cdr rfibs-ls)))))) + (if (null major-fib) + '() + ;; + (if (= major-fib target-sum) + (list major-fib) + (let ((rest-fibs (a-min-combi-rfib-sum + (- target-sum major-fib) rfibs-ls))) + (if (null rest-fibs) + '() + (cons major-fib rest-fibs))))))) + +;;(format t "~a~%" (a-min-combi-rfib-sum 100 (rfibs 100))) + +;; final solution form +(defun all-combi-fib-sum (target-sum) + (let* ((rfibs-ls (rfibs target-sum)) + (a-sum-combi (a-min-combi-rfib-sum target-sum rfibs-ls))) + (if (null a-sum-combi) + '() + (product-a-rfibs-combi a-sum-combi rfibs-ls)))) + +(defun get-command-line () + (or + #+CLISP *args* + #+SBCL *posix-argv* + #+LISPWORKS system:*line-arguments-list* + #+CMU extensions:*command-line-words* + nil)) + +(defparameter *cmdline* (get-command-line)) + +(defun print-usage () + (format t "Usage: sbcl --script ch-1.lsp " + (first *cmdline*))) + +(when (< (length *cmdline*) 2) (print-usage) (quit)) +(defparameter *target-sum* (parse-integer (second *cmdline*))) +(format t "Input: ~d~%Output:~%" *target-sum*) +(defvar all-combi (all-combi-fib-sum *target-sum*)) +(map nil (lambda (a-combi) + (progn (format t "~{~a~^ + ~}" a-combi) + (format t " = ~a~%" *target-sum*)) + ) all-combi) + +(format t "Total ~d case(s) found.~%" (length all-combi)) diff --git a/challenge-077/jeongoon/haskell/ch-1.hs b/challenge-077/jeongoon/haskell/ch-1.hs index 6a6bf0296b..9f438205d2 100644 --- a/challenge-077/jeongoon/haskell/ch-1.hs +++ b/challenge-077/jeongoon/haskell/ch-1.hs @@ -25,21 +25,18 @@ fibNumbers n = unfoldr (\(x, i) -> let fn = fib i in reversedFibNumbers = sortBy (\a b -> compare b a).fibNumbers -- find the all cases of a fib number can be expressed -divideAFib :: Integer -> [Integer] -> [Integer] -> [[Integer]] -divideAFib f [] fibNumsUsed = divideAFib f (reversedFibNumbers f) fibNumsUsed -divideAFib f rfibNums fibNumsUsed = -- fibNumUsed cannot be used twice or more +divideAFib :: Integer -> [Integer] -> [[Integer]] +divideAFib f [] = divideAFib f (reversedFibNumbers f) +divideAFib f rfibNums = case (findIndex (f==) rfibNums) of Nothing -> [] -- wrong fib number Just fidx -> [[f]] -- always include one fib number itself - -- which is not effeceted by fibNumsUsed ++ unfoldr divideAFibInner (fidx, rfibNums, [f]) where divideAFibInner (_, [], _) = Nothing -- only for silence warning message divideAFibInner (idx, rfs@(_:rfs'), acc) | idx +2 >= length rfs = Nothing - | null (intersect nextTwoFibs fibNumsUsed) = - Just ( acc', (idx+1, rfs', acc' ) ) - | otherwise = Nothing + | otherwise = Just ( acc', (idx+1, rfs', acc' ) ) where nextTwoFibs = [ rfs !! (idx+1), rfs !! (idx+2) ] acc' = (init acc) ++ nextTwoFibs @@ -49,6 +46,7 @@ rExpandFibCombination rfibNumsCombi [] = rExpandFibCombination rfibNumsCombi (reversedFibNumbers (head rfibNumsCombi)) rExpandFibCombination rfibNumsCombi rAllFibNums = -- rfibNumsCombi: expect to get reversed sorted fib numbers + filter ((0<).length) $ unfoldr productExpandedCases ((replicate nof 0), lastCsr ) -- starting from last (smallest) fib. where @@ -56,7 +54,7 @@ rExpandFibCombination rfibNumsCombi rAllFibNums = rcases = unfoldr (\fibs -> if null fibs then Nothing else Just( divideAFib - (head fibs) rAllFibNums (tail fibs), + (head fibs) rAllFibNums, (tail fibs) ) ) rfibNumsCombi nof = length rfibNumsCombi @@ -70,9 +68,9 @@ rExpandFibCombination rfibNumsCombi rAllFibNums = productExpandedCases :: ([Int], Int) -> Maybe ([Integer], ([Int], Int)) productExpandedCases (pos, csr) | null pos = Nothing + | not isValidCase = Just ( [], (pos', csr') ) | otherwise = - Just ( ((foldr (++) []).(map rCaseAtCursor)) allNumRange, - (pos', csr') ) + Just ( (foldr (++) [] rCaseCombi), (pos', csr') ) where (pos', csr') = case nextCsr csr of Nothing -> ([], csr) -- make edge case @@ -86,6 +84,15 @@ rExpandFibCombination rfibNumsCombi rAllFibNums = rCaseAtCursor :: Int -> [Integer] rCaseAtCursor i = ((rcases!!i)!!(pos!!i)) + rCaseCombi = map rCaseAtCursor allNumRange + + isValidCase = isValidCaseInner (head rCaseCombi) (tail rCaseCombi) + where + isValidCaseInner _ [] = True + isValidCaseInner leftCase (rightCase:moreRestCases) + | (last leftCase) <= (head rightCase) = False + | otherwise = isValidCaseInner rightCase moreRestCases + fibAtCursorHasMoreCases c = ((length (rcases!!c)) -1) /= pos!!c -- cgit