Posted By: Xyster (X! [({})]) on 'CZriddles'
Title:     Re: 2 matematici
Date:      Thu Mar  8 16:18:41 2001

Takze asi postnu reseni ... :)

> jsou dany 2 prirozeny cisla 
> 1. Udelame jejich soucet a soucin. 
> 2 matematikum A a B rekneme jednomu soucin (A), druhymu soucet (B).
> Pak si matematici reknou:
> 
> Varianta 1:
> A1: Nevim co to je za cisla.
> B1: To jsem vedel.
> A2: Tak ted uz to vim.
> B2: Tak ja uz taky.

A1: A by vedel, o jaka cisla se jedna, pokud by obe byla prvocisla

B1: 
= soucet nesmi byt rozlozitelny na dne prvocisla:
- vytvorime mnozinu C prirozenych cisel, ktere nejsou souctem 2 prvocisel ...

A2: A zna nejaky soucin a vi, ze soucet je ve mnozine z B1. Staci mu rozlozit 
sve cislo na mozne souciny dvou cislel a zkontrolovat soucty.  Najde 
jednoznacne reseni. 

: najdeme souciny (D) , pro ktere plati podminka jednoznacnosti

- vytvorime ?skupinu? D1 soucinu odpovidajicich souctum C
- vytvorime mnozinu D prvku D1, ktere se v D1 vyskytuji pouze 1

B2: 
= B musi mit takovy soucet, ze mu odpovida prave jeden jednoznacny soucin z D.
- pro kazdy soucet z C najdeme vsechny souciny E1(Cn) a urcime prunik E1(Cn) 
s D. Pokud prunik ma jen jeden prvek, dopocteme hledana cisla.

----
Pokud ma byt zadani jednoznacne, musi existovat pouze jedno reseni a staci 
najit prvni. 
Experimentalne opravdu existuje pouze jedno reseni pro cisla mensi nez 100 ;)

Ale asi by bylo zajimave dokazat, ze pro existuje pouze jedno Cn, pro ktere 
existuje jednoprvkovy prunik. 

---
.... a ted slibeny LISP ;) 
... asi by to slo napsat lepe(a hlabvne efektivneji), ale takhle to bylo 
nejrychlejsi ... 

;; prvocisla
(defun primes (max)
  (loop for i from 2 to max
        when (system:primep i) collect i) )

;; prvocisla splnujici podminku nejednoznacnosti
(defun sums-valid-1 (max)
  (let ((prms (primes max))
        (valid (loop for i from 4 to (* 2 max) collect i)) )
    (loop for p1 in prms
          do (loop for p2 in prms
                   do (setf valid (delete (+ p1 p2) valid)) ) )
    valid) )

;; seznam moznych soucinu pro dany soucet
(defun sum-muls (sum)
  (loop for i from 2 to (/ sum 2)
        collect (* i (- sum i)) ) )

;; souciny, ktere jsou jenzoznacne (jen v jednom souctu)
(defun muls-single (sums)
  (let (muls
        muls-invalid)
    (loop for sum in sums
          do (loop for mul in (sum-muls sum)
                   do (if (member mul muls)
                          (setf muls-invalid (adjoin mul muls-invalid))
                        (setf muls (cons mul muls)) ) ) )
    (set-difference muls muls-invalid) ) )

;; soucty, kteryn odpovida pouze jeden jednoznacny soucin 
(defun sums-valid-2 (sums)
  (let ((muls-valid (muls-single sums)))
    (loop for sum in sums
          when (= (length (intersection muls-valid (sum-muls sum))) 1)
            collect (list sum (car (intersection muls-valid (sum-muls sum)))) 
) ) )

(defun res (max) 
  (sums-valid-2 (sums-valid-1 max)) )

...
No ... zjistil jsem, z v matematicke terminologii a teorii dost tapu ... takze 
se vsem pritomnym matematikum (a ostatnim) omlouvam ...
 
  

> 
> Prevzato z Lamohlavu (www.novinky.cz) a 
> http://www.vsb.cz/mdg/pkovar/zabava.html.
> Zdravi Mantak
Xyster

42