Message Boards Message Boards

0
|
11106 Views
|
13 Replies
|
14 Total Likes
View groups...
Share
Share this post:

Calculate minimum common differences?

sketch Can someone program something todo this? Calculate the least or greatest most different numbers between a series of numbers? So far I came out with these lines, but nothing comes out...

Unprotect [Element]Unprotect [NotElement]Unprotect[NestWhile]Unprotect[a,a1,a2]Unprotect[Slot]
f[a1_]:= a&;&["|<a 1] ,[|>"a 1"\[Rule]a 1],|<=>"a1 "\[Rule] a1 "];

Block

 Thread[f[{a},{a1,a2},List AllTrue]]
e=Intersection [a,a1,a2]
Last[%]
Block[{$RecursionLimit=1000},f= a]
RandomChoice[a,27]
Thread[a=NestWhileList[a!= a1>a!=a2[Element[a,aa]& Element[a1,aa]& Element[aa,a],Element[a,aa]!=Element[a1,aa]!=Element[a2,aa]&],a,27]]
a=Flatten[List[%]]
Thread[a1=NestWhileList[a1!= a1>b!=a2[Element[a1,aa]& Element[a1,aa]& Element[aa,a1],Element[a1,aa]!=Element[a1,aa]!=Element[a1,aa]&],a1,27]]
a1=Flatten[%]
Block[{$RecursionLimit=1000},c1 ]
c1={#&,a+b1-c1}
b1={a,a1+a}
Map[MatchQ[#,_Integer]&,b]
Pick[c1,b1]

Do[If[a1  a1 And Or >=a1,Print["a1 = ",a1],Throw[a]],{a1,d}]
Catch[Do[If[a2!= a And Or #3&,Print["a1 = ",a1],Throw[a1]],{a,d}]]
Directory[]
Export["aa.txt","aa"]
Import["aa.txt"]
a=Flatten[a]
b=Flatten[a1]
c=Flatten[a2]
d=Union[a,b,c]
s=Subtract[a1,a2]
Take[a1,"-s"]
Solve[aa->aa!= aa!= #& ,aa]
a={3,4,5,7,10,15,23,27}
a1={4,6,7,8,9,10,12,15,25}
a2={2,6,7,10,11,12,23,13,14,15,25}
While a<=a1!=a2 Take[Last[a]]
13 Replies

I just would like to thank you all for coming out with a solution for the puzzle I presented , i think you are all top mathmaticians and programmers. Now i am using it to take the pixels that are least common and and least ifferent form 2 pictures. I think all you know how important it is to take out the sequences a it applies to many areas of imaging. Unfortunately i do not know how to apply it tomodifying image pixels so that i get an image from imagelevels or image data.

I am not quite sure, but perhaps you mean this:

your numbers (hand written from above)

aA = {3, 4, 5, 7, 10, 15};
bB = {4, 6, 7, 8, 9, 10, 12, 15};
cC = {2, 6, 7, 10, 11, 12, 13, 14, 15};

Find common elements

IS = Intersection[aA, bB, cC]
{7, 10, 15}

Remove them from your lists

cp = Complement[#, IS] & /@ {aA, bB, cC}

{{3, 4, 5}, {4, 6, 8, 9, 12}, {2, 6, 11, 12, 13, 14}}

Now again find elements in cp common to all members in cp comparing all subsets

pp = Table[ Intersection[cp[[i]], cp[[j]]], {i, Length[cp] - 1}, {j, i + 1, Length[cp]}] // Flatten
{4, 6, 12}

Remove them from the elements of cp and take the first elements of the results. These should be the smallest numbers different in each series

First /@ (Complement[#, pp] & /@ cp)
 {3, 8, 2}
POSTED BY: Hans Dolhaine

This can be made into a two-liner, generical counting for subsets

In[98]:= (* for the WC *)
a0 = {3, 4, 5, 7, 10, 15, 23, 27};
a1 = {4, 6, 7, 8, 9, 10, 12, 15, 25};
a2 = {2, 6, 7, 10, 11, 12, 13, 14, 15, 25};

In[101]:= Clear[cp]
          cp = Complement[#, Intersection[a0, a1, a2]] & /@ {a0, a1, a2}
Out[102]= {{3, 4, 5, 23, 27}, {4, 6, 8, 9, 12, 25}, {2, 6, 11, 12, 13, 14, 25}}

In[103]:= First /@ (Complement[#, 
     Flatten[Intersection @@@ (Part[cp, #] & /@ 
         Subsets[Range[Length[cp]], {2, Length[cp] - 1}])]] & /@ cp)
Out[103]= {3, 8, 2}

but from the (insinuated) point of view of the problem owner it might consist a problem, that not all subset intersections are non-empty

In[105]:= Intersection @@@ (Part[cp, #] & /@ Subsets[Range[Length[cp]], {2, Length[cp] - 1}])
Out[105]= {{4}, {}, {6, 12, 25}}

which has been flattened away,

POSTED BY: Dent de Lion

Hi Udo, great, albeit somewhat complex. I wanted to show the single steps. Moreover I think it suffices to look at all pairs of subsets of cp, and it is not neccesary to look at all subsets of cp with more elements than 2. This would save time and memory. So I think one could write as well

First /@ (Complement[#, 
     Flatten[Intersection @@@ (Part[cp, #] & /@ 
         Subsets[Range[Length[cp]], {2}])]] & /@ cp)

The empty sets could indeed be an issue indicating that there are elements which don't occur in some of the original sets after removing the elements common to all sets. Perhaps you could include an error-variable ( perhaps Catch, Throw ?) in your 2-liner?

POSTED BY: Hans Dolhaine

Moreover I think it suffices to look at all pairs of subsets of cp

This means that for let's say 4 non-empty sets $A,B,C,D$ the sets

$A_2 = A\cap B \vee A\cap C \vee A\cap D \vee B\cap C \vee B\cap D \vee C\cap D$

and

$A_{23} = A\cap B \vee A\cap C \vee A\cap D \vee B\cap C \vee B\cap D \vee C\cap D \vee A\cap B\cap C \vee A\cap B\cap D \vee A\cap C\cap D \vee B\cap C\cap D$

are identical $A_2 \equiv A_{23}$, which is clear because of the $\vee$ (logical OR) and the fact, that intersections of three sets are not more permissive as intersections of two sets. Actually I was driven by your other remark

Now again find elements in cp common to all members in cp comparing all subsets

to deliver a generic code sample which could deliver all subsets. It was restricted to the subsets with $2,3,...,n-1$ members and should be restricted even more in the given context, as you say.

POSTED BY: Dent de Lion

Very interesting. But what does the OR between two sets (here intersections) mean? OR is a logical function and I don't know how it works concerning sets:

In[1]:= m = {a, b, c, d};
sm = Subsets[m, {2, 3}]

Out[2]= {{a, b}, {a, c}, {a, d}, {b, c}, {b, d}, {c, d}, {a, b, c}, {a, b, d}, {a, c, d}, {b, c, d}}

In[3]:= (Or @@ (Intersection @@@ sm)) // LogicalExpand

During evaluation of In[3]:= Intersection::normal: Nonatomic expression expected at position 1 in a\[Intersection]b. >>

During evaluation of In[3]:= Intersection::normal: Nonatomic expression expected at position 1 in a\[Intersection]c. >>

During evaluation of In[3]:= Intersection::normal: Nonatomic expression expected at position 1 in a\[Intersection]d. >>

During evaluation of In[3]:= General::stop: Further output of Intersection::normal will be suppressed during this calculation. >>

Out[3]= a \[Intersection] b || a \[Intersection] c || 
 a \[Intersection] d || b \[Intersection] c || b \[Intersection] d || 
 c \[Intersection] d || a \[Intersection] b \[Intersection] c || 
 a \[Intersection] b \[Intersection] d || 
 a \[Intersection] c \[Intersection] d || 
 b \[Intersection] c \[Intersection] d

And unfortunately this is not your A2

POSTED BY: Hans Dolhaine

But what does the OR between two sets (here intersections) mean?

What do you think does it mean? That $A_2$ consists of elements from $A \cap B$ (inclusively) or from $A \cap C$ ... but this must be correctly written as $A_2 = (A \cap B) \cup (A \cap C) \cup \dots$ which means with respect to $A_2$ and $A_{23}$ that $A_2 = A_{23}$ because $A\cap B \cap C \subseteq (A \cap B) \cup (A \cap C)$ and $A\cap B \cap C \subseteq (B \cap C) \cup (B \cap A)$ and $A\cap B \cap C \subseteq (C \cap A) \cup (C \cap B)$ and so on and so on.

POSTED BY: Dent de Lion

Hello Udo,

I see what you mean:

Off[Intersection::"normal", Union::"normal"]

m = {a, b, c, d, e, f};
sm2 = Subsets[m, {2}]
sm23 = Subsets[m, {2, 3}]

Intersection @@@ sm2
Intersection @@@ sm23

and everything is clear now

Union @@ Intersection @@@ sm2
Union @@ Intersection @@@ sm23

Btw, i tried that with labeld variables and found that Intersection and Union behave in this case somewhat strange.....

Subsets[Table[a[i], {i, 6}], {2}]
Intersection @@@ Subsets[Table[a[i], {i, 6}], {2}]
Union @@ Subsets[Table[a[i], {i, 6}], {2}]
Union @@ Table[a[i], {i, 6}]
POSTED BY: Hans Dolhaine

Intersection has to be applied usually to a sequence of lists, but as mostly often

Intersection works with any head, not just List:

So, if something isn't an atom

In[8]:= AtomQ[a[1]]
Out[8]= False

it has a head and this head remains unchanged, the content is intersected - as it is done with List[]:

In[8]:= AtomQ[a[1]]
Out[8]= False

In[9]:= a[1] \[Intersection] a[2]
Out[9]= a[]

In[10]:= {1} \[Intersection] {2}
Out[10]= {}

If the heads do not fit, you get it to know

In[11]:= a[1, 2, 3, 4] \[Intersection] a[2, 3, 4, 5] \[Intersection] b[1, 2, a[1, 2, 3, 4]]
During evaluation of In[11]:= Intersection::heads: Heads b and a at positions 3 and 1 are expected to be the same. >>
Out[11]= a[1, 2, 3, 4] \[Intersection] a[2, 3, 4, 5] \[Intersection] b[1, 2, a[1, 2, 3, 4]]

it's once again a reflection of the deep insight that heads are not as much different from each other as they appear in education for childs and students:

In[13]:= a[1, 2, 3, 4] \[Intersection] a[2, 3, 4, 5] \[Intersection]  a[1, 2, b[1, 2, 3, 4]]
Out[13]= a[2]
POSTED BY: Dent de Lion
Posted 6 years ago

It's an interesting algorithm problem, but I cannot understand your example :(

Would you mind providing more sample cases?

POSTED BY: Shujie CHEN

The point i wanted to make was to catch all the numbers that were the smallest numbers of a serie but that were common to each serie presented in the three series above and the three smalest number that were different from each serie of numbers(minimum common difference ) and then make up a new seried of numbers with those characteristics.Forget my example because i started simulating numbers ( elements ) to try to catch the least common number different from each serie but the programing ( lines of program ) came out completely odd from what i supposed, i think you have to start different from me.

Well, if one considers test input a0, a1, a2 as series and some substructure in a given series as succession and defines a succession as a list of consecutive elements with constant difference between sucession members, the following arises:

(* given series *)
a0 = {3, 4, 5, 7, 10, 15, 23, 27};
a1 = {4, 6, 7, 8, 9, 10, 12, 15, 25};
a2 = {2, 6, 7, 10, 11, 12, 13, 14, 15, 25};

(* helpers *)
Clear[taker, successor]
taker[{l_List, o_Integer}] := First[l] /; Length[l] == 1 && o == 1
taker[{l_List, o_Integer}] := Drop[First[l], 1] /; Length[l] == 1 && o != 1
taker[{l_List, o_Integer}] := Union @@ l /; Length[l] != 1 && o == 1
taker[{l_List, o_Integer}] := Union @@ Drop[l, 1] /; Length[l] != 1 && o != 1
successor[l_List?VectorQ] := taker /@
     Transpose[{#, Range[Length[#]]}] &[Split[Partition[l, 2, 1], (#1.{1, -1} == #2.{1, -1}) &]] /; OrderedQ[l]

finding successions within the series

In[75]:= successor /@ {a0, a1, a2}
Out[75]= {{{3, 4, 5}, {7}, {10}, {15}, {23}, {27}}, 
          {{4, 6}, {7, 8, 9, 10}, {12}, {15}, {25}},
          {{2, 6}, {7}, {10}, {11, 12, 13, 14, 15}, {25}}}

the smallest elements of successions

Map[First, #] & /@ (successor /@ {a0, a1, a2})
{{3, 7, 10, 15, 23, 27}, {4, 7, 12, 15, 25}, {2, 7, 10, 11, 25}}

the smallest elements of successions common to all series

In[99]:= Clear[smac]
         smac = Intersection[Union @@ (Map[First, #] & /@ (successor /@ {a0, a1, a2})), a0, a1, a2]
Out[100]= {7, 10, 15}

get new series excluding the common smallest succession elements

In[102]:= {b0, b1, b2} = Complement[#, smac] & /@ {a0, a1, a2}
Out[102]= {{3, 4, 5, 23, 27}, {4, 6, 8, 9, 12, 25}, {2, 6, 11, 12, 13, 14, 25}}

finding again successions in the new series b0, b1, and b2; Attention: 8 is not smallest in any succession

In[103]:= successor /@ {b0, b1, b2}
Out[103]= {{{3, 4, 5}, {23}, {27}}, {{4, 6, 8}, {9}, {12}, {25}}, {{2, 6}, {11}, {12, 13, 14}, {25}}}

the smallest elements of these successions

In[104]:= Map[First, #] & /@ (successor /@ {b0, b1, b2})
Out[104]= {{3, 23, 27}, {4, 9, 12, 25}, {2, 11, 12, 25}}

getting smallest succession elements not in the non-home series; the X trick shouldn't be necessary

In[152]:= cp = Complement @@@ (Thread[
          X[List /@ (Map[First, #] & /@ (successor /@ {b0, b1, b2})), 
            RotateLeft[Partition[{b0, b1, b2}, 2, 1, 1]]]] //. X -> Join)
Out[152]= {{3, 23, 27}, {9}, {2, 11}}

take the smallest of them

In[153]:= First /@ cp
Out[153]= {3, 9, 2}

Finally, discuss it

  • no list came empty
  • result is {3,9,2}, not {3,8,2}
  • not sure whether the multi-valued usage of the term series in problem owner's description has been demangled correctly
  • problem owner is free the decide that and to convert the whole thing into something useful
  • notebook attached for convenience
  • why the trick with the X ruling to Join after threading X was necessary?
Attachments:
POSTED BY: Dent de Lion

If your a2 is corrected (a 23 between 12 and 13 has been canceled) then

In[11]:= a0 = {3, 4, 5, 7, 10, 15, 23, 27};
         a1 = {4, 6, 7, 8, 9, 10, 12, 15, 25};
         a2 = {2, 6, 7, 10, 11, 12, 13, 14, 15, 25};

In[8]:= Plus @@ Most[a0]
Out[8]= 67

In[9]:= Plus @@ Most[a1]
Out[9]= 71

In[14]:= Plus @@ Most[a2]
Out[14]= 90

In[16]:= 32/13 // N
Out[16]= 2.46154

A has another sum as hand-written and 32/13 is of course not bigger than 24 ... then: in the last sequence C: the difference between 2 and 6 is 4, so 2 and 6 are more different than 7 and 10, why 7 and 10 have been selected?

POSTED BY: Dent de Lion
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract